From 548be25b5ae1ea081165c309207edec874b8973b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 26 Apr 2022 03:21:44 -0400 Subject: [PATCH 01/68] Remove unused module use for calculate_density Removed unused module use statements for EOS_type, calculate_density or calculate_density_derivs in 20 files. All answers are bitwise identical. --- src/ALE/MOM_ALE.F90 | 2 -- src/diagnostics/MOM_wave_speed.F90 | 2 +- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 1 - src/parameterizations/vertical/MOM_internal_tide_input.F90 | 2 +- src/parameterizations/vertical/MOM_regularize_layers.F90 | 4 +--- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 1 - src/user/BFB_initialization.F90 | 1 - src/user/DOME2d_initialization.F90 | 1 - src/user/DOME_initialization.F90 | 2 +- src/user/Neverworld_initialization.F90 | 1 - src/user/Phillips_initialization.F90 | 1 - src/user/RGC_initialization.F90 | 2 +- src/user/Rossby_front_2d_initialization.F90 | 1 - src/user/adjustment_initialization.F90 | 1 - src/user/circle_obcs_initialization.F90 | 1 - src/user/dumbbell_initialization.F90 | 1 - src/user/seamount_initialization.F90 | 1 - src/user/sloshing_initialization.F90 | 1 - src/user/soliton_initialization.F90 | 1 - src/user/user_initialization.F90 | 2 +- 20 files changed, 6 insertions(+), 23 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 9e51d2873c..4ebc395d7a 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -15,8 +15,6 @@ module MOM_ALE use MOM_diag_mediator, only : time_type, diag_update_remap_grids use MOM_diag_vkernels, only : interpolate_column, reintegrate_column use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type -use MOM_EOS, only : calculate_density -use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_error_handler, only : callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 9cb7c46c37..a06e9768d6 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -11,7 +11,7 @@ module MOM_wave_speed use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs +use MOM_EOS, only : calculate_density_derivs implicit none ; private diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index fb218a7d67..7c427ab79a 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -8,7 +8,6 @@ module MOM_bkgnd_mixing use MOM_debugging, only : hchksum use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field use MOM_diag_mediator, only : post_data -use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_file_parser, only : openParameterBlock, closeParameterBlock diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 8a0a623c1a..f68e518a14 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -19,7 +19,7 @@ module MOM_int_tide_input use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain +use MOM_EOS, only : calculate_density_derivs, EOS_domain implicit none ; private diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 90cdd9d6e6..45b21eb1ab 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -13,7 +13,7 @@ module MOM_regularize_layers use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain +use MOM_EOS, only : calculate_density, EOS_domain implicit none ; private @@ -228,8 +228,6 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) !$OMP eb,nkml,EOSdom) do j=js,je ; if (do_j(j)) then -! call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, tv%eqn_of_state, EOSdom) - do k=1,nz ; do i=is,ie ; d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 ; enddo ; enddo kmax_d_ea = 0 diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 4728fefdff..95bd3df427 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -6,7 +6,6 @@ module MOM_tidal_mixing use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field use MOM_diag_mediator, only : safe_alloc_ptr, post_data use MOM_debugging, only : hchksum -use MOM_EOS, only : calculate_density use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_file_parser, only : get_param, log_param, log_version, param_file_type diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 8ef21d190f..22d3156723 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -11,7 +11,6 @@ module BFB_initialization use MOM_tracer_registry, only : tracer_registry_type use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 6c64ef5596..807dbc0e2a 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -13,7 +13,6 @@ module DOME2d_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 14899062b9..859b736380 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -17,7 +17,7 @@ module DOME_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type +use MOM_EOS, only : calculate_density, calculate_density_derivs implicit none ; private diff --git a/src/user/Neverworld_initialization.F90 b/src/user/Neverworld_initialization.F90 index 19dc6af68a..0ba2cbba01 100644 --- a/src/user/Neverworld_initialization.F90 +++ b/src/user/Neverworld_initialization.F90 @@ -13,7 +13,6 @@ module Neverworld_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use random_numbers_mod, only: initializeRandomNumberStream, getRandomNumbers, randomNumberStream diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 7812f66f98..f4f18869c4 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -13,7 +13,6 @@ module Phillips_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type implicit none ; private diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index 1ac2169a7e..8e4026a444 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -21,7 +21,7 @@ module RGC_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type, EOS_domain +use MOM_EOS, only : calculate_density, EOS_domain implicit none ; private #include diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 53d57e99b7..b491c027f3 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -10,7 +10,6 @@ module Rossby_front_2d_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 96e80f970f..6c05def460 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -10,7 +10,6 @@ module adjustment_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index c1ea771885..9553aafafb 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -12,7 +12,6 @@ module circle_obcs_initialization use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type implicit none ; private diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 7383373909..e3d97412bd 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -14,7 +14,6 @@ module dumbbell_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index e15bcf4d4e..dfd39e328f 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -14,7 +14,6 @@ module seamount_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 6422f05855..641afa5f3e 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -14,7 +14,6 @@ module sloshing_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type implicit none ; private diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index a203fb67de..b3b45da997 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -10,7 +10,6 @@ module soliton_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index adccc40b81..e115cd8f30 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -16,7 +16,7 @@ module user_initialization use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + implicit none ; private #include From 9c2e57310b79013e082b861a31c72b25ceb4e706 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 26 Apr 2022 03:22:14 -0400 Subject: [PATCH 02/68] Document variables in diagnoseMLDbyEnergy Added comments documenting the units of the variables in diagnoseMLDbyEnergy and slightly refactored this routine to clean up its call to calculate_density and eliminated a redundant array of interface depths. Also fixed several spelling errors in comments. All answers and diagnostics are bitwise identical. --- .../vertical/MOM_diabatic_aux.F90 | 82 ++++++++++++------- .../vertical/MOM_diabatic_driver.F90 | 2 +- 2 files changed, 53 insertions(+), 31 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 405251eaee..86df042646 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -220,7 +220,7 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) end subroutine make_frazil -!> This subroutine applies double diffusion to T & S, assuming no diapycal mass +!> This subroutine applies double diffusion to T & S, assuming no diapycnal mass !! fluxes, using a simple triadiagonal solver. subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -604,8 +604,8 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity, tracer_flow !! organizing the tracer modules. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] + real, dimension(SZI_(G),SZJ_(G)) :: chl_2d !< Vertically uniform chlorophyll-A concentrations [mg m-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: chl_3d !< The chlorophyll-A concentrations of each layer [mg m-3] character(len=128) :: mesg integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -676,7 +676,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, real, dimension(SZI_(G)) :: S_subML, S_deeper ! Salinities used in the N2 calculation [ppt]. real, dimension(SZI_(G)) :: rho_subML, rho_deeper ! Densities used in the N2 calculation [R ~> kg m-3]. real, dimension(SZI_(G)) :: dK, dKm1 ! Depths [Z ~> m]. - real, dimension(SZI_(G)) :: rhoSurf ! Density used in finding the mixedlayer depth [R ~> kg m-3]. + real, dimension(SZI_(G)) :: rhoSurf ! Density used in finding the mixed layer depth [R ~> kg m-3]. real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML [T-2 ~> s-2]. real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 [Z2 ~> m2]. @@ -801,14 +801,14 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) ! density in the mixed layer as well as in the remaining part of the present layer that is ! not mixed. ! To solve for X in this equation a Newton's method iteration is employed, which - ! converges extremely quickly (usually 1 guess) since this equation turns out being rather - ! lienar for PE change with increasing X. + ! converges extremely quickly (usually 1 guess) since this equation turns out to be rather + ! linear for PE change with increasing X. ! Input parameters: integer, dimension(3), intent(in) :: id_MLD !< Energy output diag IDs type(ocean_grid_type), intent(in) :: G !< Grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(3), intent(in) :: Mixing_Energy !< Energy values for up to 3 MLDs + real, dimension(3), intent(in) :: Mixing_Energy !< Energy values for up to 3 MLDs [R Z L2 T-2 ~> J m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any @@ -816,17 +816,44 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) type(diag_ctrl), pointer :: diagPtr !< Diagnostics structure ! Local variables - real, dimension(SZI_(G), SZJ_(G),3) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. - real, dimension(SZK_(GV)) :: Z_L, Z_U, dZ, Rho_c, pRef_MLD - real, dimension(3) :: PE_threshold - - real :: PE_Threshold_fraction, PE, PE_Mixed, PE_Mixed_TST - real :: RhoDZ_ML, H_ML, RhoDZ_ML_TST, H_ML_TST - real :: Rho_ML - - real :: R1, D1, R2, D2 - real :: Ca, Cb,D ,Cc, Cd, Ca2, Cb2, C, Cc2 - real :: Gx, Gpx, Hx, iHx, Hpx, Ix, Ipx, Fgx, Fpx, X, X2 + real, dimension(SZI_(G),SZJ_(G),3) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. + real, dimension(SZK_(GV)+1) :: Z_int ! Depths of the interfaces from the surface [Z ~> m] + real, dimension(SZK_(GV)) :: dZ ! Layer thicknesses in depth units [Z ~> m] + real, dimension(SZK_(GV)) :: Rho_c ! A column of layer densities [R ~> kg m-3] + real, dimension(SZK_(GV)) :: pRef_MLD ! The reference pressure for the mixed layer + ! depth calculation [R L2 T-2 ~> Pa] + real, dimension(3) :: PE_threshold ! The energy threshold divided by g [R Z2 ~> kg m-1] + + real :: PE_Threshold_fraction ! The fractional tolerance of the specified energy + ! for the energy used to mix to the diagnosed depth [nondim] + real :: H_ML ! The accumulated depth of the mixed layer [Z ~> m] + real :: PE ! The cumulative potential energy of the unmixed water column to a depth + ! of H_ML, divided by the gravitational acceleration [R Z2 ~> kg m-1] + real :: PE_Mixed ! The potential energy of the completely mixed water column to a depth + ! of H_ML, divided by the gravitational acceleration [R Z2 ~> kg m-1] + real :: RhoDZ_ML ! The depth integrated density of the mixed layer [R Z ~> kg m-2] + real :: H_ML_TST ! A new test value for the depth of the mixed layer [Z ~> m] + real :: PE_Mixed_TST ! The potential energy of the completely mixed water column to a depth + ! of H_ML_TST, divided by the gravitational acceleration [R Z2 ~> kg m-1] + real :: RhoDZ_ML_TST ! A test value of the new depth integrated density of the mixed layer [R Z ~> kg m-2] + real :: Rho_ML ! The average density of the mixed layer [R ~> kg m-3] + + ! These are all temporary variables used to shorten the expressions in the iterations. + real :: R1, R2, Ca, Ca2 ! Some densities [R ~> kg m-3] + real :: D1, D2, X, X2 ! Some thicknesses [Z ~> m] + real :: Cb, Cb2 ! A depth integrated density [R Z ~> kg m-2] + real :: C, D ! A depth squared [Z2 ~> m2] + real :: Cc, Cc2 ! A density times a depth squared [R Z2 ~> kg m-1] + real :: Cd ! A density times a depth cubed [R Z3 ~> kg] + real :: Gx ! A triple integral in depth of density [R Z3 ~> kg] + real :: Gpx ! The derivative of Gx with x [R Z2 ~> kg m-1] + real :: Hx ! The vertical integral depth [Z ~> m] + real :: iHx ! The inverse of Hx [Z-1 ~> m-1] + real :: Hpx ! The derivative of Hx with x, hard coded to 1. Why? [nondim] + real :: Ix ! A double integral in depth of density [R Z2 ~> kg m-1] + real :: Ipx ! The derivative of Ix with x [R Z ~> kg m-2] + real :: Fgx ! The mixing energy difference from the target [R Z2 ~> kg m-1] + real :: Fpx ! The derivative of Fgx with x [R Z ~> kg m-2] integer :: IT, iM integer :: i, j, is, ie, js, je, k, nz @@ -844,17 +871,12 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0.0) then - call calculate_density(tv%T(i,j,:), tv%S(i,j,:), pRef_MLD, rho_c, 1, nz, & - tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(i,j,:), tv%S(i,j,:), pRef_MLD, rho_c, tv%eqn_of_state) + Z_int(1) = 0.0 do k=1,nz DZ(k) = h(i,j,k) * GV%H_to_Z - enddo - Z_U(1) = 0.0 - Z_L(1) = -DZ(1) - do k=2,nz - Z_U(k) = Z_L(k-1) - Z_L(k) = Z_L(k-1)-DZ(k) + Z_int(K+1) = Z_int(K) - DZ(k) enddo do iM=1,3 @@ -870,7 +892,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) do k=1,nz ! This is the unmixed PE cumulative sum from top down - PE = PE + 0.5 * rho_c(k) * (Z_U(k)**2 - Z_L(k)**2) + PE = PE + 0.5 * rho_c(k) * (Z_int(K)**2 - Z_int(K+1)**2) ! This is the depth and integral of density H_ML_TST = H_ML + DZ(k) @@ -1067,7 +1089,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1),SZI_(G),SZK_(GV)) :: & opacityBand ! The opacity (inverse of the exponential absorption length) of each frequency - ! band of shortwave radation in each layer [H-1 ~> m-1 or m2 kg-1] + ! band of shortwave radiation in each layer [H-1 ~> m-1 or m2 kg-1] real, dimension(maxGroundings) :: hGrounding ! Thickness added by each grounding event [H ~> m or kg m-2] real :: Temp_in, Salin_in real :: g_Hconv2 ! A conversion factor for use in the TKE calculation @@ -1173,7 +1195,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! netSalt = surface salt fluxes [ppt H ~> ppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation split according to bands. ! This field provides that portion of SW from atmosphere that in fact - ! enters to the ocean and participates in pentrative SW heating. + ! enters to the ocean and participates in penetrative SW heating. ! nonpenSW = non-downwelling SW flux, which is absorbed in ocean surface ! (in tandem w/ LW,SENS,LAT); saved only for diagnostic purposes. @@ -1201,7 +1223,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! For all these reasons we compute additional values of <_rate> which are preserved ! for the buoyancy flux calculation and reproduce the old answers. ! In the future this needs more detailed investigation to make sure everything is - ! consistent and correct. These details shouldnt significantly effect climate, + ! consistent and correct. These details should not significantly effect climate, ! but do change answers. !----------------------------------------------------------------------------------------- if (calculate_buoyancy) then diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e459010481..19c7245f3f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -171,7 +171,7 @@ module MOM_diabatic_driver real :: MLDdensityDifference !< Density difference used to determine MLD_user [R ~> kg m-3] real :: dz_subML_N2 !< The distance over which to calculate a diagnostic of the !! average stratification at the base of the mixed layer [Z ~> m]. - real :: MLD_EN_VALS(3) !< Energy values for energy mixed layer diagnostics + real :: MLD_EN_VALS(3) !< Energy values for energy mixed layer diagnostics [R Z L2 T-2 ~> J m-2] !>@{ Diagnostic IDs integer :: id_cg1 = -1 ! diag handle for mode-1 speed From 07df0bfd7c2412ccb8c3284a308def310a744526 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 26 Apr 2022 03:26:50 -0400 Subject: [PATCH 03/68] Clarify units for equation of state arguments Documented the units of variables as they actually appear in subroutine calls to various equation of state or density integral routines, eliminating the potentially confusing lists of alternative units in comments. Only comments are changed, and all answers are bitwise identical. --- src/core/MOM_density_integrals.F90 | 106 ++++++++++++++--------------- src/equation_of_state/MOM_EOS.F90 | 47 +++++++------ 2 files changed, 78 insertions(+), 75 deletions(-) diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 4b7ba9454a..5ef04ad280 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -47,19 +47,19 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, US, dpa, intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m] - real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3] or [kg m-3], that is + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is !! subtracted out to reduce the magnitude of each of the !! integrals. - real, intent(in) :: rho_0 !< A density [R ~> kg m-3] or [kg m-3], that is used + real, intent(in) :: rho_0 !< A density [R ~> kg m-3], that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration - !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] + !! [L2 Z-1 T-2 ~> m s-2] type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly - !! across the layer [R L2 T-2 ~> Pa] or [Pa] + !! across the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & optional, intent(inout) :: intz_dpa !< The integral through the thickness of the !! layer of the pressure anomaly relative to the @@ -104,19 +104,19 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m] - real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3] or [kg m-3], that is + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is !! subtracted out to reduce the magnitude !! of each of the integrals. - real, intent(in) :: rho_0 !< A density [R ~> kg m-3] or [kg m-3], that is used + real, intent(in) :: rho_0 !< A density [R ~> kg m-3], that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration - !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] + !! [L2 Z-1 T-2 ~> m s-2] type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly - !! across the layer [R L2 T-2 ~> Pa] or [Pa] + !! across the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & optional, intent(inout) :: intz_dpa !< The integral through the thickness of the !! layer of the pressure anomaly relative to the @@ -141,11 +141,11 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & ! Local variables real :: T5(5), S5(5) ! Temperatures and salinities at five quadrature points [degC] and [ppt] real :: p5(5) ! Pressures at five quadrature points, never rescaled from Pa [Pa] - real :: r5(5) ! Densities at five quadrature points [R ~> kg m-3] or [kg m-3] - real :: rho_anom ! The depth averaged density anomaly [R ~> kg m-3] or [kg m-3] + real :: r5(5) ! Densities at five quadrature points [R ~> kg m-3] + real :: rho_anom ! The depth averaged density anomaly [R ~> kg m-3] real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] - real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] or [m3 kg-1] + real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] real :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] real :: dz ! The layer thickness [Z ~> m] @@ -158,7 +158,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim] real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim] real :: intz(5) ! The gravitational acceleration times the integrals of density - ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] or [Pa] + ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] logical :: do_massWeight ! Indicates whether to do mass weighting. logical :: use_rho_ref ! Pass rho_ref to the equation of state for more accurate calculation ! of density anomalies. @@ -354,9 +354,9 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & intent(in) :: S_b !< Salinity at the cell bottom [ppt] real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)+1), & intent(in) :: e !< Height of interfaces [Z ~> m] - real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3] or [kg m-3], that is subtracted + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is subtracted !! out to reduce the magnitude of each of the integrals. - real, intent(in) :: rho_0 !< A density [R ~> kg m-3] or [kg m-3], that is used to calculate + real, intent(in) :: rho_0 !< A density [R ~> kg m-3], that is used to calculate !! the pressure (as p~=-z*rho_0*G_e) used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real, intent(in) :: dz_subroundoff !< A minuscule thickness change [Z ~> m] @@ -404,9 +404,9 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real :: p5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Pressures along a line of subgrid locations, never ! rescaled from Pa [Pa] real :: r5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Densities anomalies along a line of subgrid - ! locations [R ~> kg m-3] or [kg m-3] + ! locations [R ~> kg m-3] real :: u5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Densities anomalies along a line of subgrid locations - ! (used for inaccurate form) [R ~> kg m-3] or [kg m-3] + ! (used for inaccurate form) [R ~> kg m-3] real :: T15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Temperatures at an array of subgrid locations [degC] real :: S15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Salinities at an array of subgrid locations [ppt] real :: T215((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS temperature variance along a line of subgrid locations [degC2] @@ -414,15 +414,15 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real :: S215((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS salinity variance along a line of subgrid locations [ppt2] real :: p15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Pressures at an array of subgrid locations [Pa] real :: r15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Densities at an array of subgrid locations - ! [R ~> kg m-3] or [kg m-3] + ! [R ~> kg m-3] real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim] - real :: rho_anom ! A density anomaly [R ~> kg m-3] or [kg m-3] + real :: rho_anom ! A density anomaly [R ~> kg m-3] real :: w_left, w_right ! Left and right weights [nondim] real :: intz(5) ! The gravitational acceleration times the integrals of density - ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] or [Pa] + ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] - real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] or [m3 kg-1] + real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] real :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] real :: dz(HI%iscB:HI%iecB+1) ! Layer thicknesses at tracer points [Z ~> m] @@ -796,9 +796,9 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & intent(in) :: S_b !< Salinity at the cell bottom [ppt] real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)+1), & intent(in) :: e !< Height of interfaces [Z ~> m] - real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3] or [kg m-3], that is + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is !! subtracted out to reduce the magnitude of each of the integrals. - real, intent(in) :: rho_0 !< A density [R ~> kg m-3] or [kg m-3], that is used to calculate + real, intent(in) :: rho_0 !< A density [R ~> kg m-3], that is used to calculate !! the pressure (as p~=-z*rho_0*G_e) used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real, intent(in) :: dz_subroundoff !< A minuscule thickness change [Z ~> m] @@ -842,15 +842,15 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real :: TS5(5) ! SGS temperature-salinity covariance along a line of subgrid locations [degC ppt] real :: S25(5) ! SGS salinity variance along a line of subgrid locations [ppt2] real :: p5(5) ! Pressures at five quadrature points, never rescaled from Pa [Pa] - real :: r5(5) ! Density anomalies from rho_ref at quadrature points [R ~> kg m-3] or [kg m-3] + real :: r5(5) ! Density anomalies from rho_ref at quadrature points [R ~> kg m-3] real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim] - real :: rho_anom ! The integrated density anomaly [R ~> kg m-3] or [kg m-3] + real :: rho_anom ! The integrated density anomaly [R ~> kg m-3] real :: w_left, w_right ! Left and right weights [nondim] real :: intz(5) ! The gravitational acceleration times the integrals of density - ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] or [Pa] + ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] - real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] or [m3 kg-1] + real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] real :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] real :: dz ! Layer thicknesses at tracer points [Z ~> m] @@ -1128,9 +1128,9 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, US, & real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: S !< Salinity [ppt] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [Pa] + intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: p_b !< Pressure at the bottom of the layer [R L2 T-2 ~> Pa] or [Pa] + intent(in) :: p_b !< Pressure at the bottom of the layer [R L2 T-2 ~> Pa] real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1] !! The calculation is mathematically identical with different values of @@ -1139,24 +1139,24 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, US, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly across - !! the layer [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! the layer [L2 T-2 ~> m2 s-2] real, dimension(SZI_(HI),SZJ_(HI)), & optional, intent(inout) :: intp_dza !< The integral in pressure through the layer of the !! geopotential anomaly relative to the anomaly at the bottom of the - !! layer [R L4 T-4 ~> Pa m2 s-2] or [Pa m2 s-2] + !! layer [R L4 T-4 ~> Pa m2 s-2] real, dimension(SZIB_(HI),SZJ_(HI)), & optional, intent(inout) :: intx_dza !< The integral in x of the difference between the !! geopotential anomaly at the top and bottom of the layer divided by - !! the x grid spacing [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! the x grid spacing [L2 T-2 ~> m2 s-2] real, dimension(SZI_(HI),SZJB_(HI)), & optional, intent(inout) :: inty_dza !< The integral in y of the difference between the !! geopotential anomaly at the top and bottom of the layer divided by - !! the y grid spacing [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! the y grid spacing [L2 T-2 ~> m2 s-2] integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(SZI_(HI),SZJ_(HI)), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] real, optional, intent(in) :: dP_tiny !< A minuscule pressure change with - !! the same units as p_t [R L2 T-2 ~> Pa] or [Pa] + !! the same units as p_t [R L2 T-2 ~> Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -1186,9 +1186,9 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: S !< Salinity of the layer [ppt] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: p_t !< Pressure atop the layer [R L2 T-2 ~> Pa] or [Pa] + intent(in) :: p_t !< Pressure atop the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: p_b !< Pressure below the layer [R L2 T-2 ~> Pa] or [Pa] + intent(in) :: p_b !< Pressure below the layer [R L2 T-2 ~> Pa] real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1] !! The calculation is mathematically identical with different values of @@ -1198,24 +1198,24 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly - !! across the layer [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! across the layer [L2 T-2 ~> m2 s-2] real, dimension(SZI_(HI),SZJ_(HI)), & optional, intent(inout) :: intp_dza !< The integral in pressure through the layer of !! the geopotential anomaly relative to the anomaly at the bottom of the - !! layer [R L4 T-4 ~> Pa m2 s-2] or [Pa m2 s-2] + !! layer [R L4 T-4 ~> Pa m2 s-2] real, dimension(SZIB_(HI),SZJ_(HI)), & optional, intent(inout) :: intx_dza !< The integral in x of the difference between !! the geopotential anomaly at the top and bottom of the layer divided - !! by the x grid spacing [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! by the x grid spacing [L2 T-2 ~> m2 s-2] real, dimension(SZI_(HI),SZJB_(HI)), & optional, intent(inout) :: inty_dza !< The integral in y of the difference between !! the geopotential anomaly at the top and bottom of the layer divided - !! by the y grid spacing [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! by the y grid spacing [L2 T-2 ~> m2 s-2] integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(SZI_(HI),SZJ_(HI)), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] real, optional, intent(in) :: dP_neglect !< A minuscule pressure change with - !! the same units as p_t [R L2 T-2 ~> Pa] or [Pa] + !! the same units as p_t [R L2 T-2 ~> Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -1230,7 +1230,7 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d real :: T5(5) ! Temperatures at five quadrature points [degC] real :: S5(5) ! Salinities at five quadrature points [ppt] real :: p5(5) ! Pressures at five quadrature points, scaled back to Pa if necessary [Pa] - real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1] or [m3 kg-1] + real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1] real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1] real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa] real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa] @@ -1405,18 +1405,18 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: S_b !< Salinity at the bottom the layer [ppt] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: p_t !< Pressure atop the layer [R L2 T-2 ~> Pa] or [Pa] + intent(in) :: p_t !< Pressure atop the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: p_b !< Pressure below the layer [R L2 T-2 ~> Pa] or [Pa] + intent(in) :: p_b !< Pressure below the layer [R L2 T-2 ~> Pa] real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1] !! The calculation is mathematically identical with different values of !! alpha_ref, but alpha_ref alters the effects of roundoff, and !! answers do change. real, intent(in) :: dP_neglect ! Pa] or [Pa] + !! the same units as p_t [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] + intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & @@ -1425,15 +1425,15 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real, dimension(SZI_(HI),SZJ_(HI)), & optional, intent(inout) :: intp_dza !< The integral in pressure through the layer of !! the geopotential anomaly relative to the anomaly at the bottom of the - !! layer [R L4 T-4 ~> Pa m2 s-2] or [Pa m2 s-2] + !! layer [R L4 T-4 ~> Pa m2 s-2] real, dimension(SZIB_(HI),SZJ_(HI)), & optional, intent(inout) :: intx_dza !< The integral in x of the difference between !! the geopotential anomaly at the top and bottom of the layer divided - !! by the x grid spacing [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! by the x grid spacing [L2 T-2 ~> m2 s-2] real, dimension(SZI_(HI),SZJB_(HI)), & optional, intent(inout) :: inty_dza !< The integral in y of the difference between !! the geopotential anomaly at the top and bottom of the layer divided - !! by the y grid spacing [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! by the y grid spacing [L2 T-2 ~> m2 s-2] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -1447,18 +1447,18 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: T5(5) ! Temperatures at five quadrature points [degC] real :: S5(5) ! Salinities at five quadrature points [ppt] real :: p5(5) ! Pressures at five quadrature points, scaled back to Pa as necessary [Pa] - real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1] or [m3 kg-1] + real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1] real :: T15(15) ! Temperatures at fifteen interior quadrature points [degC] real :: S15(15) ! Salinities at fifteen interior quadrature points [ppt] real :: p15(15) ! Pressures at fifteen quadrature points, scaled back to Pa as necessary [Pa] - real :: a15(15) ! Specific volumes at fifteen quadrature points [R-1 ~> m3 kg-1] or [m3 kg-1] + real :: a15(15) ! Specific volumes at fifteen quadrature points [R-1 ~> m3 kg-1] real :: wt_t(5), wt_b(5) ! Weights of top and bottom values at quadrature points [nondim] real :: T_top, T_bot ! Horizontally interpolated temperature at the cell top and bottom [degC] real :: S_top, S_bot ! Horizontally interpolated salinity at the cell top and bottom [ppt] real :: P_top, P_bot ! Horizontally interpolated pressure at the cell top and bottom, ! scaled back to Pa as necessary [Pa] - real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1] or [m3 kg-1] + real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1] real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa] real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [R L2 T-2 ~> Pa] real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa] diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 80a8d3f866..e1814fc000 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -254,13 +254,14 @@ end subroutine calculate_stanley_density_scalar subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] - real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] + real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [kg m-3] or other + !! units if rescaled via a scale argument integer, intent(in) :: start !< Start index for computation integer, intent(in) :: npts !< Number of point to compute type(EOS_type), intent(in) :: EOS !< Equation of state structure - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] integer :: j @@ -350,7 +351,7 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] + real, optional, intent(in) :: rho_ref !< A reference density [R ~> kg m-3] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -594,11 +595,12 @@ end subroutine calc_spec_vol_1d !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs. subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure [Pa] or [other] + real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] real, intent(out) :: T_fr !< Freezing point potential temperature referenced !! to the surface [degC] type(EOS_type), intent(in) :: EOS !< Equation of state structure - real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa + real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure + !! into Pa [Pa T2 R-1 L-2 ~> 1]. ! Local variables real :: p_scale ! A factor to convert pressure to units of Pa. @@ -622,13 +624,14 @@ end subroutine calculate_TFreeze_scalar !> Calls the appropriate subroutine to calculate the freezing point for a 1-D array. subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_scale) real, dimension(:), intent(in) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [other] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: T_fr !< Freezing point potential temperature referenced !! to the surface [degC] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), intent(in) :: EOS !< Equation of state structure - real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure + !! into Pa [Pa T2 R-1 L-2 ~> 1]. ! Local variables real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] @@ -678,7 +681,7 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), intent(in) :: EOS !< Equation of state structure - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -1128,9 +1131,9 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: S !< Salinity [ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [Pa] + intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure at the bottom of the layer [R L2 T-2 ~> Pa] or [Pa] + intent(in) :: p_b !< Pressure at the bottom of the layer [R L2 T-2 ~> Pa] real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1] !! The calculation is mathematically identical with different values of @@ -1138,24 +1141,24 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & type(EOS_type), intent(in) :: EOS !< Equation of state structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(inout) :: dza !< The change in the geopotential anomaly across - !! the layer [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! the layer [L2 T-2 ~> m2 s-2] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(inout) :: intp_dza !< The integral in pressure through the layer of the !! geopotential anomaly relative to the anomaly at the bottom of the - !! layer [R L4 T-4 ~> Pa m2 s-2] or [Pa m2 s-2] + !! layer [R L4 T-4 ~> Pa m2 s-2] real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(inout) :: intx_dza !< The integral in x of the difference between the !! geopotential anomaly at the top and bottom of the layer divided by - !! the x grid spacing [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! the x grid spacing [L2 T-2 ~> m2 s-2] real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & optional, intent(inout) :: inty_dza !< The integral in y of the difference between the !! geopotential anomaly at the top and bottom of the layer divided by - !! the y grid spacing [L2 T-2 ~> m2 s-2] or [m2 s-2] + !! the y grid spacing [L2 T-2 ~> m2 s-2] integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] real, optional, intent(in) :: dP_tiny !< A miniscule pressure change with - !! the same units as p_t [R L2 T-2 ~> Pa] or [Pa] + !! the same units as p_t [R L2 T-2 ~> Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -1193,18 +1196,18 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m] - real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3] or [kg m-3], that is + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is !! subtracted out to reduce the magnitude of each of the !! integrals. - real, intent(in) :: rho_0 !< A density [R ~> kg m-3] or [kg m-3], that is used + real, intent(in) :: rho_0 !< A density [R ~> kg m-3], that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration - !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] + !! [L2 Z-1 T-2 ~> m s-2] type(EOS_type), intent(in) :: EOS !< Equation of state structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(inout) :: dpa !< The change in the pressure anomaly - !! across the layer [R L2 T-2 ~> Pa] or [Pa] + !! across the layer [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(inout) :: intz_dpa !< The integral through the thickness of the !! layer of the pressure anomaly relative to the From 3a9d51163ba33ea0e7c53e38e443f58a615fd799 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 26 Apr 2022 13:30:12 -0400 Subject: [PATCH 04/68] Revise how the drho_dT diagnostic is calculated Revised the calculation of the drho_dT and drho_dS diagnostics to use dimensional consistency testing, along with the newer interface to calculate_density that takes dimensionally rescaled arguments. With this change, the units of most the variables in this section of code match their descriptions in comments, although there is still the local re-use of some 3-d arrays as temporaries with units that do not match. All answers and output are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 9c22ab5eb5..6d5417e9cb 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -326,7 +326,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & work_3d(i,j,k) = GV%H_to_kg_m2*h(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_masscello, work_3d, CS%diag) - !### If the registration call has conversion=GV%H_to_kg, the mathematically equivalent form would be: + !### If the registration call has conversion=GV%H_to_kg_m2, the mathematically equivalent form would be: ! call post_data(CS%id_masscello, h, CS%diag) endif @@ -628,7 +628,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & do k=1,nz pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure in middle of layer k call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & - tv%eqn_of_state, EOSdom) + tv%eqn_of_state, EOSdom) pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure at bottom of layer k enddo enddo @@ -640,11 +640,11 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & do j=js,je pressure_1d(:) = 0. ! Start at p=0 Pa at surface do k=1,nz - pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * GV%H_to_Pa ! Pressure in middle of layer k + pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure in middle of layer k ! To avoid storing more arrays, put drho_dT into Rcv, and drho_dS into work3d - call calculate_density_derivs(tv%T(:,j,k),tv%S(:,j,k),pressure_1d, & - Rcv(:,j,k),work_3d(:,j,k),is,ie-is+1, tv%eqn_of_state) - pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * GV%H_to_Pa ! Pressure at bottom of layer k + call calculate_density_derivs(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, & + Rcv(:,j,k), work_3d(:,j,k), tv%eqn_of_state, EOSdom) + pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure at bottom of layer k enddo enddo if (CS%id_drho_dT > 0) call post_data(CS%id_drho_dT, Rcv, CS%diag) @@ -1669,9 +1669,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_rhoinsitu = register_diag_field('ocean_model', 'rhoinsitu', diag%axesTL, Time, & 'In situ density', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_drho_dT = register_diag_field('ocean_model', 'drho_dT', diag%axesTL, Time, & - 'Partial derivative of rhoinsitu with respect to temperature (alpha)', 'kg m-3 degC-1') + 'Partial derivative of rhoinsitu with respect to temperature (alpha)', & + 'kg m-3 degC-1', conversion=US%R_to_kg_m3) CS%id_drho_dS = register_diag_field('ocean_model', 'drho_dS', diag%axesTL, Time, & - 'Partial derivative of rhoinsitu with respect to salinity (beta)', 'kg^2 g-1 m-3') + 'Partial derivative of rhoinsitu with respect to salinity (beta)', & + 'kg^2 g-1 m-3', conversion=US%R_to_kg_m3) CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) From 75ebb4090e6f73c602dcd9e2b9a8818ad5baa9f2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 26 Apr 2022 14:51:28 -0400 Subject: [PATCH 05/68] +Refactored MOM_density_integrals Refactored MOM_density_integrals to use the newer calculate_density_1d() and calculated_stanley_density_1d() interfaces to the equation of state routines, and to thereby shift all related dimensional rescaling into MOM_EOS.F90. Also revised the comments describing the arguments to a number of the equation of state routines to eliminate confusing options and clearly indicate the units of each input and output variable. As a part of this change, the units of the rho_ref argument to calculate_stanley_density_1d were changed from [kg m-3] to [R ~> kg m-3] to match the equivalent routine calculate_density_1d(). Because this does not appear to have been used previously, this should not be a problem, and answers will not change unless a dimensional consistency test is underway. All answers are bitwise identical, but there is one minor change to the rescaled units of one apparently unused optional argument. --- src/core/MOM_density_integrals.F90 | 253 ++++++++--------------------- src/equation_of_state/MOM_EOS.F90 | 119 +++++++------- 2 files changed, 129 insertions(+), 243 deletions(-) diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 5ef04ad280..cfb61e897b 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -140,14 +140,12 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & ! Local variables real :: T5(5), S5(5) ! Temperatures and salinities at five quadrature points [degC] and [ppt] - real :: p5(5) ! Pressures at five quadrature points, never rescaled from Pa [Pa] + real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] real :: r5(5) ! Densities at five quadrature points [R ~> kg m-3] real :: rho_anom ! The depth averaged density anomaly [R ~> kg m-3] real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. - real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] + real :: GxRho ! The product of the gravitational acceleration and reference density [R L2 Z-1 T-2 ~> Pa m-1] real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] - real :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] - real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] real :: dz ! The layer thickness [Z ~> m] real :: z0pres ! The height at which the pressure is zero [Z ~> m] real :: hWght ! A pressure-thickness below topography [Z ~> m] @@ -171,9 +169,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & is = HI%isc ; ie = HI%iec js = HI%jsc ; je = HI%jec - rho_scale = US%kg_m3_to_R - GxRho = US%RL2_T2_to_Pa * G_e * rho_0 - rho_ref_mks = rho_ref * US%R_to_kg_m3 + GxRho = G_e * rho_0 I_Rho = 1.0 / rho_0 z0pres = 0.0 ; if (present(Z_0p)) z0pres = Z_0p use_rho_ref = .true. @@ -197,19 +193,11 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & p5(n) = -GxRho*((z_t(i,j) - z0pres) - 0.25*real(n-1)*dz) enddo if (use_rho_ref) then - if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref=rho_ref_mks, scale=rho_scale) - else - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref=rho_ref_mks) - endif + call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref) ! Use Boole's rule to estimate the pressure anomaly change. rho_anom = C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) else - if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, scale=rho_scale) - else - call calculate_density(T5, S5, p5, r5, 1, 5, EOS) - endif + call calculate_density(T5, S5, p5, r5, EOS) ! Use Boole's rule to estimate the pressure anomaly change. rho_anom = C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) - rho_ref endif @@ -253,19 +241,11 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = p5(n-1) + GxRho*0.25*dz enddo if (use_rho_ref) then - if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref=rho_ref_mks, scale=rho_scale) - else - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref=rho_ref_mks) - endif + call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref) ! Use Boole's rule to estimate the pressure anomaly change. intz(m) = G_e*dz*( C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3))) else - if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, scale=rho_scale) - else - call calculate_density(T5, S5, p5, r5, 1, 5, EOS) - endif + call calculate_density(T5, S5, p5, r5, EOS) ! Use Boole's rule to estimate the pressure anomaly change. intz(m) = G_e*dz*( C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) - rho_ref ) endif @@ -309,19 +289,11 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & p5(n) = p5(n-1) + GxRho*0.25*dz enddo if (use_rho_ref) then - if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref=rho_ref_mks, scale=rho_scale) - else - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref=rho_ref_mks) - endif + call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref) ! Use Boole's rule to estimate the pressure anomaly change. intz(m) = G_e*dz*( C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3))) else - if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, scale=rho_scale) - else - call calculate_density(T5, S5, p5, r5, 1, 5, EOS) - endif + call calculate_density(T5, S5, p5, r5, EOS) ! Use Boole's rule to estimate the pressure anomaly change. intz(m) = G_e*dz*( C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) - rho_ref ) endif @@ -401,8 +373,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real :: T25((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS temperature variance along a line of subgrid locations [degC2] real :: TS5((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS temp-salt covariance along a line of subgrid locations [degC ppt] real :: S25((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS salinity variance along a line of subgrid locations [ppt2] - real :: p5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Pressures along a line of subgrid locations, never - ! rescaled from Pa [Pa] + real :: p5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Pressures along a line of subgrid locations [R L2 T-2 ~> Pa] real :: r5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Densities anomalies along a line of subgrid ! locations [R ~> kg m-3] real :: u5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Densities anomalies along a line of subgrid locations @@ -412,19 +383,16 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real :: T215((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS temperature variance along a line of subgrid locations [degC2] real :: TS15((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS temp-salt covariance along a line of subgrid locations [degC ppt] real :: S215((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS salinity variance along a line of subgrid locations [ppt2] - real :: p15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Pressures at an array of subgrid locations [Pa] - real :: r15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Densities at an array of subgrid locations - ! [R ~> kg m-3] + real :: p15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Pressures at an array of subgrid locations [R L2 T-2 ~> Pa] + real :: r15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Densities at an array of subgrid locations [R ~> kg m-3] real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim] real :: rho_anom ! A density anomaly [R ~> kg m-3] real :: w_left, w_right ! Left and right weights [nondim] real :: intz(5) ! The gravitational acceleration times the integrals of density ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] - real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] + real :: GxRho ! The product of the gravitational acceleration and reference density [R L2 Z-1 T-2 ~> Pa m-1] real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] - real :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] - real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] real :: dz(HI%iscB:HI%iecB+1) ! Layer thicknesses at tracer points [Z ~> m] real :: dz_x(5,HI%iscB:HI%iecB) ! Layer thicknesses along an x-line of subgrid locations [Z ~> m] real :: dz_y(5,HI%isc:HI%iec) ! Layer thicknesses along a y-line of subgrid locations [Z ~> m] @@ -439,14 +407,15 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & logical :: use_rho_ref ! Pass rho_ref to the equation of state for more accurate calculation ! of density anomalies. logical :: use_varT, use_varS, use_covarTS ! Logicals for SGS variances fields - integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n - integer :: pos + integer, dimension(2) :: EOSdom_q5 ! The 5-point q-point i-computational domain for the equation of state + integer, dimension(2) :: EOSdom_q15 ! The 3x5-point q-point i-computational domain for the equation of state + integer, dimension(2) :: EOSdom_h15 ! The 3x5-point h-point i-computational domain for the equation of state + + integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n, pos Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB - rho_scale = US%kg_m3_to_R - GxRho = US%RL2_T2_to_Pa * G_e * rho_0 - rho_ref_mks = rho_ref * US%R_to_kg_m3 + GxRho = G_e * rho_0 I_Rho = 1.0 / rho_0 z0pres = 0.0 ; if (present(Z_0p)) z0pres = Z_0p massWeightToggle = 0. @@ -474,6 +443,11 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & wt_b(n) = 1.0 - wt_t(n) enddo + ! Set the loop ranges for equation of state calculations at various points. + EOSdom_q5(1) = 1 ; EOSdom_q5(2) = (ieq-isq+2)*5 + EOSdom_q15(1) = 1 ; EOSdom_q15(2) = 15*(ieq-isq+1) + EOSdom_h15(1) = 1 ; EOSdom_h15(2) = 15*(HI%iec-HI%isc+1) + ! 1. Compute vertical integrals do j=Jsq,Jeq+1 do i = Isq,Ieq+1 @@ -489,27 +463,12 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & if (use_varS) S25(i*5+1:i*5+5) = tv%varS(i,j,k) enddo if (use_Stanley_eos) then - if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, T25, TS5, S25, r5, 1, (ieq-isq+2)*5, EOS, & - rho_ref=rho_ref_mks, scale=rho_scale) - else - call calculate_density(T5, S5, p5, T25, TS5, S25, r5, 1, (ieq-isq+2)*5, EOS, & - rho_ref=rho_ref_mks) - endif + call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, EOSdom_q5, rho_ref=rho_ref) else if (use_rho_ref) then - if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS, rho_ref=rho_ref_mks, & - scale=rho_scale) - else - call calculate_density(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS, rho_ref=rho_ref_mks) - endif + call calculate_density(T5, S5, p5, r5, EOS, EOSdom_q5, rho_ref=rho_ref) else - if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS, scale=rho_scale) - else - call calculate_density(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS) - endif + call calculate_density(T5, S5, p5, r5, EOS, EOSdom_q5) u5(:) = r5(:) - rho_ref endif endif @@ -606,27 +565,12 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & enddo if (use_stanley_eos) then - if (rho_scale /= 1.0) then - call calculate_density(T15, S15, p15, T215, TS15, S215, r15, 1, 15*(ieq-isq+1), EOS, & - rho_ref=rho_ref_mks, scale=rho_scale) - else - call calculate_density(T15, S15, p15, T215, TS15, S215, r15, 1, 15*(ieq-isq+1), EOS, & - rho_ref=rho_ref_mks) - endif + call calculate_density(T15, S15, p15, T215, TS15, S215, r15, EOS, EOSdom_q15, rho_ref=rho_ref) else if (use_rho_ref) then - if (rho_scale /= 1.0) then - call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, rho_ref=rho_ref_mks, & - scale=rho_scale) - else - call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, rho_ref=rho_ref_mks) - endif + call calculate_density(T15, S15, p15, r15, EOS, EOSdom_q15, rho_ref=rho_ref) else - if (rho_scale /= 1.0) then - call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, scale=rho_scale) - else - call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS) - endif + call calculate_density(T15, S15, p15, r15, EOS, EOSdom_q15) endif endif @@ -717,35 +661,16 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & enddo if (use_stanley_eos) then - if (rho_scale /= 1.0) then - call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), & - T215(15*HI%isc+1:), TS15(15*HI%isc+1:), S215(15*HI%isc+1:), & - r15(15*HI%isc+1:), 1, 15*(HI%iec-HI%isc+1), EOS, & - rho_ref=rho_ref_mks, scale=rho_scale) - else - call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), & - T215(15*HI%isc+1:), TS15(15*HI%isc+1:), S215(15*HI%isc+1:), & - r15(15*HI%isc+1:), 1, 15*(HI%iec-HI%isc+1), EOS, rho_ref=rho_ref_mks) - endif + call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), & + T215(15*HI%isc+1:), TS15(15*HI%isc+1:), S215(15*HI%isc+1:), & + r15(15*HI%isc+1:), EOS, EOSdom_h15, rho_ref=rho_ref) else if (use_rho_ref) then - if (rho_scale /= 1.0) then - call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), & - r15(15*HI%isc+1:), 1, 15*(HI%iec-HI%isc+1), EOS, & - rho_ref=rho_ref_mks, scale=rho_scale) - else - call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), & - r15(15*HI%isc+1:), 1, 15*(HI%iec-HI%isc+1), EOS, rho_ref=rho_ref_mks) - endif + call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), & + r15(15*HI%isc+1:), EOS, EOSdom_h15, rho_ref=rho_ref) else - if (rho_scale /= 1.0) then - call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), & - r15(15*HI%isc+1:), 1, 15*(HI%iec-HI%isc+1), EOS, & - scale=rho_scale) - else - call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), & - r15(15*HI%isc+1:), 1, 15*(HI%iec-HI%isc+1), EOS) - endif + call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), & + r15(15*HI%isc+1:), EOS, EOSdom_h15) endif endif @@ -841,7 +766,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real :: T25(5) ! SGS temperature variance along a line of subgrid locations [degC2] real :: TS5(5) ! SGS temperature-salinity covariance along a line of subgrid locations [degC ppt] real :: S25(5) ! SGS salinity variance along a line of subgrid locations [ppt2] - real :: p5(5) ! Pressures at five quadrature points, never rescaled from Pa [Pa] + real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] real :: r5(5) ! Density anomalies from rho_ref at quadrature points [R ~> kg m-3] real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim] real :: rho_anom ! The integrated density anomaly [R ~> kg m-3] @@ -849,10 +774,8 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real :: intz(5) ! The gravitational acceleration times the integrals of density ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. - real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] + real :: GxRho ! The gravitational acceleration times density [R L2 Z-1 T-2 ~> kg m-2 s-2] real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] - real :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] - real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] real :: dz ! Layer thicknesses at tracer points [Z ~> m] real :: massWeightToggle ! A non-dimensional toggle factor (0 or 1) [nondim] real :: Ttl, Tbl, Tml, Ttr, Tbr, Tmr ! Temperatures at the velocity cell corners [degC] @@ -872,9 +795,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB - rho_scale = US%kg_m3_to_R - GxRho = US%RL2_T2_to_Pa * G_e * rho_0 - rho_ref_mks = rho_ref * US%R_to_kg_m3 + GxRho = G_e * rho_0 I_Rho = 1.0 / rho_0 z0pres = 0.0 ; if (present(Z_0p)) z0pres = Z_0p massWeightToggle = 0. @@ -918,10 +839,9 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & if (use_varT) T25(:) = tv%varT(i,j,k) if (use_covarTS) TS5(:) = tv%covarTS(i,j,k) if (use_varS) S25(:) = tv%varS(i,j,k) - call calculate_density(T5, S5, p5, T25, TS5, S25, r5, & - 1, 5, EOS, rho_ref=rho_ref_mks, scale=rho_scale) + call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, rho_ref=rho_ref) else - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref=rho_ref_mks, scale=rho_scale) + call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref) endif ! Use Boole's rule to estimate the pressure anomaly change. @@ -1007,10 +927,9 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & if (use_varT) T25(:) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i+1,j,k) if (use_covarTS) TS5(:) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i+1,j,k) if (use_varS) S25(:) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i+1,j,k) - call calculate_density(T5, S5, p5, T25, TS5, S25, r5, & - 1, 5, EOS, rho_ref=rho_ref_mks, scale=rho_scale) + call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, rho_ref=rho_ref) else - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref=rho_ref_mks, scale=rho_scale) + call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref) endif ! Use Boole's rule to estimate the pressure anomaly change. @@ -1095,10 +1014,9 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & if (use_varT) T25(:) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i,j+1,k) if (use_covarTS) TS5(:) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i,j+1,k) if (use_varS) S25(:) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i,j+1,k) - call calculate_density(T5, S5, p5, T25, TS5, S25, r5, & - 1, 5, EOS, rho_ref=rho_ref_mks, scale=rho_scale) + call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, rho_ref=rho_ref) else - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref=rho_ref_mks, scale=rho_scale) + call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref) endif ! Use Boole's rule to estimate the pressure anomaly change. @@ -1229,13 +1147,12 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d ! Local variables real :: T5(5) ! Temperatures at five quadrature points [degC] real :: S5(5) ! Salinities at five quadrature points [ppt] - real :: p5(5) ! Pressures at five quadrature points, scaled back to Pa if necessary [Pa] + real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1] real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1] real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa] real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa] real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [R L2 T-2 ~> Pa] - real :: alpha_ref_mks ! The reference specific volume in MKS units, never rescaled from m3 kg-1 [m3 kg-1] real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2] real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim] real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim] @@ -1243,9 +1160,6 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim] real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations [L2 T-2 ~> m2 s-2] - real :: RL2_T2_to_Pa ! A unit conversion factor from the rescaled units of pressure to Pa [Pa T2 R-1 L-2 ~> 1] - real :: SV_scale ! A multiplicative factor by which to scale specific - ! volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_90 = 1.0/90.0 ! A rational constant. integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, n, halo @@ -1256,10 +1170,6 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh); endif if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh); endif - SV_scale = US%R_to_kg_m3 - RL2_T2_to_Pa = US%RL2_T2_to_Pa - alpha_ref_mks = alpha_ref * US%kg_m3_to_R - do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then do_massWeight = .true. @@ -1273,14 +1183,10 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d dp = p_b(i,j) - p_t(i,j) do n=1,5 T5(n) = T(i,j) ; S5(n) = S(i,j) - p5(n) = RL2_T2_to_Pa * (p_b(i,j) - 0.25*real(n-1)*dp) + p5(n) = p_b(i,j) - 0.25*real(n-1)*dp enddo - if (SV_scale /= 1.0) then - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks, scale=SV_scale) - else - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks) - endif + call calculate_spec_vol(T5, S5, p5, a5, EOS, spv_ref=alpha_ref) ! Use Boole's rule to estimate the interface height anomaly change. alpha_anom = C1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + 12.0*a5(3)) @@ -1316,19 +1222,15 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d ! T, S, and p are interpolated in the horizontal. The p interpolation ! is linear, but for T and S it may be thickness weighted. - p5(1) = RL2_T2_to_Pa * (wt_L*p_b(i,j) + wt_R*p_b(i+1,j)) + p5(1) = wt_L*p_b(i,j) + wt_R*p_b(i+1,j) dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j)) T5(1) = wtT_L*T(i,j) + wtT_R*T(i+1,j) S5(1) = wtT_L*S(i,j) + wtT_R*S(i+1,j) do n=2,5 - T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = p5(n-1) - RL2_T2_to_Pa * 0.25*dp + T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = p5(n-1) - 0.25*dp enddo - if (SV_scale /= 1.0) then - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks, scale=SV_scale) - else - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks) - endif + call calculate_spec_vol(T5, S5, p5, a5, EOS, spv_ref=alpha_ref) ! Use Boole's rule to estimate the interface height anomaly change. intp(m) = dp*( C1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + & @@ -1364,18 +1266,14 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d ! T, S, and p are interpolated in the horizontal. The p interpolation ! is linear, but for T and S it may be thickness weighted. - p5(1) = RL2_T2_to_Pa * (wt_L*p_b(i,j) + wt_R*p_b(i,j+1)) + p5(1) = wt_L*p_b(i,j) + wt_R*p_b(i,j+1) dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1)) T5(1) = wtT_L*T(i,j) + wtT_R*T(i,j+1) S5(1) = wtT_L*S(i,j) + wtT_R*S(i,j+1) do n=2,5 - T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = RL2_T2_to_Pa * (p5(n-1) - 0.25*dp) + T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = p5(n-1) - 0.25*dp enddo - if (SV_scale /= 1.0) then - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks, scale=SV_scale) - else - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks) - endif + call calculate_spec_vol(T5, S5, p5, a5, EOS, spv_ref=alpha_ref) ! Use Boole's rule to estimate the interface height anomaly change. intp(m) = dp*( C1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + & @@ -1446,24 +1344,22 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: T5(5) ! Temperatures at five quadrature points [degC] real :: S5(5) ! Salinities at five quadrature points [ppt] - real :: p5(5) ! Pressures at five quadrature points, scaled back to Pa as necessary [Pa] + real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1] real :: T15(15) ! Temperatures at fifteen interior quadrature points [degC] real :: S15(15) ! Salinities at fifteen interior quadrature points [ppt] - real :: p15(15) ! Pressures at fifteen quadrature points, scaled back to Pa as necessary [Pa] + real :: p15(15) ! Pressures at fifteen quadrature points [R L2 T-2 ~> Pa] real :: a15(15) ! Specific volumes at fifteen quadrature points [R-1 ~> m3 kg-1] real :: wt_t(5), wt_b(5) ! Weights of top and bottom values at quadrature points [nondim] real :: T_top, T_bot ! Horizontally interpolated temperature at the cell top and bottom [degC] real :: S_top, S_bot ! Horizontally interpolated salinity at the cell top and bottom [ppt] - real :: P_top, P_bot ! Horizontally interpolated pressure at the cell top and bottom, - ! scaled back to Pa as necessary [Pa] + real :: P_top, P_bot ! Horizontally interpolated pressure at the cell top and bottom [R L2 T-2 ~> Pa] real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1] real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa] real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [R L2 T-2 ~> Pa] real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa] real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [R L2 T-2 ~> Pa] - real :: alpha_ref_mks ! The reference specific volume in MKS units, never rescaled from m3 kg-1 [m3 kg-1] real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2] real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim] real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim] @@ -1471,10 +1367,7 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim] real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations [L2 T-2 ~> m2 s-2] - real :: RL2_T2_to_Pa ! A unit conversion factor from the rescaled units of pressure to Pa [Pa T2 R-1 L-2 ~> 1] - real :: SV_scale ! A multiplicative factor by which to scale specific - ! volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] - real, parameter :: C1_90 = 1.0/90.0 ! A rational constant. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] logical :: do_massWeight ! Indicates whether to do mass weighting. integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n, pos @@ -1483,10 +1376,6 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, do_massWeight = .false. if (present(useMassWghtInterp)) do_massWeight = useMassWghtInterp - SV_scale = US%R_to_kg_m3 - RL2_T2_to_Pa = US%RL2_T2_to_Pa - alpha_ref_mks = alpha_ref * US%kg_m3_to_R - do n = 1, 5 ! Note that these are reversed from int_density_dz. wt_t(n) = 0.25 * real(n-1) wt_b(n) = 1.0 - wt_t(n) @@ -1496,15 +1385,11 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dp = p_b(i,j) - p_t(i,j) do n=1,5 ! T, S and p are linearly interpolated in the vertical. - p5(n) = RL2_T2_to_Pa * (wt_t(n) * p_t(i,j) + wt_b(n) * p_b(i,j)) + p5(n) = wt_t(n) * p_t(i,j) + wt_b(n) * p_b(i,j) S5(n) = wt_t(n) * S_t(i,j) + wt_b(n) * S_b(i,j) T5(n) = wt_t(n) * T_t(i,j) + wt_b(n) * T_b(i,j) enddo - if (SV_scale /= 1.0) then - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks, scale=SV_scale) - else - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks) - endif + call calculate_spec_vol(T5, S5, p5, a5, EOS, spv_ref=alpha_ref) ! Use Boole's rule to estimate the interface height anomaly change. alpha_anom = C1_90*((7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4))) + 12.0*a5(3)) @@ -1553,17 +1438,13 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, ! Salinity, temperature and pressure with linear interpolation in the vertical. pos = (m-2)*5 do n=1,5 - p15(pos+n) = RL2_T2_to_Pa * (wt_t(n) * P_top + wt_b(n) * P_bot) + p15(pos+n) = wt_t(n) * P_top + wt_b(n) * P_bot S15(pos+n) = wt_t(n) * S_top + wt_b(n) * S_bot T15(pos+n) = wt_t(n) * T_top + wt_b(n) * T_bot enddo enddo - if (SV_scale /= 1.0) then - call calculate_spec_vol(T15, S15, p15, a15, 1, 15, EOS, alpha_ref_mks, scale=SV_scale) - else - call calculate_spec_vol(T15, S15, p15, a15, 1, 15, EOS, alpha_ref_mks) - endif + call calculate_spec_vol(T15, S15, p15, a15, EOS, spv_ref=alpha_ref) intp(1) = dza(i,j) ; intp(5) = dza(i+1,j) do m=2,4 @@ -1614,17 +1495,13 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, ! Salinity, temperature and pressure with linear interpolation in the vertical. pos = (m-2)*5 do n=1,5 - p15(pos+n) = RL2_T2_to_Pa * (wt_t(n) * P_top + wt_b(n) * P_bot) + p15(pos+n) = wt_t(n) * P_top + wt_b(n) * P_bot S15(pos+n) = wt_t(n) * S_top + wt_b(n) * S_bot T15(pos+n) = wt_t(n) * T_top + wt_b(n) * T_bot enddo enddo - if (SV_scale /= 1.0) then - call calculate_spec_vol(T15, S15, p15, a15, 1, 15, EOS, alpha_ref_mks, scale=SV_scale) - else - call calculate_spec_vol(T15, S15, p15, a15, 1, 15, EOS, alpha_ref_mks) - endif + call calculate_spec_vol(T15, S15, p15, a15, EOS, spv_ref=alpha_ref) intp(1) = dza(i,j) ; intp(5) = dza(i,j+1) do m=2,4 diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index e1814fc000..a13fd7e2b4 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -64,26 +64,26 @@ module MOM_EOS !> Calculates density of sea water from T, S and P interface calculate_density - module procedure calculate_density_scalar, calculate_density_array, calculate_density_1d + module procedure calculate_density_scalar, calculate_density_1d, calculate_density_array module procedure calculate_stanley_density_scalar, calculate_stanley_density_array module procedure calculate_stanley_density_1d end interface calculate_density !> Calculates specific volume of sea water from T, S and P interface calculate_spec_vol - module procedure calc_spec_vol_scalar, calculate_spec_vol_array, & - calc_spec_vol_1d + module procedure calc_spec_vol_scalar, calculate_spec_vol_array + module procedure calc_spec_vol_1d end interface calculate_spec_vol !> Calculate the derivatives of density with temperature and salinity from T, S, and P interface calculate_density_derivs - module procedure calculate_density_derivs_scalar, calculate_density_derivs_array, & - calculate_density_derivs_1d + module procedure calculate_density_derivs_scalar, calculate_density_derivs_array + module procedure calculate_density_derivs_1d end interface calculate_density_derivs !> Calculate the derivatives of specific volume with temperature and salinity from T, S, and P interface calculate_specific_vol_derivs - module procedure calculate_spec_vol_derivs_array, calc_spec_vol_derivs_1d + module procedure calc_spec_vol_derivs_1d, calculate_spec_vol_derivs_array end interface calculate_specific_vol_derivs !> Calculates the second derivatives of density with various combinations of temperature, @@ -163,11 +163,11 @@ module MOM_EOS subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] - real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] + real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] + real, intent(out) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density in + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale output density in !! combination with scaling given by US [various] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] @@ -209,12 +209,12 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r real, intent(in) :: Tvar !< Variance of potential temperature referenced to the surface [degC2] real, intent(in) :: TScov !< Covariance of potential temperature and salinity [degC ppt] real, intent(in) :: Svar !< Variance of salinity [ppt2] - real, intent(in) :: pressure !< Pressure [Pa] - real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] + real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] + real, intent(out) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! from kg m-3 to the desired units [R m3 kg-1] + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale output density in + !! combination with scaling given by US [various] ! Local variables real :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] @@ -261,8 +261,8 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re integer, intent(in) :: npts !< Number of point to compute type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! in combination with scaling given by US [various] + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale the output + !! density, perhaps to other units than kg m-3 [various] integer :: j select case (EOS%form_of_EOS) @@ -304,8 +304,8 @@ subroutine calculate_stanley_density_array(T, S, pressure, Tvar, TScov, Svar, rh integer, intent(in) :: npts !< Number of point to compute type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! from kg m-3 to the desired units [R m3 kg-1] + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale the output + !! density, perhaps to other units than kg m-3 [various] ! Local variables real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p integer :: j @@ -357,7 +357,6 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) ! Local variables real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - real :: rho_unscale ! A factor to convert density from R to kg m-3 [kg m-3 R-1 ~> 1] real :: rho_reference ! rho_ref converted to [kg m-3] real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] integer :: i, is, ie, npts @@ -369,13 +368,12 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) endif p_scale = EOS%RL2_T2_to_Pa - rho_unscale = EOS%R_to_kg_m3 - if ((p_scale == 1.0) .and. (rho_unscale == 1.0)) then + if ((p_scale == 1.0) .and. (EOS%R_to_kg_m3 == 1.0)) then call calculate_density_array(T, S, pressure, rho, is, npts, EOS, rho_ref=rho_ref) elseif (present(rho_ref)) then ! This is the same as above, but with some extra work to rescale variables. do i=is,ie ; pres(i) = p_scale * pressure(i) ; enddo - rho_reference = rho_unscale*rho_ref + rho_reference = EOS%R_to_kg_m3*rho_ref call calculate_density_array(T, S, pres, rho, is, npts, EOS, rho_ref=rho_reference) else ! There is rescaling of variables, but rho_ref is not present. Passing a 0 value of rho_ref ! changes answers at roundoff for some equations of state, like Wright and UNESCO. @@ -408,12 +406,13 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] + real, optional, intent(in) :: rho_ref !< A reference density [R ~> kg m-3] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] + real :: rho_reference ! rho_ref converted to [kg m-3] real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p integer :: i, is, ie, npts @@ -429,18 +428,23 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, pres(i) = p_scale * pressure(i) enddo + ! Rho_ref is seems like it is always present when calculate_Stanley_density is called, so + ! always set rho_reference, even though a 0 value can change answers at roundoff with + ! some equations of state. + rho_reference = 0.0 ; if (present(rho_ref)) rho_reference = EOS%R_to_kg_m3*rho_ref + select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_linear(T, S, pres, rho, 1, npts, & - EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_ref) + EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_reference) call calculate_density_second_derivs_linear(T, S, pres, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP, 1, npts) case (EOS_WRIGHT) - call calculate_density_wright(T, S, pres, rho, 1, npts, rho_ref) + call calculate_density_wright(T, S, pres, rho, 1, npts, rho_reference) call calculate_density_second_derivs_wright(T, S, pres, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP, 1, npts) case (EOS_TEOS10) - call calculate_density_teos10(T, S, pres, rho, 1, npts, rho_ref) + call calculate_density_teos10(T, S, pres, rho, 1, npts, rho_reference) call calculate_density_second_derivs_teos10(T, S, pres, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP, 1, npts) case default @@ -510,10 +514,11 @@ end subroutine calculate_spec_vol_array subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] - real, intent(out) :: specvol !< In situ? specific volume [m3 kg-1] or [R-1 ~> m3 kg-1] + real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] + real, intent(out) :: specvol !< In situ or potential specific volume [R-1 ~> m3 kg-1] + !! or other units determined by the scale argument type(EOS_type), intent(in) :: EOS !< Equation of state structure - real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] or [R-1 m3 kg-1] + real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 m3 kg-1] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] @@ -595,7 +600,7 @@ end subroutine calc_spec_vol_1d !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs. subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] + real, intent(in) :: pressure !< Pressure, in [Pa] or [R L2 T-2 ~> Pa] depending on pres_scale real, intent(out) :: T_fr !< Freezing point potential temperature referenced !! to the surface [degC] type(EOS_type), intent(in) :: EOS !< Equation of state structure @@ -624,7 +629,7 @@ end subroutine calculate_TFreeze_scalar !> Calls the appropriate subroutine to calculate the freezing point for a 1-D array. subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_scale) real, dimension(:), intent(in) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] + real, dimension(:), intent(in) :: pressure !< Pressure, in [Pa] or [R L2 T-2 ~> Pa] depending on pres_scale real, dimension(:), intent(inout) :: T_fr !< Freezing point potential temperature referenced !! to the surface [degC] integer, intent(in) :: start !< Starting index within the array @@ -673,11 +678,13 @@ end subroutine calculate_TFreeze_array subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] real, dimension(:), intent(inout) :: drho_dT !< The partial derivative of density with potential - !! temperature [kg m-3 degC-1] or [R degC-1 ~> kg m-3 degC-1] + !! temperature [kg m-3 degC-1] or other units determined + !! by the optional scale argument real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 ppt-1] or [R ppt-1 ~> kg m-3 ppt-1] + !! in [kg m-3 ppt-1] or other units determined + !! by the optional scale argument integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), intent(in) :: EOS !< Equation of state structure @@ -761,11 +768,13 @@ end subroutine calculate_density_derivs_1d subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] + real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, intent(out) :: drho_dT !< The partial derivative of density with potential - !! temperature [kg m-3 degC-1] or [R degC-1 ~> kg m-3 degC-1] + !! temperature [R degC-1 ~> kg m-3 degC-1] or other + !! units determined by the optional scale argument real, intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 ppt-1] or [R ppt-1 ~> kg m-3 ppt-1] + !! in [R ppt-1 ~> kg m-3 ppt-1] or other units + !! determined by the optional scale argument type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] @@ -801,17 +810,17 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh drho_dS_dP, drho_dT_dP, start, npts, EOS, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] + real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: drho_dS_dS !< Partial derivative of beta with respect to S - !! [kg m-3 ppt-2] or [R ppt-2 ~> kg m-3 ppt-2] + !! [R ppt-2 ~> kg m-3 ppt-2] real, dimension(:), intent(inout) :: drho_dS_dT !< Partial derivative of beta with respect to T - !! [kg m-3 ppt-1 degC-1] or [R ppt-1 degC-1 ~> kg m-3 ppt-1 degC-1] + !! [R ppt-1 degC-1 ~> kg m-3 ppt-1 degC-1] real, dimension(:), intent(inout) :: drho_dT_dT !< Partial derivative of alpha with respect to T - !! [kg m-3 degC-2] or [R degC-2 ~> kg m-3 degC-2] + !! [R degC-2 ~> kg m-3 degC-2] real, dimension(:), intent(inout) :: drho_dS_dP !< Partial derivative of beta with respect to pressure - !! [kg m-3 ppt-1 Pa-1] or [R ppt-1 Pa-1 ~> kg m-3 ppt-1 Pa-1] + !! [T2 ppt-1 L-2 ~> kg m-3 ppt-1 Pa-1] real, dimension(:), intent(inout) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure - !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] + !! [T2 degC-1 L-2 ~> kg m-3 degC-1 Pa-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), intent(in) :: EOS !< Equation of state structure @@ -882,17 +891,17 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr drho_dS_dP, drho_dT_dP, EOS, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] + real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S - !! [kg m-3 ppt-2] or [R ppt-2 ~> kg m-3 ppt-2] + !! [R ppt-2 ~> kg m-3 ppt-2] real, intent(out) :: drho_dS_dT !< Partial derivative of beta with respect to T - !! [kg m-3 ppt-1 degC-1] or [R ppt-1 degC-1 ~> kg m-3 ppt-1 degC-1] + !! [R ppt-1 degC-1 ~> kg m-3 ppt-1 degC-1] real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T - !! [kg m-3 degC-2] or [R degC-2 ~> kg m-3 degC-2] + !! [R degC-2 ~> kg m-3 degC-2] real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure - !! [kg m-3 ppt-1 Pa-1] or [R ppt-1 Pa-1 ~> kg m-3 ppt-1 Pa-1] + !! [T2 ppt-1 L-2 ~> kg m-3 ppt-1 Pa-1] real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure - !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] + !! [T2 degC-1 L-2 ~> kg m-3 degC-1 Pa-1] type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] @@ -1032,12 +1041,12 @@ end subroutine calc_spec_vol_derivs_1d !! inputs. If US is present, the units of the inputs and outputs are rescaled. subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(:), intent(in) :: S !< Salinity [PSU] - real, dimension(:), intent(in) :: press !< Pressure [Pa] or [R L2 T-2 ~> Pa] - real, dimension(:), intent(inout) :: rho !< In situ density [kg m-3] or [R ~> kg m-3] + real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: press !< Pressure [R L2 T-2 ~> Pa] + real, dimension(:), intent(inout) :: rho !< In situ density [R ~> kg m-3] real, dimension(:), intent(inout) :: drho_dp !< The partial derivative of density with pressure !! (also the inverse of the square of sound speed) - !! [s2 m-2] or [T2 L-2] + !! [T2 L-2 ~> s2 m-2] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), intent(in) :: EOS !< Equation of state structure @@ -1080,10 +1089,10 @@ end subroutine calculate_compress_array subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] - real, intent(out) :: rho !< In situ density [kg m-3] or [R ~> kg m-3] + real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] + real, intent(out) :: rho !< In situ density [R ~> kg m-3] real, intent(out) :: drho_dp !< The partial derivative of density with pressure (also the - !! inverse of the square of sound speed) [s2 m-2] or [T2 L-2] + !! inverse of the square of sound speed) [T2 L-2 ~> s2 m-2] type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables From f51355476a773b2b90d9ccaf1b973db3c37fc983 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 27 Apr 2022 03:52:11 -0400 Subject: [PATCH 06/68] Clarify argument units for int_density_dz_wright Modified the comments describing the units of the arguments to int_density_dz_wright, int_spec_vol_dp_wright int_density_dz_linear and int_spec_vol_dp_linear so that they reflect the units as they are used in practice where they are called from analytic_int_density_dz or analytic_int_specific_vol_dp. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS_Wright.F90 | 27 ++++++----- src/equation_of_state/MOM_EOS_linear.F90 | 58 ++++++++++++------------ 2 files changed, 42 insertions(+), 43 deletions(-) diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index 8293cf5d32..4b22a112db 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -419,17 +419,17 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3] or [kg m-3], that is subtracted + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is subtracted !! out to reduce the magnitude of each of the integrals. !! (The pressure is calucated as p~=-z*rho_0*G_e.) - real, intent(in) :: rho_0 !< Density [R ~> kg m-3] or [kg m-3], that is used + real, intent(in) :: rho_0 !< Density [R ~> kg m-3], that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration - !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(inout) :: dpa !< The change in the pressure anomaly across the - !! layer [R L2 T-2 ~> Pa] or [Pa]. + !! layer [R L2 T-2 ~> Pa]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(inout) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly @@ -473,9 +473,9 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intz(5) ! The gravitational acceleration times the integrals of density - ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] or [Pa]. + ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa]. real :: Pa_to_RL2_T2 ! A conversion factor of pressures from Pa to the output units indicated by - ! pres_scale [R L2 T-2 Pa-1 ~> 1] or [1]. + ! pres_scale [R L2 T-2 Pa-1 ~> 1]. real :: z0pres ! The height at which the pressure is zero [Z ~> m] logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. @@ -637,37 +637,36 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: S !< Salinity [PSU]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [Pa]. + intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [Pa]. + intent(in) :: p_b !< Pressure at the top of the layer [R L2 T-2 ~> Pa] real, intent(in) :: spv_ref !< A mean specific volume that is subtracted out !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1]. !! The calculation is mathematically identical with different values of !! spv_ref, but this reduces the effects of roundoff. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(inout) :: dza !< The change in the geopotential anomaly across - !! the layer [T-2 ~> m2 s-2] or [m2 s-2]. + !! the layer [L2 T-2 ~> m2 s-2]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(inout) :: intp_dza !< The integral in pressure through the layer of !! the geopotential anomaly relative to the anomaly !! at the bottom of the layer [R L4 T-4 ~> Pa m2 s-2] - !! or [Pa m2 s-2]. real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(inout) :: intx_dza !< The integral in x of the difference between the !! geopotential anomaly at the top and bottom of !! the layer divided by the x grid spacing - !! [L2 T-2 ~> m2 s-2] or [m2 s-2]. + !! [L2 T-2 ~> m2 s-2]. real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & optional, intent(inout) :: inty_dza !< The integral in y of the difference between the !! geopotential anomaly at the top and bottom of !! the layer divided by the y grid spacing - !! [L2 T-2 ~> m2 s-2] or [m2 s-2]. + !! [L2 T-2 ~> m2 s-2]. integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate !! dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t [R L2 T-2 ~> Pa] or [Pa] + !! the same units as p_t [R L2 T-2 ~> Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. real, optional, intent(in) :: SV_scale !< A multiplicative factor by which to scale specific diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index c56c397a8d..5650481558 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -336,34 +336,34 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3] or [kg m-3], that + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that !! is subtracted out to reduce the magnitude of !! each of the integrals. real, intent(in) :: rho_0_pres !< A density [R ~> kg m-3], used to calculate !! the pressure (as p~=-z*rho_0_pres*G_e) used in !! the equation of state. rho_0_pres is not used. real, intent(in) :: G_e !< The Earth's gravitational acceleration - !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2]. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [R ~> kg m-3] or [kg m-3]. + !! [L2 Z-1 T-2 ~> m s-2] + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [R ~> kg m-3] real, intent(in) :: dRho_dT !< The derivative of density with temperature, - !! [R degC-1 ~> kg m-3 degC-1] or [kg m-3 degC-1]. + !! [R degC-1 ~> kg m-3 degC-1] real, intent(in) :: dRho_dS !< The derivative of density with salinity, - !! in [R ppt-1 ~> kg m-3 ppt-1] or [kg m-3 ppt-1]. + !! in [R ppt-1 ~> kg m-3 ppt-1] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the - !! layer [R L2 T-2 ~> Pa] or [Pa]. + !! layer [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer [R L2 Z T-2 ~> Pa m] or [Pa m]. + !! at the top of the layer [R L2 Z T-2 ~> Pa m] real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the - !! layer divided by the x grid spacing [R L2 T-2 ~> Pa] or [Pa]. + !! layer divided by the x grid spacing [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & optional, intent(out) :: inty_dpa !< The integral in y of the difference between the !! pressure anomaly at the top and bottom of the - !! layer divided by the y grid spacing [R L2 T-2 ~> Pa] or [Pa]. + !! layer divided by the y grid spacing [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. @@ -382,7 +382,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, & real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations [R L2 T-2 ~> Pa] or [Pa]. + ! 5 sub-column locations [R L2 T-2 ~> Pa] logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_6 = 1.0/6.0, C1_90 = 1.0/90.0 ! Rational constants. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m @@ -504,56 +504,56 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: S !< Salinity [PSU]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [Pa]. + intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [Pa]. + intent(in) :: p_b !< Pressure at the top of the layer [R L2 T-2 ~> Pa] real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1]. !! The calculation is mathematically identical with different values of !! alpha_ref, but this reduces the effects of roundoff. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [R ~> kg m-3] or [kg m-3]. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [R ~> kg m-3] real, intent(in) :: dRho_dT !< The derivative of density with temperature - !! [R degC-1 ~> kg m-3 degC-1] or [kg m-3 degC-1]. + !! [R degC-1 ~> kg m-3 degC-1] real, intent(in) :: dRho_dS !< The derivative of density with salinity, - !! in [R ppt-1 ~> kg m-3 ppt-1] or [kg m-3 ppt-1]. + !! in [R ppt-1 ~> kg m-3 ppt-1] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dza !< The change in the geopotential anomaly across - !! the layer [L2 T-2 ~> m2 s-2] or [m2 s-2]. + !! the layer [L2 T-2 ~> m2 s-2] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the layer of the !! geopotential anomaly relative to the anomaly at the - !! bottom of the layer [R L4 T-4 ~> Pa m2 s-2] or [Pa m2 s-2]. + !! bottom of the layer [R L4 T-4 ~> Pa m2 s-2] real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dza !< The integral in x of the difference between the !! geopotential anomaly at the top and bottom of !! the layer divided by the x grid spacing - !! [L2 T-2 ~> m2 s-2] or [m2 s-2]. + !! [L2 T-2 ~> m2 s-2] real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & optional, intent(out) :: inty_dza !< The integral in y of the difference between the !! geopotential anomaly at the top and bottom of !! the layer divided by the y grid spacing - !! [L2 T-2 ~> m2 s-2] or [m2 s-2]. + !! [L2 T-2 ~> m2 s-2] integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t [R L2 T-2 ~> Pa] or [Pa] + !! the same units as p_t [R L2 T-2 ~> Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. ! Local variables - real :: dRho_TS ! The density anomaly due to T and S [R ~> kg m-3] or [kg m-3]. - real :: alpha_anom ! The specific volume anomaly from 1/rho_ref [R-1 ~> m3 kg-1] or [m3 kg-1]. - real :: aaL, aaR ! The specific volume anomaly to the left and right [R-1 ~> m3 kg-1] or [m3 kg-1]. - real :: dp, dpL, dpR ! Layer pressure thicknesses [R L2 T-2 ~> Pa] or [Pa]. - real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa] or [Pa]. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [R L2 T-2 ~> Pa] or [Pa]. - real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2] or [Pa-2]. + real :: dRho_TS ! The density anomaly due to T and S [R ~> kg m-3] + real :: alpha_anom ! The specific volume anomaly from 1/rho_ref [R-1 ~> m3 kg-1] + real :: aaL, aaR ! The specific volume anomaly to the left and right [R-1 ~> m3 kg-1] + real :: dp, dpL, dpR ! Layer pressure thicknesses [R L2 T-2 ~> Pa] + real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa] + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [R L2 T-2 ~> Pa] + real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2] real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intp(5) ! The integrals of specific volume with pressure at the - ! 5 sub-column locations [L2 T-2 ~> m2 s-2] or [m2 s-2]. + ! 5 sub-column locations [L2 T-2 ~> m2 s-2] logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_6 = 1.0/6.0, C1_90 = 1.0/90.0 ! Rational constants. integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, halo From 0903609a6c9b499e313b9d55abc3cd00f620df94 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 27 Apr 2022 04:03:14 -0400 Subject: [PATCH 07/68] +Make equation of state interfaces more consistent This commit has several interface changes to some little-called equation of state routines to follow the patterns set by the most commonly used equation of state routines. All answers in test cases are bitwise identical. - Added calculate_TFreeze_1d to the overloaded interface calculate_TFreeze, with dimensional rescaling of its arguments taken from its EOS_type argument and an optional two-element domain, rather than two mandatory integer arguments used with calculate_TFreeze_array. The older interface is also retained within the overloaded interface to calculate_TFreeze. - Modified calculate_density_scalar and calculate_stanley_density_scalar to use units of [R ~> kg m-3] for its rho_ref optional argument, following the pattern from calculate_density_1d. These arguments were not previously used. - Renamed the internally visible routine calculate_density_second_derivs_array to calculate_density_second_derivs_1d and changed its argument list to take an optional two-element domain, rather than two mandatory integer arguments, to follow the pattern set by calculate_density_derivs_1d. Because this routine was only being called in two places the older interface is not being preserved in the overloaded interface calculate_density_second_derivs. - Renamed the internally visible routine calculate_compress_array to calculate_compress_1d and changed its argument list to take an optional two-element domain, rather than two mandatory integer arguments, to follow the pattern set by calculate_density_derivs_1d. Because this routine was only being called in one place the older interface is not being preserved in the overloaded interface calculate_compress. - Eliminated some unnecessary local variables (mostly p_scale) for brevity and code clarity. - Modified two calls to calculate_density_second_derivs in thickness_diffuse_full to use its revised interface. - Modified one call to calculate_compress in build_slight_column to use its revised interface. --- src/ALE/coord_slight.F90 | 2 +- src/equation_of_state/MOM_EOS.F90 | 258 ++++++++++-------- .../lateral/MOM_thickness_diffuse.F90 | 6 +- 3 files changed, 148 insertions(+), 118 deletions(-) diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 66c78d7c7a..6c2432d50d 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -375,7 +375,7 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_pres, H_subroundoff, & call calculate_density_derivs(T_int, S_int, p_R, drhoR_dT, drhoR_dS, & eqn_of_state, (/2,nz/) ) if (CS%compressibility_fraction > 0.0) then - call calculate_compress(T_int, S_int, p_R(:), rho_tmp, drho_dp, 2, nz-1, eqn_of_state) + call calculate_compress(T_int, S_int, p_R(:), rho_tmp, drho_dp, eqn_of_state, (/2,nz/)) else do K=2,nz ; drho_dp(K) = 0.0 ; enddo endif diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index a13fd7e2b4..7a70d7f1bd 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -89,17 +89,17 @@ module MOM_EOS !> Calculates the second derivatives of density with various combinations of temperature, !! salinity, and pressure from T, S and P interface calculate_density_second_derivs - module procedure calculate_density_second_derivs_scalar, calculate_density_second_derivs_array + module procedure calculate_density_second_derivs_scalar, calculate_density_second_derivs_1d end interface calculate_density_second_derivs !> Calculates the freezing point of sea water from T, S and P interface calculate_TFreeze - module procedure calculate_TFreeze_scalar, calculate_TFreeze_array + module procedure calculate_TFreeze_scalar, calculate_TFreeze_1d, calculate_TFreeze_array end interface calculate_TFreeze !> Calculates the compressibility of water from T, S, and P interface calculate_compress - module procedure calculate_compress_scalar, calculate_compress_array + module procedure calculate_compress_scalar, calculate_compress_1d end interface calculate_compress !> A control structure for the equation of state @@ -166,34 +166,28 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, intent(out) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] type(EOS_type), intent(in) :: EOS !< Equation of state structure - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] + real, optional, intent(in) :: rho_ref !< A reference density [R ~> kg m-3] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale output density in !! combination with scaling given by US [various] - real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - - p_scale = EOS%RL2_T2_to_Pa + real :: Ta(1) ! An array of temperatures [degC] + real :: Sa(1) ! An array of salinities [ppt] + real :: pres(1) ! An mks version of the pressure to use [Pa] + real :: rho_mks(1) ! An mks version of the density to be returned [kg m-3] + real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_linear(T, S, p_scale*pressure, rho, & - EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_ref) - case (EOS_UNESCO) - call calculate_density_unesco(T, S, p_scale*pressure, rho, rho_ref) - case (EOS_WRIGHT) - call calculate_density_wright(T, S, p_scale*pressure, rho, rho_ref) - case (EOS_TEOS10) - call calculate_density_teos10(T, S, p_scale*pressure, rho, rho_ref) - case (EOS_NEMO) - call calculate_density_nemo(T, S, p_scale*pressure, rho, rho_ref) - case default - call MOM_error(FATAL, "calculate_density_scalar: EOS is not valid.") - end select + pres(1) = EOS%RL2_T2_to_Pa * pressure + Ta(1) = T ; Sa(1) = S + if (present(rho_ref)) then + call calculate_density_array(Ta, Sa, pres, rho_mks, 1, 1, EOS, EOS%R_to_kg_m3*rho_ref) + else + call calculate_density_array(Ta, Sa, pres, rho_mks, 1, 1, EOS) + endif + ! Rescale the output density to the desired units. rho_scale = EOS%kg_m3_to_R if (present(scale)) rho_scale = rho_scale * scale - rho = rho_scale * rho + rho = rho_scale * rho_mks(1) end subroutine calculate_density_scalar @@ -212,40 +206,34 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, intent(out) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] type(EOS_type), intent(in) :: EOS !< Equation of state structure - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + real, optional, intent(in) :: rho_ref !< A reference density [R ~> kg m-3]. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale output density in !! combination with scaling given by US [various] ! Local variables real :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p - real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - p_scale = EOS%RL2_T2_to_Pa + call calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref) + p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_linear(T, S, p_scale*pressure, rho, & - EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_ref) - call calculate_density_second_derivs_linear(T, S, pressure, d2RdSS, d2RdST, & + call calculate_density_second_derivs_linear(T, S, p_scale*pressure, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP) case (EOS_WRIGHT) - call calculate_density_wright(T, S, p_scale*pressure, rho, rho_ref) - call calculate_density_second_derivs_wright(T, S, pressure, d2RdSS, d2RdST, & + call calculate_density_second_derivs_wright(T, S, p_scale*pressure, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP) case (EOS_TEOS10) - call calculate_density_teos10(T, S, p_scale*pressure, rho, rho_ref) - call calculate_density_second_derivs_teos10(T, S, pressure, d2RdSS, d2RdST, & + call calculate_density_second_derivs_teos10(T, S, p_scale*pressure, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP) case default call MOM_error(FATAL, "calculate_stanley_density_scalar: EOS is not valid.") end select ! Equation 25 of Stanley et al., 2020. - rho = rho + ( 0.5 * d2RdTT * Tvar + ( d2RdST * TScov + 0.5 * d2RdSS * Svar ) ) + rho = rho + EOS%kg_m3_to_R * ( 0.5 * d2RdTT * Tvar + ( d2RdST * TScov + 0.5 * d2RdSS * Svar ) ) - rho_scale = EOS%kg_m3_to_R - if (present(scale)) rho_scale = rho_scale * scale - rho = rho_scale * rho + if (present(scale)) rho = rho * scale end subroutine calculate_stanley_density_scalar @@ -355,7 +343,6 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: rho_reference ! rho_ref converted to [kg m-3] real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] @@ -367,17 +354,15 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) is = 1 ; ie = size(rho) ; npts = 1 + ie - is endif - p_scale = EOS%RL2_T2_to_Pa - - if ((p_scale == 1.0) .and. (EOS%R_to_kg_m3 == 1.0)) then + if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%R_to_kg_m3 == 1.0)) then call calculate_density_array(T, S, pressure, rho, is, npts, EOS, rho_ref=rho_ref) elseif (present(rho_ref)) then ! This is the same as above, but with some extra work to rescale variables. - do i=is,ie ; pres(i) = p_scale * pressure(i) ; enddo + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo rho_reference = EOS%R_to_kg_m3*rho_ref call calculate_density_array(T, S, pres, rho, is, npts, EOS, rho_ref=rho_reference) else ! There is rescaling of variables, but rho_ref is not present. Passing a 0 value of rho_ref ! changes answers at roundoff for some equations of state, like Wright and UNESCO. - do i=is,ie ; pres(i) = p_scale * pressure(i) ; enddo + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo call calculate_density_array(T, S, pres, rho, is, npts, EOS) endif @@ -410,7 +395,6 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: rho_reference ! rho_ref converted to [kg m-3] real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] @@ -423,9 +407,8 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, is = 1 ; ie = size(rho) ; npts = 1 + ie - is endif - p_scale = EOS%RL2_T2_to_Pa do i=is,ie - pres(i) = p_scale * pressure(i) + pres(i) = EOS%RL2_T2_to_Pa * pressure(i) enddo ! Rho_ref is seems like it is always present when calculate_Stanley_density is called, so @@ -435,16 +418,16 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_linear(T, S, pres, rho, 1, npts, & + call calculate_density_linear(T, S, pres, rho, is, npts, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_reference) call calculate_density_second_derivs_linear(T, S, pres, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP, 1, npts) case (EOS_WRIGHT) - call calculate_density_wright(T, S, pres, rho, 1, npts, rho_reference) + call calculate_density_wright(T, S, pres, rho, is, npts, rho_reference) call calculate_density_second_derivs_wright(T, S, pres, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP, 1, npts) case (EOS_TEOS10) - call calculate_density_teos10(T, S, pres, rho, 1, npts, rho_reference) + call calculate_density_teos10(T, S, pres, rho, is, npts, rho_reference) call calculate_density_second_derivs_teos10(T, S, pres, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP, 1, npts) case default @@ -518,7 +501,7 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) real, intent(out) :: specvol !< In situ or potential specific volume [R-1 ~> m3 kg-1] !! or other units determined by the scale argument type(EOS_type), intent(in) :: EOS !< Equation of state structure - real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 m3 kg-1] + real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] @@ -561,8 +544,6 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) !! scaling given by US [various] ! Local variables real, dimension(size(specvol)) :: pres ! Pressure converted to [Pa] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - real :: spv_unscale ! A factor to convert specific volume from R-1 to m3 kg-1 [m3 kg-1 R ~> 1] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] real :: spv_reference ! spv_ref converted to [m3 kg-1] integer :: i, is, ie, npts @@ -573,18 +554,15 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) is = 1 ; ie = size(specvol) ; npts = 1 + ie - is endif - p_scale = EOS%RL2_T2_to_Pa - spv_unscale = EOS%kg_m3_to_R - - if ((p_scale == 1.0) .and. (spv_unscale == 1.0)) then + if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%kg_m3_to_R == 1.0)) then call calculate_spec_vol_array(T, S, pressure, specvol, is, npts, EOS, spv_ref) elseif (present(spv_ref)) then ! This is the same as above, but with some extra work to rescale variables. - do i=is,ie ; pres(i) = p_scale * pressure(i) ; enddo - spv_reference = spv_unscale*spv_ref + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo + spv_reference = EOS%kg_m3_to_R*spv_ref call calculate_spec_vol_array(T, S, pres, specvol, is, npts, EOS, spv_reference) else ! There is rescaling of variables, but spv_ref is not present. Passing a 0 value of spv_ref ! changes answers at roundoff for some equations of state, like Wright and UNESCO. - do i=is,ie ; pres(i) = p_scale * pressure(i) ; enddo + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo call calculate_spec_vol_array(T, S, pres, specvol, is, npts, EOS) endif @@ -674,6 +652,57 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca end subroutine calculate_TFreeze_array +!> Calls the appropriate subroutine to calculate the freezing point for a 1-D array, taking +!! dimensionally rescaled arguments with factors stored in EOS. +subroutine calculate_TFreeze_1d(S, pressure, T_fr, EOS, dom) + real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] + real, dimension(:), intent(inout) :: T_fr !< Freezing point potential temperature referenced + !! to the surface [degC] + type(EOS_type), intent(in) :: EOS !< Equation of state structure + integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking + !! into account that arrays start at 1. + + ! Local variables + real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] + integer :: i, is, ie, npts + + if (present(dom)) then + is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is + else + is = 1 ; ie = size(T_Fr) ; npts = 1 + ie - is + endif + + if (EOS%RL2_T2_to_Pa == 1.0) then + select case (EOS%form_of_TFreeze) + case (TFREEZE_LINEAR) + call calculate_TFreeze_linear(S, pressure, T_fr, is, npts, & + EOS%TFr_S0_P0, EOS%dTFr_dS, EOS%dTFr_dp) + case (TFREEZE_MILLERO) + call calculate_TFreeze_Millero(S, pressure, T_fr, is, npts) + case (TFREEZE_TEOS10) + call calculate_TFreeze_teos10(S, pressure, T_fr, is, npts) + case default + call MOM_error(FATAL, "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") + end select + else + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo + select case (EOS%form_of_TFreeze) + case (TFREEZE_LINEAR) + call calculate_TFreeze_linear(S, pres, T_fr, is, npts, & + EOS%TFr_S0_P0, EOS%dTFr_dS, EOS%dTFr_dp) + case (TFREEZE_MILLERO) + call calculate_TFreeze_Millero(S, pres, T_fr, is, npts) + case (TFREEZE_TEOS10) + call calculate_TFreeze_teos10(S, pres, T_fr, is, npts) + case default + call MOM_error(FATAL, "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") + end select + endif + +end subroutine calculate_TFreeze_1d + + !> Calls the appropriate subroutine to calculate density derivatives for 1-D array inputs. subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] @@ -735,7 +764,6 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do ! Local variables real, dimension(size(drho_dT)) :: pres ! Pressure converted to [Pa] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: i, is, ie, npts if (present(dom)) then @@ -744,12 +772,10 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do is = 1 ; ie = size(drho_dT) ; npts = 1 + ie - is endif - p_scale = EOS%RL2_T2_to_Pa - - if (p_scale == 1.0) then + if (EOS%RL2_T2_to_Pa == 1.0) then call calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, is, npts, EOS) else - do i=is,ie ; pres(i) = p_scale * pressure(i) ; enddo + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo call calculate_density_derivs_array(T, S, pres, drho_dT, drho_dS, is, npts, EOS) endif @@ -806,8 +832,8 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS end subroutine calculate_density_derivs_scalar !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs. -subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & - drho_dS_dP, drho_dT_dP, start, npts, EOS, scale) +subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & + drho_dS_dP, drho_dT_dP, EOS, dom, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] @@ -821,46 +847,49 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh !! [T2 ppt-1 L-2 ~> kg m-3 ppt-1 Pa-1] real, dimension(:), intent(inout) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure !! [T2 degC-1 L-2 ~> kg m-3 degC-1 Pa-1] - integer, intent(in) :: start !< Starting index within the array - integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), intent(in) :: EOS !< Equation of state structure - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + type(EOS_type), intent(in) :: EOS !< Equation of state structure + integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking + !! into account that arrays start at 1. + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa [R L2 T-2 Pa-1 ~> 1] - integer :: j + integer :: i, is, ie, npts - p_scale = EOS%RL2_T2_to_Pa + if (present(dom)) then + is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is + else + is = 1 ; ie = size(T) ; npts = 1 + ie - is + endif - if (p_scale == 1.0) then + if (EOS%RL2_T2_to_Pa == 1.0) then select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & - drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case (EOS_WRIGHT) call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, & - drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case (EOS_TEOS10) call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & - drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case default call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") end select else - do j=start,start+npts-1 ; pres(j) = p_scale * pressure(j) ; enddo + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_second_derivs_linear(T, S, pres, drho_dS_dS, drho_dS_dT, & - drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case (EOS_WRIGHT) call calculate_density_second_derivs_wright(T, S, pres, drho_dS_dS, drho_dS_dT, & - drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case (EOS_TEOS10) call calculate_density_second_derivs_teos10(T, S, pres, drho_dS_dS, drho_dS_dT, & - drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) + drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case default call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") end select @@ -868,23 +897,23 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh rho_scale = EOS%kg_m3_to_R if (present(scale)) rho_scale = rho_scale * scale - if (rho_scale /= 1.0) then ; do j=start,start+npts-1 - drho_dS_dS(j) = rho_scale * drho_dS_dS(j) - drho_dS_dT(j) = rho_scale * drho_dS_dT(j) - drho_dT_dT(j) = rho_scale * drho_dT_dT(j) - drho_dS_dP(j) = rho_scale * drho_dS_dP(j) - drho_dT_dP(j) = rho_scale * drho_dT_dP(j) + if (rho_scale /= 1.0) then ; do i=is,ie + drho_dS_dS(i) = rho_scale * drho_dS_dS(i) + drho_dS_dT(i) = rho_scale * drho_dS_dT(i) + drho_dT_dT(i) = rho_scale * drho_dT_dT(i) + drho_dS_dP(i) = rho_scale * drho_dS_dP(i) + drho_dT_dP(i) = rho_scale * drho_dT_dP(i) enddo ; endif - if (p_scale /= 1.0) then - I_p_scale = 1.0 / p_scale - do j=start,start+npts-1 - drho_dS_dP(j) = I_p_scale * drho_dS_dP(j) - drho_dT_dP(j) = I_p_scale * drho_dT_dP(j) + if (EOS%RL2_T2_to_Pa /= 1.0) then + I_p_scale = 1.0 / EOS%RL2_T2_to_Pa + do i=is,ie + drho_dS_dP(i) = I_p_scale * drho_dS_dP(i) + drho_dT_dP(i) = I_p_scale * drho_dT_dP(i) enddo endif -end subroutine calculate_density_second_derivs_array +end subroutine calculate_density_second_derivs_1d !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & @@ -1010,7 +1039,6 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca ! Local variables real, dimension(size(dSV_dT)) :: press ! Pressure converted to [Pa] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: i, is, ie, npts if (present(dom)) then @@ -1018,12 +1046,11 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca else is = 1 ; ie = size(dSV_dT) ; npts = 1 + ie - is endif - p_scale = EOS%RL2_T2_to_Pa - if (p_scale == 1.0) then + if (EOS%RL2_T2_to_Pa == 1.0) then call calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, is, npts, EOS) else - do i=is,ie ; press(i) = p_scale * pressure(i) ; enddo + do i=is,ie ; press(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo call calculate_spec_vol_derivs_array(T, S, press, dSV_dT, dSV_dS, is, npts, EOS) endif @@ -1038,8 +1065,8 @@ end subroutine calc_spec_vol_derivs_1d !> Calls the appropriate subroutine to calculate the density and compressibility for 1-D array -!! inputs. If US is present, the units of the inputs and outputs are rescaled. -subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS) +!! inputs. The inputs and outputs use dimensionally rescaled units. +subroutine calculate_compress_1d(T, S, press, rho, drho_dp, EOS, dom) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: press !< Pressure [R L2 T-2 ~> Pa] @@ -1047,29 +1074,34 @@ subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS) real, dimension(:), intent(inout) :: drho_dp !< The partial derivative of density with pressure !! (also the inverse of the square of sound speed) !! [T2 L-2 ~> s2 m-2] - integer, intent(in) :: start !< Starting index within the array - integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), intent(in) :: EOS !< Equation of state structure + integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking + !! into account that arrays start at 1. ! Local variables real, dimension(size(press)) :: pressure ! Pressure converted to [Pa] - integer :: i, is, ie + integer :: i, is, ie, npts + + if (present(dom)) then + is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is + else + is = 1 ; ie = size(rho) ; npts = 1 + ie - is + endif - is = start ; ie = is + npts - 1 do i=is,ie ; pressure(i) = EOS%RL2_T2_to_Pa * press(i) ; enddo select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_compress_linear(T, S, pressure, rho, drho_dp, start, npts, & + call calculate_compress_linear(T, S, pressure, rho, drho_dp, is, npts, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) case (EOS_UNESCO) - call calculate_compress_unesco(T, S, pressure, rho, drho_dp, start, npts) + call calculate_compress_unesco(T, S, pressure, rho, drho_dp, is, npts) case (EOS_WRIGHT) - call calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) + call calculate_compress_wright(T, S, pressure, rho, drho_dp, is, npts) case (EOS_TEOS10) - call calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts) + call calculate_compress_teos10(T, S, pressure, rho, drho_dp, is, npts) case (EOS_NEMO) - call calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) + call calculate_compress_nemo(T, S, pressure, rho, drho_dp, is, npts) case default call MOM_error(FATAL, "calculate_compress: EOS%form_of_EOS is not valid.") end select @@ -1081,11 +1113,11 @@ subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS) drho_dp(i) = EOS%L_T_to_m_s**2 * drho_dp(i) enddo ; endif -end subroutine calculate_compress_array +end subroutine calculate_compress_1d !> Calculate density and compressibility for a scalar. This just promotes the scalar to an array -!! with a singleton dimension and calls calculate_compress_array. If US is present, the units of -!! the inputs and outputs are rescaled. +!! with a singleton dimension and calls calculate_compress_1d. The inputs and outputs use +!! dimensionally rescaled units. subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] @@ -1100,7 +1132,7 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) Ta(1) = T ; Sa(1) = S; pa(1) = pressure - call calculate_compress_array(Ta, Sa, pa, rhoa, drho_dpa, 1, 1, EOS) + call calculate_compress_1d(Ta, Sa, pa, rhoa, drho_dpa, EOS) rho = rhoa(1) ; drho_dp = drho_dpa(1) end subroutine calculate_compress_scalar diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 88376e83b9..036337a8de 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -858,8 +858,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! The second line below would correspond to arguments ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & call calculate_density_second_derivs(T_u, S_u, pres_u, & - scrap, scrap, drho_dT_dT_u, scrap, scrap, & - (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state) + scrap, scrap, drho_dT_dT_u, scrap, scrap, tv%eqn_of_state, EOSdom_u) endif do I=is-1,ie @@ -1125,8 +1124,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! The second line below would correspond to arguments ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & call calculate_density_second_derivs(T_v, S_v, pres_v, & - scrap, scrap, drho_dT_dT_v, scrap, scrap, & - is, ie-is+1, tv%eqn_of_state) + scrap, scrap, drho_dT_dT_v, scrap, scrap, tv%eqn_of_state, EOSdom_v) endif do i=is,ie if (calc_derivatives) then From f52c40aec7aa86d2e4c65b85a285122a8b26e4d8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 27 Apr 2022 14:29:01 -0400 Subject: [PATCH 08/68] Fix a bug in the rescaling of drho_dT_dP Corrected a bug in the calculation of drho_dS_dP and drho_dT_dP in the calculate_density_second_derivs routines, where the inverse of the correct rescaling was being used. However, these routines are only called in a very few places and these particular output fields are not being used, so this bug does not alter any existing MOM6 solutions. --- src/equation_of_state/MOM_EOS.F90 | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 7a70d7f1bd..4542c678f2 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -855,7 +855,6 @@ subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_d ! Local variables real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa [R L2 T-2 Pa-1 ~> 1] integer :: i, is, ie, npts if (present(dom)) then @@ -905,13 +904,10 @@ subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_d drho_dT_dP(i) = rho_scale * drho_dT_dP(i) enddo ; endif - if (EOS%RL2_T2_to_Pa /= 1.0) then - I_p_scale = 1.0 / EOS%RL2_T2_to_Pa - do i=is,ie - drho_dS_dP(i) = I_p_scale * drho_dS_dP(i) - drho_dT_dP(i) = I_p_scale * drho_dT_dP(i) - enddo - endif + if (EOS%RL2_T2_to_Pa /= 1.0) then ; do i=is,ie + drho_dS_dP(i) = EOS%RL2_T2_to_Pa * drho_dS_dP(i) + drho_dT_dP(i) = EOS%RL2_T2_to_Pa * drho_dT_dP(i) + enddo ; endif end subroutine calculate_density_second_derivs_1d @@ -937,7 +933,6 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa [R L2 T-2 Pa-1 ~> 1] p_scale = EOS%RL2_T2_to_Pa @@ -966,9 +961,8 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr endif if (p_scale /= 1.0) then - I_p_scale = 1.0 / p_scale - drho_dS_dP = I_p_scale * drho_dS_dP - drho_dT_dP = I_p_scale * drho_dT_dP + drho_dS_dP = p_scale * drho_dS_dP + drho_dT_dP = p_scale * drho_dT_dP endif end subroutine calculate_density_second_derivs_scalar From 5d88f2e47872ea8e78e93cfe69eb21b5edfa1043 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 1 May 2022 14:13:17 -0400 Subject: [PATCH 09/68] Modify units in temperature and salinity comments Modified comments in 20 files to prepare for the addition of dimensional rescaling of temperature and salinity. All answers are bitwise identical. --- src/ALE/MOM_hybgen_regrid.F90 | 4 +- src/ALE/MOM_hybgen_unmix.F90 | 24 +-- src/ALE/MOM_regridding.F90 | 12 +- src/ALE/coord_adapt.F90 | 8 +- src/ALE/coord_hycom.F90 | 4 +- src/ALE/coord_rho.F90 | 12 +- src/ALE/coord_slight.F90 | 16 +- src/diagnostics/MOM_wave_speed.F90 | 64 +++--- src/diagnostics/MOM_wave_structure.F90 | 20 +- src/framework/MOM_diag_mediator.F90 | 11 +- src/framework/MOM_diag_remap.F90 | 4 +- .../vertical/MOM_CVMix_ddiff.F90 | 12 +- .../vertical/MOM_CVMix_shear.F90 | 4 +- .../vertical/MOM_energetic_PBL.F90 | 136 ++++++------ .../vertical/MOM_entrain_diffusive.F90 | 6 +- .../vertical/MOM_full_convection.F90 | 30 +-- .../vertical/MOM_internal_tide_input.F90 | 14 +- .../vertical/MOM_kappa_shear.F90 | 44 ++-- src/tracer/MOM_neutral_diffusion.F90 | 197 +++++++++--------- src/tracer/MOM_tracer_hor_diff.F90 | 2 +- 20 files changed, 314 insertions(+), 310 deletions(-) diff --git a/src/ALE/MOM_hybgen_regrid.F90 b/src/ALE/MOM_hybgen_regrid.F90 index 22fd474854..cc961b88f2 100644 --- a/src/ALE/MOM_hybgen_regrid.F90 +++ b/src/ALE/MOM_hybgen_regrid.F90 @@ -361,8 +361,8 @@ subroutine hybgen_regrid(G, GV, US, dp, tv, CS, dzInterface, PCM_cell) ! These arrays work with the input column real :: p_col(GV%ke) ! A column of reference pressures [R L2 T-2 ~> Pa] - real :: temp_in(GV%ke) ! A column of input potential temperatures [degC] - real :: saln_in(GV%ke) ! A column of input layer salinities [ppt] + real :: temp_in(GV%ke) ! A column of input potential temperatures [C ~> degC] + real :: saln_in(GV%ke) ! A column of input layer salinities [S ~> ppt] real :: Rcv_in(GV%ke) ! An input column of coordinate potential density [R ~> kg m-3] real :: dp_in(GV%ke) ! The input column of layer thicknesses [H ~> m or kg m-2] logical :: PCM_lay(GV%ke) ! If true for a layer, use PCM remapping for that layer diff --git a/src/ALE/MOM_hybgen_unmix.F90 b/src/ALE/MOM_hybgen_unmix.F90 index a2b94d846b..024a9baffa 100644 --- a/src/ALE/MOM_hybgen_unmix.F90 +++ b/src/ALE/MOM_hybgen_unmix.F90 @@ -139,8 +139,8 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h) real :: dp0cum(GV%ke+1) ! minimum interface depth [H ~> m or kg m-2] real :: Rcv_tgt(GV%ke) ! Target potential density [R ~> kg m-3] - real :: temp(GV%ke) ! A column of potential temperature [degC] - real :: saln(GV%ke) ! A column of salinity [ppt] + real :: temp(GV%ke) ! A column of potential temperature [C ~> degC] + real :: saln(GV%ke) ! A column of salinity [S ~> ppt] real :: Rcv(GV%ke) ! A column of coordinate potential density [R ~> kg m-3] real :: h_col(GV%ke) ! A column of layer thicknesses [H ~> m or kg m-2] real :: p_col(GV%ke) ! A column of reference pressures [R L2 T-2 ~> Pa] @@ -151,8 +151,8 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h) ! vanished layers [H ~> m or kg m-2] real :: dilate ! A factor by which to dilate the target positions from z to z* [nondim] - real :: Th_tot_in, Th_tot_out ! Column integrated temperature [degC H ~> degC m or degC kg m-2] - real :: Sh_tot_in, Sh_tot_out ! Column integrated salinity [ppt H ~> ppt m or ppt kg m-2] + real :: Th_tot_in, Th_tot_out ! Column integrated temperature [C H ~> degC m or degC kg m-2] + real :: Sh_tot_in, Sh_tot_out ! Column integrated salinity [S H ~> ppt m or ppt kg m-2] real :: Trh_tot_in(max(ntr,1)) ! Initial column integrated tracer amounts [conc H ~> conc m or conc kg m-2] real :: Trh_tot_out(max(ntr,1)) ! Final column integrated tracer amounts [conc H ~> conc m or conc kg m-2] @@ -280,8 +280,8 @@ subroutine hybgen_column_unmix(CS, nk, Rcv_tgt, temp, saln, Rcv, eqn_of_state, & integer, intent(in) :: fixlay !< deepest fixed coordinate layer real, intent(in) :: qhrlx(nk+1) !< Relaxation fraction per timestep [nondim], < 1. real, intent(in) :: Rcv_tgt(nk) !< Target potential density [R ~> kg m-3] - real, intent(inout) :: temp(nk) !< A column of potential temperature [degC] - real, intent(inout) :: saln(nk) !< A column of salinity [ppt] + real, intent(inout) :: temp(nk) !< A column of potential temperature [C ~> degC] + real, intent(inout) :: saln(nk) !< A column of salinity [S ~> ppt] real, intent(inout) :: Rcv(nk) !< Coordinate potential density [R ~> kg m-3] type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure integer, intent(in) :: ntr !< The number of registered passive tracers @@ -299,20 +299,20 @@ subroutine hybgen_column_unmix(CS, nk, Rcv_tgt, temp, saln, Rcv, eqn_of_state, & ! ! Local variables real :: h_hat ! A portion of a layer to move across an interface [H ~> m or kg m-2] - real :: delt, deltm ! Temperature differences between successive layers [degC] - real :: dels, delsm ! Salinity differences between successive layers [ppt] + real :: delt, deltm ! Temperature differences between successive layers [C ~> degC] + real :: dels, delsm ! Salinity differences between successive layers [S ~> ppt] real :: abs_dRdT ! The absolute value of the derivative of the coordinate density - ! with temperature [R degC-1 ~> kg m-3 degC-1] + ! with temperature [R C-1 ~> kg m-3 degC-1] real :: abs_dRdS ! The absolute value of the derivative of the coordinate density - ! with salinity [R ppt-1 ~> kg m-3 ppt-1] + ! with salinity [R S-1 ~> kg m-3 ppt-1] real :: q, qts ! Nondimensional fractions in the range of 0 to 1 [nondim] real :: frac_dts ! The fraction of the temperature or salinity difference between successive ! layers by which the source layer's property changes by the loss of water ! that matches the destination layers properties via unmixing [nondim]. real :: qtr ! The fraction of the water that will come from the layer below, ! used for updating the concentration of passive tracers [nondim] - real :: swap_T ! A swap variable for temperature [degC] - real :: swap_S ! A swap variable for salinity [ppt] + real :: swap_T ! A swap variable for temperature [C ~> degC] + real :: swap_S ! A swap variable for salinity [S ~> ppt] real :: swap_tr ! A temporary swap variable for the tracers [conc] logical, parameter :: lunmix=.true. ! unmix a too light deepest layer integer :: k, ka, kp, kt, m diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 95a77f503d..562bc80d67 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1594,7 +1594,7 @@ subroutine build_grid_adaptive(G, GV, US, h, tv, dzInterface, remapCS, CS) ! local variables integer :: i, j, k, nz ! indices and dimension lengths - ! temperature, salinity and pressure on interfaces + ! temperature [C ~> degC], salinity [S ~> ppt] and pressure on interfaces real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: tInt, sInt ! current interface positions and after tendency term is applied ! positive downward @@ -1936,8 +1936,8 @@ subroutine convective_adjustment(G, GV, h, tv) !------------------------------------------------------------------------------ ! Local variables - real :: T0, T1 ! temperatures of two layers [degC] - real :: S0, S1 ! salinities of two layers [ppt] + real :: T0, T1 ! temperatures of two layers [C ~> degC] + real :: S0, S1 ! salinities of two layers [S ~> ppt] real :: r0, r1 ! densities of two layers [R ~> kg m-3] real :: h0, h1 ! Layer thicknesses [H ~> m or kg m-2] real, dimension(GV%ke) :: p_col ! A column of zero pressures [R L2 T-2 ~> Pa] @@ -1953,7 +1953,7 @@ subroutine convective_adjustment(G, GV, h, tv) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 ! Compute densities within current water column - call calculate_density( tv%T(i,j,:), tv%S(i,j,:), p_col, densities, tv%eqn_of_state) + call calculate_density(tv%T(i,j,:), tv%S(i,j,:), p_col, densities, tv%eqn_of_state) ! Repeat restratification until complete do @@ -1972,8 +1972,8 @@ subroutine convective_adjustment(G, GV, h, tv) tv%S(i,j,k) = S1 ; tv%S(i,j,k+1) = S0 h(i,j,k) = h1 ; h(i,j,k+1) = h0 ! Recompute densities at levels k and k+1 - call calculate_density( tv%T(i,j,k), tv%S(i,j,k), p_col(k), densities(k), tv%eqn_of_state) - call calculate_density( tv%T(i,j,k+1), tv%S(i,j,k+1), p_col(k+1), & + call calculate_density(tv%T(i,j,k), tv%S(i,j,k), p_col(k), densities(k), tv%eqn_of_state) + call calculate_density(tv%T(i,j,k+1), tv%S(i,j,k+1), p_col(k+1), & densities(k+1), tv%eqn_of_state ) ! Because p_col is has uniform values, these calculate_density calls are equivalent to ! densities(k) = r1 ; densities(k+1) = r0 diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index e5b33103ef..91df78c021 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -122,8 +122,8 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex integer, intent(in) :: i !< The i-index of the column to work on integer, intent(in) :: j !< The j-index of the column to work on real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt !< Interface heights [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZK_(GV)+1), intent(inout) :: zNext !< updated interface positions @@ -131,8 +131,8 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex integer :: k, nz real :: h_up, b1, b_denom_1, d1, depth, nominal_z, stretching real :: drdz ! The vertical density gradient [R H-1 ~> kg m-4 or m-1] - real, dimension(SZK_(GV)+1) :: alpha ! drho/dT [R degC-1 ~> kg m-3 degC-1] - real, dimension(SZK_(GV)+1) :: beta ! drho/dS [R ppt-1 ~> kg m-3 ppt-1] + real, dimension(SZK_(GV)+1) :: alpha ! drho/dT [R C-1 ~> kg m-3 degC-1] + real, dimension(SZK_(GV)+1) :: beta ! drho/dS [R S-1 ~> kg m-3 ppt-1] real, dimension(SZK_(GV)+1) :: del2sigma ! Laplacian of in situ density times grid spacing [R ~> kg m-3] real, dimension(SZK_(GV)+1) :: dh_d2s ! Thickness change in response to del2sigma [H ~> m or kg m-2] real, dimension(SZK_(GV)) :: kGrid, c1 ! grid diffusivity on layers, and tridiagonal work array diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 4d70f925aa..5a3ffaff52 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -101,8 +101,8 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) - real, dimension(nz), intent(in) :: T !< Temperature of column [degC] - real, dimension(nz), intent(in) :: S !< Salinity of column [ppt] + real, dimension(nz), intent(in) :: T !< Temperature of column [C ~> degC] + real, dimension(nz), intent(in) :: S !< Salinity of column [S ~> ppt] real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(nz), intent(in) :: p_col !< Layer pressure [R L2 T-2 ~> Pa] real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface [H ~> m or kg m-2] diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 4a9872d429..0cbf025b94 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -93,8 +93,8 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & integer, intent(in) :: nz !< Number of levels on source grid (i.e. length of h, T, S) real, intent(in) :: depth !< Depth of ocean bottom (positive downward) [H ~> m or kg m-2] real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(nz), intent(in) :: T !< Temperature for source column [degC] - real, dimension(nz), intent(in) :: S !< Salinity for source column [ppt] + real, dimension(nz), intent(in) :: T !< Temperature for source column [C ~> degC] + real, dimension(nz), intent(in) :: S !< Salinity for source column [S ~> ppt] type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, dimension(CS%nk+1), & intent(inout) :: z_interface !< Absolute positions of interfaces @@ -206,8 +206,8 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom [Z ~> m] real, dimension(nz), intent(in) :: h !< Layer thicknesses in Z coordinates [Z ~> m] - real, dimension(nz), intent(in) :: T !< T for column [degC] - real, dimension(nz), intent(in) :: S !< S for column [ppt] + real, dimension(nz), intent(in) :: T !< T for column [C ~> degC] + real, dimension(nz), intent(in) :: S !< S for column [S ~> ppt] type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, dimension(nz+1), intent(inout) :: zInterface !< Absolute positions of interfaces real, optional, intent(in) :: h_neglect !< A negligibly small width for the @@ -224,7 +224,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ real, dimension(nz+1) :: x0, x1, xTmp ! Temporary interface heights [Z ~> m] real, dimension(nz) :: pres ! The pressure used in the equation of state [R L2 T-2 ~> Pa]. real, dimension(nz) :: densities ! Layer densities [R ~> kg m-3] - real, dimension(nz) :: T_tmp, S_tmp ! A temporary profile of temperature [degC] and salinity [ppt]. + real, dimension(nz) :: T_tmp, S_tmp ! A temporary profile of temperature [C ~> degC] and salinity [S ~> ppt]. real, dimension(nz) :: Tmp ! A temporary variable holding a remapped variable. real, dimension(nz) :: h0, h1, hTmp ! Temporary thicknesses [Z ~> m] real :: deviation ! When iterating to determine the final grid, this is the @@ -263,7 +263,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ enddo ! Compute densities within current water column - call calculate_density( T_tmp, S_tmp, pres, densities, eqn_of_state) + call calculate_density(T_tmp, S_tmp, pres, densities, eqn_of_state) do k = 1,count_nonzero_layers densities(k) = densities(mapping(k)) diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 6c2432d50d..4b4ac8a153 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -187,8 +187,8 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_pres, H_subroundoff, & real, intent(in) :: H_subroundoff !< GV%H_subroundoff integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) - real, dimension(nz), intent(in) :: T_col !< T for column - real, dimension(nz), intent(in) :: S_col !< S for column + real, dimension(nz), intent(in) :: T_col !< T for column [C ~> degC] + real, dimension(nz), intent(in) :: S_col !< S for column [S ~> ppt] real, dimension(nz), intent(in) :: h_col !< Layer thicknesses [H ~> m or kg m-2] real, dimension(nz), intent(in) :: p_col !< Layer center pressure [R L2 T-2 ~> Pa] real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface [H ~> m or kg m-2] @@ -199,20 +199,20 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_pres, H_subroundoff, & !! of edge value calculations [H ~> m or kg m-2]. ! Local variables real, dimension(nz) :: rho_col ! Layer densities [R ~> kg m-3] - real, dimension(nz) :: T_f, S_f ! Filtered layer temperature [degC] and salinity [ppt] + real, dimension(nz) :: T_f, S_f ! Filtered layer temperature [C ~> degC] and salinity [S ~> ppt] logical, dimension(nz+1) :: reliable ! If true, this interface is in a reliable position. - real, dimension(nz+1) :: T_int, S_int ! Temperature [degC] and salinity [ppt] interpolated to interfaces. + real, dimension(nz+1) :: T_int, S_int ! Temperature [C ~> degC] and salinity [S ~> ppt] interpolated to interfaces. real, dimension(nz+1) :: rho_tmp ! A temporary density [R ~> kg m-3] real, dimension(nz+1) :: drho_dp ! The partial derivative of density with pressure [T2 L-2 ~> kg m-3 Pa-1] real, dimension(nz+1) :: p_IS, p_R ! Pressures [R L2 T-2 ~> Pa] real, dimension(nz+1) :: drhoIS_dT ! The partial derivative of in situ density with temperature - ! in [R degC-1 ~> kg m-3 degC-1] + ! in [R C-1 ~> kg m-3 degC-1] real, dimension(nz+1) :: drhoIS_dS ! The partial derivative of in situ density with salinity - ! in [R ppt-1 ~> kg m-3 ppt-1] + ! in [R S-1 ~> kg m-3 ppt-1] real, dimension(nz+1) :: drhoR_dT ! The partial derivative of reference density with temperature - ! in [R degC-1 ~> kg m-3 degC-1] + ! in [R C-1 ~> kg m-3 degC-1] real, dimension(nz+1) :: drhoR_dS ! The partial derivative of reference density with salinity - ! in [R ppt-1 ~> kg m-3 ppt-1] + ! in [R S-1 ~> kg m-3 ppt-1] real, dimension(nz+1) :: strat_rat real :: H_to_cPa ! A conversion factor from thicknesses to the compressibility fraction times ! the units of pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index a06e9768d6..36a6d51e83 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -80,11 +80,11 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ ! Local variables real, dimension(SZK_(GV)+1) :: & - dRho_dT, & ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - dRho_dS, & ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + dRho_dT, & ! Partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + dRho_dS, & ! Partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] pres, & ! Interface pressure [R L2 T-2 ~> Pa] - T_int, & ! Temperature interpolated to interfaces [degC] - S_int, & ! Salinity interpolated to interfaces [ppt] + T_int, & ! Temperature interpolated to interfaces [C ~> degC] + S_int, & ! Salinity interpolated to interfaces [S ~> ppt] H_top, & ! The distance of each filtered interface from the ocean surface [Z ~> m] H_bot, & ! The distance of each filtered interface from the bottom [Z ~> m] gprime ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. @@ -93,14 +93,14 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ ! the thickness of the layer below (Igl) or above (Igu) it, in [T2 L-2 ~> s2 m-2]. real, dimension(SZK_(GV),SZI_(G)) :: & Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m] - Tf, & ! Layer temperatures after very thin layers are combined [degC] - Sf, & ! Layer salinities after very thin layers are combined [ppt] + Tf, & ! Layer temperatures after very thin layers are combined [C ~> degC] + Sf, & ! Layer salinities after very thin layers are combined [S ~> ppt] Rf ! Layer densities after very thin layers are combined [R ~> kg m-3] real, dimension(SZK_(GV)) :: & - Hc, & ! A column of layer thicknesses after convective istabilities are removed [Z ~> m] - Tc, & ! A column of layer temperatures after convective istabilities are removed [degC] - Sc, & ! A column of layer salinites after convective istabilities are removed [ppt] - Rc, & ! A column of layer densities after convective istabilities are removed [R ~> kg m-3] + Hc, & ! A column of layer thicknesses after convective instabilities are removed [Z ~> m] + Tc, & ! A column of layer temperatures after convective instabilities are removed [C ~> degC] + Sc, & ! A column of layer salinities after convective instabilities are removed [S ~> ppt] + Rc, & ! A column of layer densities after convective instabilities are removed [R ~> kg m-3] Hc_H ! Hc(:) rescaled from Z to thickness units [H ~> m or kg m-2] real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] real :: det, ddet @@ -112,8 +112,8 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses [Z ~> m] H_here, & ! A thickness [Z ~> m] - HxT_here, & ! A layer integrated temperature [degC Z ~> degC m] - HxS_here, & ! A layer integrated salinity [ppt Z ~> ppt m] + HxT_here, & ! A layer integrated temperature [C Z ~> degC m] + HxS_here, & ! A layer integrated salinity [S Z ~> ppt m] HxR_here ! A layer integrated density [R Z ~> kg m-2] real :: speed2_tot ! overestimate of the mode-1 speed squared [L2 T-2 ~> m2 s-2] real :: cg1_min2 ! A floor in the squared first mode speed below which 0 is returned [L2 T-2 ~> m2 s-2] @@ -203,7 +203,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !$OMP better_est,cg1_min2,tol_merge,tol_solve,c2_scale) & !$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & !$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT,drho_dS, & -!$OMP drxh_sum,kc,Hc,Hc_H,tC,sc,I_Hnew,gprime,& +!$OMP drxh_sum,kc,Hc,Hc_H,Tc,Sc,I_Hnew,gprime,& !$OMP Rc,speed2_tot,Igl,Igu,lam0,lam,lam_it,dlam, & !$OMP mode_struct,sum_hc,N2min,gp,hw, & !$OMP ms_min,ms_max,ms_sq,H_top,H_bot,I_Htot,merge, & @@ -581,7 +581,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ end subroutine wave_speed -!> Solve a non-symmetric tridiagonal problem with the sum of the upper and lower diagnonals minus a +!> Solve a non-symmetric tridiagonal problem with the sum of the upper and lower diagonals minus a !! scalar contribution as the leading diagonal. !! This uses the Thomas algorithm rather than the Hallberg algorithm since the matrix is not symmetric. subroutine tdma6(n, a, c, lam, y) @@ -646,26 +646,26 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! Local variables real, dimension(SZK_(GV)+1) :: & - dRho_dT, & ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - dRho_dS, & ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + dRho_dT, & ! Partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + dRho_dS, & ! Partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] pres, & ! Interface pressure [R L2 T-2 ~> Pa] - T_int, & ! Temperature interpolated to interfaces [degC] - S_int, & ! Salinity interpolated to interfaces [ppt] + T_int, & ! Temperature interpolated to interfaces [C ~> degC] + S_int, & ! Salinity interpolated to interfaces [S ~> ppt] H_top, & ! The distance of each filtered interface from the ocean surface [Z ~> m] H_bot, & ! The distance of each filtered interface from the bottom [Z ~> m] gprime ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. real, dimension(SZK_(GV),SZI_(G)) :: & Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m] - Tf, & ! Layer temperatures after very thin layers are combined [degC] - Sf, & ! Layer salinities after very thin layers are combined [ppt] + Tf, & ! Layer temperatures after very thin layers are combined [C ~> degC] + Sf, & ! Layer salinities after very thin layers are combined [S ~> ppt] Rf ! Layer densities after very thin layers are combined [R ~> kg m-3] real, dimension(SZK_(GV)) :: & Igl, Igu, & ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, in [T2 L-2 ~> s2 m-2]. - Hc, & ! A column of layer thicknesses after convective istabilities are removed [Z ~> m] - Tc, & ! A column of layer temperatures after convective istabilities are removed [degC] - Sc, & ! A column of layer salinites after convective istabilities are removed [ppt] - Rc ! A column of layer densities after convective istabilities are removed [R ~> kg m-3] + Hc, & ! A column of layer thicknesses after convective instabilities are removed [Z ~> m] + Tc, & ! A column of layer temperatures after convective instabilities are removed [C ~> degC] + Sc, & ! A column of layer salinities after convective instabilities are removed [S ~> ppt] + Rc ! A column of layer densities after convective instabilities are removed [R ~> kg m-3] real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] real :: c1_thresh ! if c1 is below this value, don't bother calculating ! cn values for higher modes [L T-1 ~> m s-1] @@ -692,8 +692,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses [Z ~> m] H_here, & ! A thickness [Z ~> m] - HxT_here, & ! A layer integrated temperature [degC Z ~> degC m] - HxS_here, & ! A layer integrated salinity [ppt Z ~> ppt m] + HxT_here, & ! A layer integrated temperature [C Z ~> degC m] + HxS_here, & ! A layer integrated salinity [S Z ~> ppt m] HxR_here ! A layer integrated density [R Z ~> kg m-2] real :: speed2_tot ! overestimate of the mode-1 speed squared [L2 T-2 ~> m2 s-2] real :: speed2_min ! minimum mode speed (squared) to consider in root searching [L2 T-2 ~> m2 s-2] @@ -702,7 +702,6 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! A factor used in setting speed2_min [nondim] real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] - real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1]. real :: tol_Hfrac ! Layers that together are smaller than this fraction of ! the total water column can be merged for efficiency. @@ -735,7 +734,6 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif - S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 ! Simplifying the following could change answers at roundoff. Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) @@ -757,7 +755,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) cn(:,:,:) = 0.0 min_h_frac = tol_Hfrac / real(nz) - !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,T,S, & + !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS, & !$OMP Z_to_pres,tv,cn,g_Rho0,nmodes,cg1_min2,better_est, & !$OMP c1_thresh,tol_solve,tol_merge,c2_scale) do j=js,je @@ -781,12 +779,12 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! Start a new layer H_here(i) = h(i,j,k)*GV%H_to_Z - HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*tv%T(i,j,k) + HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*tv%S(i,j,k) else H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z - HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*tv%T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*tv%S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 931532983a..41b296036f 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -110,24 +110,24 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !! over the entire computational domain. ! Local variables real, dimension(SZK_(GV)+1) :: & - dRho_dT, & !< Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - dRho_dS, & !< Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + dRho_dT, & !< Partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + dRho_dS, & !< Partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] pres, & !< Interface pressure [R L2 T-2 ~> Pa] - T_int, & !< Temperature interpolated to interfaces [degC] - S_int, & !< Salinity interpolated to interfaces [ppt] + T_int, & !< Temperature interpolated to interfaces [C ~> degC] + S_int, & !< Salinity interpolated to interfaces [S ~> ppt] gprime !< The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. real, dimension(SZK_(GV)) :: & Igl, Igu !< The inverse of the reduced gravity across an interface times !< the thickness of the layer below (Igl) or above (Igu) it [T2 L-2 ~> s2 m-2]. real, dimension(SZK_(GV),SZI_(G)) :: & Hf, & !< Layer thicknesses after very thin layers are combined [Z ~> m] - Tf, & !< Layer temperatures after very thin layers are combined [degC] - Sf, & !< Layer salinities after very thin layers are combined [ppt] + Tf, & !< Layer temperatures after very thin layers are combined [C ~> degC] + Sf, & !< Layer salinities after very thin layers are combined [S ~> ppt] Rf !< Layer densities after very thin layers are combined [R ~> kg m-3] real, dimension(SZK_(GV)) :: & Hc, & !< A column of layer thicknesses after convective instabilities are removed [Z ~> m] - Tc, & !< A column of layer temperatures after convective instabilities are removed [degC] - Sc, & !< A column of layer salinites after convective instabilities are removed [ppt] + Tc, & !< A column of layer temperatures after convective instabilities are removed [C ~> degC] + Sc, & !< A column of layer salinites after convective instabilities are removed [S ~> ppt] Rc !< A column of layer densities after convective instabilities are removed [R ~> kg m-3] real, dimension(SZI_(G),SZJ_(G)) :: & htot !< The vertical sum of the thicknesses [Z ~> m] @@ -137,8 +137,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZI_(G)) :: & hmin, & !< Thicknesses [Z ~> m] H_here, & !< A thickness [Z ~> m] - HxT_here, & !< A layer integrated temperature [degC Z ~> degC m] - HxS_here, & !< A layer integrated salinity [ppt Z ~> ppt m] + HxT_here, & !< A layer integrated temperature [C Z ~> degC m] + HxS_here, & !< A layer integrated salinity [S Z ~> ppt m] HxR_here !< A layer integrated density [R Z ~> kg m-2] real :: I_Hnew !< The inverse of a new layer thickness [Z-1 ~> m-1] real :: drxh_sum !< The sum of density diffrences across interfaces times thicknesses [R Z ~> kg m-2] diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 9f6b57fe6c..2816ac2c6a 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3335,8 +3335,8 @@ end subroutine diag_mediator_init !> Set pointers to the default state fields used to remap diagnostics. subroutine diag_set_state_ptrs(h, T, S, eqn_of_state, diag_cs) real, dimension(:,:,:), target, intent(in ) :: h !< the model thickness array [H ~> m or kg m-2] - real, dimension(:,:,:), target, intent(in ) :: T !< the model temperature array - real, dimension(:,:,:), target, intent(in ) :: S !< the model salinity array + real, dimension(:,:,:), target, intent(in ) :: T !< the model temperature array [C ~> degC] + real, dimension(:,:,:), target, intent(in ) :: S !< the model salinity array [S ~> ppt] type(EOS_type), target, intent(in ) :: eqn_of_state !< Equation of state structure type(diag_ctrl), intent(inout) :: diag_cs !< diag mediator control structure @@ -3356,9 +3356,9 @@ subroutine diag_update_remap_grids(diag_cs, alt_h, alt_T, alt_S, update_intensiv real, target, optional, intent(in ) :: alt_h(:,:,:) !< Used if remapped grids should be something other than !! the current thicknesses [H ~> m or kg m-2] real, target, optional, intent(in ) :: alt_T(:,:,:) !< Used if remapped grids should be something other than - !! the current temperatures + !! the current temperatures [C ~> degC] real, target, optional, intent(in ) :: alt_S(:,:,:) !< Used if remapped grids should be something other than - !! the current salinity + !! the current salinity [S ~> ppt] logical, optional, intent(in ) :: update_intensive !< If true (default), update the grids used for !! intensive diagnostics logical, optional, intent(in ) :: update_extensive !< If true (not default), update the grids used for @@ -3366,7 +3366,8 @@ subroutine diag_update_remap_grids(diag_cs, alt_h, alt_T, alt_S, update_intensiv ! Local variables integer :: i real, dimension(:,:,:), pointer :: h_diag => NULL() ! The layer thickneses for diagnostics [H ~> m or kg m-2] - real, dimension(:,:,:), pointer :: T_diag => NULL(), S_diag => NULL() + real, dimension(:,:,:), pointer :: T_diag => NULL() ! The layer temperatures for diagnostics [C ~> degC] + real, dimension(:,:,:), pointer :: S_diag => NULL() ! The layer salinities for diagnostics [S ~> ppt] logical :: update_intensive_local, update_extensive_local ! Set values based on optional input arguments diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 63e6bcba7a..e404580631 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -273,8 +273,8 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(:,:,:), intent(in) :: h !< New thickness [H ~> m or kg m-2] - real, dimension(:,:,:), intent(in) :: T !< New temperatures [degC] - real, dimension(:,:,:), intent(in) :: S !< New salinities [ppt] + real, dimension(:,:,:), intent(in) :: T !< New temperatures [C ~> degC] + real, dimension(:,:,:), intent(in) :: S !< New salinities [S ~> ppt] type(EOS_type), intent(in) :: eqn_of_state !< A pointer to the equation of state real, dimension(:,:,:), intent(inout) :: h_target !< The new diagnostic thicknesses [H ~> m or kg m-2] diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index b77387f521..413b87f631 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -160,15 +160,15 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) ! Local variables real, dimension(SZK_(GV)) :: & cellHeight, & !< Height of cell centers [m] - dRho_dT, & !< partial derivatives of density wrt temp [R degC-1 ~> kg m-3 degC-1] - dRho_dS, & !< partial derivatives of density wrt saln [R ppt-1 ~> kg m-3 ppt-1] + dRho_dT, & !< partial derivatives of density wrt temp [R C-1 ~> kg m-3 degC-1] + dRho_dS, & !< partial derivatives of density wrt saln [R S-1 ~> kg m-3 ppt-1] pres_int, & !< pressure at each interface [R L2 T-2 ~> Pa] - temp_int, & !< temp and at interfaces [degC] - salt_int, & !< salt at at interfaces [ppt] + temp_int, & !< temp and at interfaces [C ~> degC] + salt_int, & !< salt at at interfaces [S ~> ppt] alpha_dT, & !< alpha*dT across interfaces [kg m-3] beta_dS, & !< beta*dS across interfaces [kg m-3] - dT, & !< temp. difference between adjacent layers [degC] - dS !< salt difference between adjacent layers [ppt] + dT, & !< temp. difference between adjacent layers [C ~> degC] + dS !< salt difference between adjacent layers [S ~> ppt] real, dimension(SZK_(GV)+1) :: & Kd1_T, & !< Diapycanal diffusivity of temperature [m2 s-1]. Kd1_S !< Diapycanal diffusivity of salinity [m2 s-1]. diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index db98e063d8..7ec45dbe11 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -82,8 +82,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real :: dummy ! A dummy variable [nondim] real :: dRho ! Buoyancy differences [Z T-2 ~> m s-2] real, dimension(2*(GV%ke)) :: pres_1d ! A column of interface pressures [R L2 T-2 ~> Pa] - real, dimension(2*(GV%ke)) :: temp_1d ! A column of temperatures [degC] - real, dimension(2*(GV%ke)) :: salt_1d ! A column of salinities [ppt] + real, dimension(2*(GV%ke)) :: temp_1d ! A column of temperatures [C ~> degC] + real, dimension(2*(GV%ke)) :: salt_1d ! A column of salinities [S ~> ppt] real, dimension(2*(GV%ke)) :: rho_1d ! A column of densities at interface pressures [R ~> kg m-3] real, dimension(GV%ke+1) :: Ri_Grad !< Gradient Richardson number [nondim] real, dimension(GV%ke+1) :: Kvisc !< Vertical viscosity at interfaces [m2 s-1] diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index e62db4dc36..214b5ee75c 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -260,10 +260,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dT !< The partial derivative of in-situ specific !! volume with potential temperature - !! [R-1 degC-1 ~> m3 kg-1 degC-1]. + !! [R-1 C-1 ~> m3 kg-1 degC-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dS !< The partial derivative of in-situ specific - !! volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + !! volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: TKE_forced !< The forcing requirements to homogenize the !! forcing that has been applied to each layer @@ -309,21 +309,21 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2]. - T_2d, & ! A 2-d slice of the layer temperatures [degC]. - S_2d, & ! A 2-d slice of the layer salinities [ppt]. + T_2d, & ! A 2-d slice of the layer temperatures [C ~> degC]. + S_2d, & ! A 2-d slice of the layer salinities [S ~> ppt]. TKE_forced_2d, & ! A 2-d slice of TKE_forced [R Z3 T-2 ~> J m-2]. - dSV_dT_2d, & ! A 2-d slice of dSV_dT [R-1 degC-1 ~> m3 kg-1 degC-1]. - dSV_dS_2d, & ! A 2-d slice of dSV_dS [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + dSV_dT_2d, & ! A 2-d slice of dSV_dT [R-1 C-1 ~> m3 kg-1 degC-1]. + dSV_dS_2d, & ! A 2-d slice of dSV_dS [R-1 S-1 ~> m3 kg-1 ppt-1]. u_2d, & ! A 2-d slice of the zonal velocity [L T-1 ~> m s-1]. v_2d ! A 2-d slice of the meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)) :: & h, & ! The layer thickness [H ~> m or kg m-2]. - T0, & ! The initial layer temperatures [degC]. - S0, & ! The initial layer salinities [ppt]. - dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [R-1 degC-1 ~> m3 kg-1 degC-1]. - dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + T0, & ! The initial layer temperatures [C ~> degC]. + S0, & ! The initial layer salinities [S ~> ppt]. + dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1]. + dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [R Z3 T-2 ~> J m-2]. u, & ! The zonal velocity [L T-1 ~> m s-1]. v ! The meridional velocity [L T-1 ~> m s-1]. @@ -508,14 +508,14 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs !! [L T-1 ~> m s-1]. real, dimension(SZK_(GV)), intent(in) :: v !< Zonal velocities interpolated to h points !! [L T-1 ~> m s-1]. - real, dimension(SZK_(GV)), intent(in) :: T0 !< The initial layer temperatures [degC]. - real, dimension(SZK_(GV)), intent(in) :: S0 !< The initial layer salinities [ppt]. + real, dimension(SZK_(GV)), intent(in) :: T0 !< The initial layer temperatures [C ~> degC]. + real, dimension(SZK_(GV)), intent(in) :: S0 !< The initial layer salinities [S ~> ppt]. real, dimension(SZK_(GV)), intent(in) :: dSV_dT !< The partial derivative of in-situ specific !! volume with potential temperature - !! [R-1 degC-1 ~> m3 kg-1 degC-1]. + !! [R-1 C-1 ~> m3 kg-1 degC-1]. real, dimension(SZK_(GV)), intent(in) :: dSV_dS !< The partial derivative of in-situ specific - !! volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + !! volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the !! forcing that has been applied to each layer !! [R Z3 T-2 ~> J m-2]. @@ -576,38 +576,38 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real, dimension(SZK_(GV)) :: & dT_to_dColHt, & ! Partial derivative of the total column height with the temperature changes - ! within a layer [Z degC-1 ~> m degC-1]. + ! within a layer [Z C-1 ~> m degC-1]. dS_to_dColHt, & ! Partial derivative of the total column height with the salinity changes - ! within a layer [Z ppt-1 ~> m ppt-1]. + ! within a layer [Z S-1 ~> m ppt-1]. dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature - ! changes within a layer, in [R Z3 T-2 degC-1 ~> J m-2 degC-1]. + ! changes within a layer, in [R Z3 T-2 C-1 ~> J m-2 degC-1]. dS_to_dPE, & ! Partial derivatives of column potential energy with the salinity changes - ! within a layer, in [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + ! within a layer, in [R Z3 T-2 S-1 ~> J m-2 ppt-1]. dT_to_dColHt_a, & ! Partial derivative of the total column height with the temperature changes ! within a layer, including the implicit effects of mixing with layers higher - ! in the water column [Z degC-1 ~> m degC-1]. + ! in the water column [Z C-1 ~> m degC-1]. dS_to_dColHt_a, & ! Partial derivative of the total column height with the salinity changes ! within a layer, including the implicit effects of mixing with layers higher - ! in the water column [Z ppt-1 ~> m ppt-1]. + ! in the water column [Z S-1 ~> m ppt-1]. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature changes ! within a layer, including the implicit effects of mixing with layers higher - ! in the water column [R Z3 T-2 degC-1 ~> J m-2 degC-1]. + ! in the water column [R Z3 T-2 C-1 ~> J m-2 degC-1]. dS_to_dPE_a, & ! Partial derivative of column potential energy with the salinity changes ! within a layer, including the implicit effects of mixing with layers higher - ! in the water column [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + ! in the water column [R Z3 T-2 S-1 ~> J m-2 ppt-1]. c1, & ! c1 is used by the tridiagonal solver [nondim]. - Te, & ! Estimated final values of T in the column [degC]. - Se, & ! Estimated final values of S in the column [ppt]. - dTe, & ! Running (1-way) estimates of temperature change [degC]. - dSe, & ! Running (1-way) estimates of salinity change [ppt]. + 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]. Th_a, & ! An effective temperature times a thickness in the layer above, including implicit - ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2]. + ! mixing effects with other yet higher layers [C H ~> degC m or degC kg m-2]. Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit - ! mixing effects with other yet higher layers [ppt H ~> ppt m or ppt kg m-2]. + ! mixing effects with other yet higher layers [S H ~> ppt m or ppt kg m-2]. Th_b, & ! An effective temperature times a thickness in the layer below, including implicit - ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. + ! mixing effects with other yet lower layers [C H ~> degC m or degC kg m-2]. Sh_b ! An effective salinity times a thickness in the layer below, including implicit - ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. + ! mixing effects with other yet lower layers [S H ~> ppt m or ppt kg m-2]. real, dimension(SZK_(GV)+1) :: & MixLen_shape, & ! A nondimensional shape factor for the mixing length that ! gives it an appropriate assymptotic value at the bottom of @@ -658,15 +658,15 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: tot_TKE ! The total TKE available to support mixing at interface K [R Z3 T-2 ~> J m-2]. real :: TKE_here ! The total TKE at this point in the algorithm [R Z3 T-2 ~> J m-2]. real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature - ! change in the layer above the interface [degC]. + ! change in the layer above the interface [C ~> degC]. real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity - ! change in the layer above the interface [ppt]. + ! change in the layer above the interface [S ~> ppt]. real :: dTe_term ! A diffusivity-independent term related to the temperature - ! change in the layer below the interface [degC H ~> degC m or degC kg m-2]. + ! change in the layer below the interface [C H ~> degC m or degC kg m-2]. real :: dSe_term ! A diffusivity-independent term related to the salinity - ! change in the layer above the interface [ppt H ~> ppt m or ppt kg m-2]. - real :: dTe_t2 ! A part of dTe_term [degC H ~> degC m or degC kg m-2]. - real :: dSe_t2 ! A part of dSe_term [ppt H ~> ppt m or ppt kg m-2]. + ! change in the layer above the interface [S H ~> ppt m or ppt kg m-2]. + real :: dTe_t2 ! A part of dTe_term [C H ~> degC m or degC kg m-2]. + real :: dSe_t2 ! A part of dSe_term [S H ~> ppt m or ppt kg m-2]. real :: dPE_conv ! The convective change in column potential energy [R Z3 T-2 ~> J m-2]. real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [R Z3 T-2 ~> J m-2]. real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [R Z3 T-2 H-1 ~> J m-3 or J kg-1]. @@ -732,8 +732,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: dPE_debug, mixing_debug real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k - real, dimension(SZK_(GV)) :: dT_expect !< Expected temperature changes [degC] - real, dimension(SZK_(GV)) :: dS_expect !< Expected salinity changes [ppt] + real, dimension(SZK_(GV)) :: dT_expect !< Expected temperature changes [C ~> degC] + real, dimension(SZK_(GV)) :: dS_expect !< Expected salinity changes [S ~> ppt] integer, dimension(SZK_(GV)) :: num_itts integer :: k, nz, itt, max_itt @@ -1447,51 +1447,51 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer !! above, including implicit mixing effects with other - !! yet higher layers [degC H ~> degC m or degC kg m-2]. + !! yet higher layers [C H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_a !< An effective salinity times a thickness in the layer !! above, including implicit mixing effects with other - !! yet higher layers [degC H ~> degC m or degC kg m-2]. + !! yet higher layers [S H ~> ppt m or ppt kg m-2]. real, intent(in) :: Th_b !< An effective temperature times a thickness in the layer !! below, including implicit mixfing effects with other - !! yet lower layers [degC H ~> degC m or degC kg m-2]. + !! yet lower layers [C H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_b !< An effective salinity times a thickness in the layer !! below, including implicit mixing effects with other - !! yet lower layers [degC H ~> degC m or degC kg m-2]. + !! yet lower layers [S H ~> ppt m or ppt kg m-2]. real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column potential !! energy, including all implicit diffusive changes in the - !! temperatures of all the layers above [R Z3 T-2 degC-1 ~> J m-2 degC-1]. + !! temperatures of all the layers above [R Z3 T-2 C-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column potential !! energy, including all implicit diffusive changes in the - !! salinities of all the layers above [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + !! salinities of all the layers above [R Z3 T-2 S-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column potential !! energy, including all implicit diffusive changes in the - !! temperatures of all the layers below [R Z3 T-2 degC-1 ~> J m-2 degC-1]. + !! temperatures of all the layers below [R Z3 T-2 C-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column potential !! energy, including all implicit diffusive changes in the - !! salinities of all the layers below [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + !! salinities of all the layers below [R Z3 T-2 S-1 ~> J m-2 ppt-1]. real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [R Z2 T-2 ~> J m-3]. real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above [Z degC-1 ~> m degC-1]. + !! in the temperatures of all the layers above [Z C-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. + !! in the salinities of all the layers above [Z S-1 ~> m ppt-1]. real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below [Z degC-1 ~> m degC-1]. + !! in the temperatures of all the layers below [Z C-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. + !! in the salinities of all the layers below [Z S-1 ~> m ppt-1]. real, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface [R Z3 T-2 ~> J m-2]. @@ -1508,8 +1508,8 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & ! Local variables real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. - real :: dT_c ! The core term in the expressions for the temperature changes [degC H2 ~> degC m2 or degC kg2 m-4]. - real :: dS_c ! The core term in the expressions for the salinity changes [ppt H2 ~> ppt m2 or ppt kg2 m-4]. + real :: dT_c ! The core term in the expressions for the temperature changes [C H2 ~> degC m2 or degC kg2 m-4]. + real :: dS_c ! The core term in the expressions for the salinity changes [S H2 ~> ppt m2 or ppt kg2 m-4]. real :: PEc_core ! The diffusivity-independent core term in the expressions ! for the potential energy changes [R Z2 T-2 ~> J m-3]. real :: ColHt_core ! The diffusivity-independent core term in the expressions @@ -1587,48 +1587,48 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! is a fraction (determined from the tridiagonal solver) of !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: dTe_term !< A diffusivity-independent term related to the temperature change - !! in the layer below the interface [degC H ~> degC m or degC kg m-2]. + !! in the layer below the interface [C H ~> degC m or degC kg m-2]. real, intent(in) :: dSe_term !< A diffusivity-independent term related to the salinity change - !! in the layer below the interface [ppt H ~> ppt m or ppt kg m-2]. + !! in the layer below the interface [S H ~> ppt m or ppt kg m-2]. real, intent(in) :: dT_km1_t2 !< A diffusivity-independent term related to the - !! temperature change in the layer above the interface [degC]. + !! temperature change in the layer above the interface [C ~> degC]. real, intent(in) :: dS_km1_t2 !< A diffusivity-independent term related to the - !! salinity change in the layer above the interface [ppt]. + !! salinity change in the layer above the interface [S ~> ppt]. real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [R Z2 T-2 ~> J m-3]. real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column potential !! energy, including all implicit diffusive changes in the - !! temperatures of all the layers below [R Z3 T-2 degC-1 ~> J m-2 degC-1]. + !! temperatures of all the layers below [R Z3 T-2 C-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column potential !! energy, including all implicit diffusive changes in the - !! in the salinities of all the layers below [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + !! in the salinities of all the layers below [R Z3 T-2 S-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column potential !! energy, including all implicit diffusive changes in the - !! temperatures of all the layers above [R Z3 T-2 degC-1 ~> J m-2 degC-1]. + !! temperatures of all the layers above [R Z3 T-2 C-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column potential !! energy, including all implicit diffusive changes in the - !! salinities of all the layers above [R Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + !! salinities of all the layers above [R Z3 T-2 S-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes in the - !! temperatures of all the layers below [Z degC-1 ~> m degC-1]. + !! temperatures of all the layers below [Z C-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. + !! in the salinities of all the layers below [Z S-1 ~> m ppt-1]. real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above [Z degC-1 ~> m degC-1]. + !! in the temperatures of all the layers above [Z C-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. + !! in the salinities of all the layers above [Z S-1 ~> m ppt-1]. real, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface [R Z3 T-2 ~> J m-2]. @@ -1655,14 +1655,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real :: ColHt_chg ! The change in column thickness [Z ~> m]. real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> nondim or m3 kg-1] - real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [degC] - real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [ppt] + real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [C ~> degC] + real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [S ~> ppt] real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2] real :: dKr_dKd ! Temporary array [H-2 ~> m-2 or m4 kg-2] real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays indicating the temperature changes - ! per unit change in Kddt_h [degC H-1 ~> degC m-1 or degC m2 kg-1] + ! per unit change in Kddt_h [C H-1 ~> degC m-1 or degC m2 kg-1] real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays indicating the salinity changes - ! per unit change in Kddt_h [ppt H-1 ~> ppt m-1 or ppt m2 kg-1] + ! per unit change in Kddt_h [S H-1 ~> ppt m-1 or ppt m2 kg-1] b1 = 1.0 / (b_den_1 + Kddt_h) b1Kd = Kddt_h*b1 diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 45d442f98c..beb207624a 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -175,9 +175,9 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface [R L2 T-2 ~> Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to - ! evaluate dRho_dT and dRho_dS [degC] and [ppt]. + ! evaluate dRho_dT and dRho_dS [C ~> degC] and [S ~> ppt]. dRho_dT, dRho_dS ! The partial derivatives of potential density with temperature and - ! salinity, [R degC-1 ~> kg m-3 degC-1] and [R ppt-1 ~> kg m-3 ppt-1]. + ! salinity, [R C-1 ~> kg m-3 degC-1] and [R S-1 ~> kg m-3 ppt-1]. real :: tolerance ! The tolerance within which E must be converged [H ~> m or kg m-2]. real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. @@ -848,7 +848,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & S_eos(i) = 0.5*(tv%S(i,j,k-1) + tv%S(i,j,k)) endif enddo - call calculate_density_derivs(T_eos, S_eos, pressure, dRho_dT, dRho_dS, & + call calculate_density_derivs(T_EOS, S_EOS, pressure, dRho_dT, dRho_dS, & tv%eqn_of_state, EOSdom) do i=is,ie if ((k>kmb) .and. (k m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: T_adj !< Adjusted potential temperature [degC]. + intent(out) :: T_adj !< Adjusted potential temperature [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: S_adj !< Adjusted salinity [ppt]. + intent(out) :: S_adj !< Adjusted salinity [S ~> ppt]. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa] (or NULL). real, intent(in) :: Kddt_smooth !< A smoothing vertical !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4]. @@ -37,27 +37,27 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, ! Local variables real, dimension(SZI_(G),SZK_(GV)+1) :: & - dRho_dT, & ! The derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - dRho_dS ! The derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + dRho_dT, & ! The derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + dRho_dS ! The derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: h_neglect, h0 ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. ! logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real, dimension(SZI_(G),SZK0_(G)) :: & Te_a, & ! A partially updated temperature estimate including the influence from - ! mixing with layers above rescaled by a factor of d_a [degC]. + ! mixing with layers above rescaled by a factor of d_a [C ~> degC]. ! This array is discretized on tracer cells, but contains an extra ! layer at the top for algorithmic convenience. Se_a ! A partially updated salinity estimate including the influence from - ! mixing with layers above rescaled by a factor of d_a [ppt]. + ! mixing with layers above rescaled by a factor of d_a [S ~> ppt]. ! This array is discretized on tracer cells, but contains an extra ! layer at the top for algorithmic convenience. real, dimension(SZI_(G),SZK_(GV)+1) :: & Te_b, & ! A partially updated temperature estimate including the influence from - ! mixing with layers below rescaled by a factor of d_b [degC]. + ! mixing with layers below rescaled by a factor of d_b [C ~> degC]. ! This array is discretized on tracer cells, but contains an extra ! layer at the bottom for algorithmic convenience. Se_b ! A partially updated salinity estimate including the influence from - ! mixing with layers below rescaled by a factor of d_b [ppt]. + ! mixing with layers below rescaled by a factor of d_b [S ~> ppt]. ! This array is discretized on tracer cells, but contains an extra ! layer at the bottom for algorithmic convenience. real, dimension(SZI_(G),SZK_(GV)+1) :: & @@ -316,10 +316,10 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h real, intent(in) :: Kddt !< A diffusivity times a time increment [H2 ~> m2 or kg2 m-4]. real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: dR_dT !< Derivative of locally referenced - !! potential density with temperature [R degC-1 ~> kg m-3 degC-1] + !! potential density with temperature [R C-1 ~> kg m-3 degC-1] real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: dR_dS !< Derivative of locally referenced - !! potential density with salinity [R ppt-1 ~> kg m-3 ppt-1] + !! potential density with salinity [R S-1 ~> kg m-3 ppt-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-point to work on. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa]. @@ -331,11 +331,11 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h real :: b1(SZI_(G)) ! A tridiagonal solver variable [H-1 ~> m-1 or m2 kg-1] real :: d1(SZI_(G)) ! A tridiagonal solver variable [nondim] real :: c1(SZI_(G),SZK_(GV)) ! A tridiagonal solver variable [nondim] - real :: T_f(SZI_(G),SZK_(GV)) ! Filtered temperatures [degC] - real :: S_f(SZI_(G),SZK_(GV)) ! Filtered salinities [ppt] + real :: T_f(SZI_(G),SZK_(GV)) ! Filtered temperatures [C ~> degC] + real :: S_f(SZI_(G),SZK_(GV)) ! Filtered salinities [S ~> ppt] real :: pres(SZI_(G)) ! Interface pressures [R L2 T-2 ~> Pa]. - real :: T_EOS(SZI_(G)) ! Filtered and vertically averaged temperatures [degC] - real :: S_EOS(SZI_(G)) ! Filtered and vertically averaged salinities [ppt] + real :: T_EOS(SZI_(G)) ! Filtered and vertically averaged temperatures [C ~> degC] + real :: S_EOS(SZI_(G)) ! Filtered and vertically averaged salinities [S ~> ppt] real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4]. real :: h_neglect, h0 ! Negligible thicknesses to allow for zero thicknesses, ! [H ~> m or kg m-2]. diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index f68e518a14..ff2180497b 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -96,7 +96,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) N2_bot ! The bottom squared buoyancy frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - T_f, S_f ! The temperature and salinity in [degC] and [ppt] with the values in + T_f, S_f ! The temperature and salinity in [C ~> degC] and [S ~> ppt] with the values in ! the massless layers filled vertically by diffusion. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. @@ -180,9 +180,9 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T_f !< Temperature after vertical filtering to - !! smooth out the values in thin layers [degC]. + !! smooth out the values in thin layers [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S_f !< Salinity after vertical filtering to - !! smooth out the values in thin layers [ppt]. + !! smooth out the values in thin layers [S ~> ppt]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness [Z2 ~> m2]. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the @@ -192,14 +192,14 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) dRho_int ! The unfiltered density differences across interfaces [R ~> kg m-3]. real, dimension(SZI_(G)) :: & pres, & ! The pressure at each interface [R L2 T-2 ~> Pa]. - Temp_int, & ! The temperature at each interface [degC]. - Salin_int, & ! The salinity at each interface [ppt]. + Temp_int, & ! The temperature at each interface [C ~> degC] + Salin_int, & ! The salinity at each interface [S ~> ppt] drho_bot, & ! The density difference at the bottom of a layer [R ~> kg m-3] h_amp, & ! The amplitude of topographic roughness [Z ~> m]. hb, & ! The depth below a layer [Z ~> m]. z_from_bot, & ! The height of a layer center above the bottom [Z ~> m]. - dRho_dT, & ! The partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - dRho_dS ! The partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + dRho_dT, & ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: dz_int ! The thickness associated with an interface [Z ~> m]. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index f0f958d49d..a95edbad52 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -142,7 +142,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, dimension(SZI_(G),SZK_(GV)) :: & h_2d, & ! A 2-D version of h, but converted to [Z ~> m]. u_2d, v_2d, & ! 2-D versions of u_in and v_in, converted to [L T-1 ~> m s-1]. - T_2d, S_2d, rho_2d ! 2-D versions of T [degC], S [ppt], and rho [R ~> kg m-3]. + T_2d, S_2d, rho_2d ! 2-D versions of T [C ~> degC], S [S ~> ppt], and rho [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)+1) :: & kappa_2d, & ! 2-D version of kappa_io [Z2 T-1 ~> m2 s-1]. tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2]. @@ -151,8 +151,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz [Z L T-1 ~> m2 s-1]. v0xdz, & ! The initial meridional velocity times dz [Z L T-1 ~> m2 s-1]. - T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. - S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. + T0xdz, & ! The initial temperature times dz [C Z ~> degC m]. + S0xdz ! The initial salinity times dz [S Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1]. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [Z2 T-2 ~> m2 s-2]. @@ -339,9 +339,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: T_in !< Layer potential temperatures [degC] + intent(in) :: T_in !< Layer potential temperatures [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: S_in !< Layer salinities in ppt. + intent(in) :: S_in !< Layer salinities [S ~> ppt] type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -366,7 +366,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZIB_(G),SZK_(GV)) :: & h_2d, & ! A 2-D version of h, but converted to [Z ~> m]. u_2d, v_2d, & ! 2-D versions of u_in and v_in, converted to [L T-1 ~> m s-1]. - T_2d, S_2d, rho_2d ! 2-D versions of T [degC], S [ppt], and rho [R ~> kg m-3]. + T_2d, S_2d, rho_2d ! 2-D versions of T [C ~> degC], S [S ~> ppt], and rho [R ~> kg m-3]. real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & kappa_2d ! Quasi 2-D versions of kappa_io [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & @@ -376,8 +376,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz [L Z T-1 ~> m2 s-1]. v0xdz, & ! The initial meridional velocity times dz [L Z T-1 ~> m2 s-1]. - T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. - S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. + T0xdz, & ! The initial temperature times dz [C Z ~> degC m]. + S0xdz ! The initial salinity times dz [S Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1]. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [Z2 T-2 ~> m2 s-2]. @@ -614,9 +614,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & real, dimension(SZK_(GV)), & intent(in) :: v0xdz !< The initial meridional velocity times dz [Z L T-1 ~> m2 s-1]. real, dimension(SZK_(GV)), & - intent(in) :: T0xdz !< The initial temperature times dz [degC Z ~> degC m]. + intent(in) :: T0xdz !< The initial temperature times dz [C Z ~> degC m]. real, dimension(SZK_(GV)), & - intent(in) :: S0xdz !< The initial salinity times dz [ppt Z ~> ppt m]. + intent(in) :: S0xdz !< The initial salinity times dz [S Z ~> ppt m]. real, dimension(SZK_(GV)+1), & intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & @@ -634,10 +634,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & u, & ! The zonal velocity after a timestep of mixing [L T-1 ~> m s-1]. v, & ! The meridional velocity after a timestep of mixing [L T-1 ~> m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. - T, & ! The potential temperature after a timestep of mixing [degC]. - Sal, & ! The salinity after a timestep of mixing [ppt]. + T, & ! The potential temperature after a timestep of mixing [C ~> degC]. + Sal, & ! The salinity after a timestep of mixing [S ~> ppt]. u_test, v_test, & ! Temporary velocities [L T-1 ~> m s-1]. - T_test, S_test ! Temporary temperatures [degC] and salinities [ppt]. + T_test, S_test ! Temporary temperatures [C ~> degC] and salinities [S ~> ppt]. real, dimension(nzc+1) :: & N2, & ! The squared buoyancy frequency at an interface [T-2 ~> s-2]. @@ -658,10 +658,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & tke_pred, & ! The value of TKE from a predictor step [Z2 T-2 ~> m2 s-2]. kappa_pred, & ! The value of kappa from a predictor step [Z2 T-1 ~> m2 s-1]. pressure, & ! The pressure at an interface [R L2 T-2 ~> Pa]. - T_int, & ! The temperature interpolated to an interface [degC]. - Sal_int, & ! The salinity interpolated to an interface [ppt]. + T_int, & ! The temperature interpolated to an interface [C ~> degC]. + Sal_int, & ! The salinity interpolated to an interface [S ~> ppt]. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature - dbuoy_dS, & ! and salinity, [Z T-2 degC-1 ~> m s-2 degC-1] and [Z T-2 ppt-1 ~> m s-2 ppt-1]. + dbuoy_dS, & ! and salinity, [Z T-2 C-1 ~> m s-2 degC-1] and [Z T-2 S-1 ~> m s-2 ppt-1]. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean ! distance to the top and bottom boundaries [Z-2 ~> m-2]. K_Q, & ! Diffusivity divided by TKE [T ~> s]. @@ -1035,22 +1035,22 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity [L T-1 ~> m s-1]. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity [L T-1 ~> m s-1]. - real, dimension(nz), intent(in) :: T0 !< The initial temperature [degC]. - real, dimension(nz), intent(in) :: S0 !< The initial salinity [ppt]. + real, dimension(nz), intent(in) :: T0 !< The initial temperature [C ~> degC]. + real, dimension(nz), intent(in) :: S0 !< The initial salinity [S ~> ppt]. real, intent(in) :: dt !< The time step [T ~> s]. real, dimension(nz), intent(in) :: dz !< The grid spacing of layers [Z ~> m]. real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with - !! temperature [Z T-2 degC-1 ~> m s-2 degC-1]. + !! temperature [Z T-2 C-1 ~> m s-2 degC-1]. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with - !! salinity [Z T-2 ppt-1 ~> m s-2 ppt-1]. + !! salinity [Z T-2 S-1 ~> m s-2 ppt-1]. real, intent(in) :: vel_under !< Any velocities that are smaller in magnitude !! than this value are set to 0 [L T-1 ~> m s-1]. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt [L T-1 ~> m s-1]. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt [L T-1 ~> m s-1]. - real, dimension(nz), intent(inout) :: T !< The temperature after dt [degC]. - real, dimension(nz), intent(inout) :: Sal !< The salinity after dt [ppt]. + real, dimension(nz), intent(inout) :: T !< The temperature after dt [C ~> degC]. + real, dimension(nz), intent(inout) :: Sal !< The salinity after dt [S ~> ppt]. real, dimension(nz+1), intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2]. real, dimension(nz+1), intent(inout) :: S2 !< The squared shear at interfaces [T-2 ~> s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index f21bc9fa84..a8e08d8cab 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -74,18 +74,18 @@ module MOM_neutral_diffusion real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_T !< Polynomial coefficients for temperature real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_S !< Polynomial coefficients for salinity ! Variables needed for continuous reconstructions - real, allocatable, dimension(:,:,:) :: dRdT !< dRho/dT [R degC-1 ~> kg m-3 degC-1] at interfaces - real, allocatable, dimension(:,:,:) :: dRdS !< dRho/dS [R ppt-1 ~> kg m-3 ppt-1] at interfaces - real, allocatable, dimension(:,:,:) :: Tint !< Interface T [degC] - real, allocatable, dimension(:,:,:) :: Sint !< Interface S [ppt] + real, allocatable, dimension(:,:,:) :: dRdT !< dRho/dT [R C-1 ~> kg m-3 degC-1] at interfaces + real, allocatable, dimension(:,:,:) :: dRdS !< dRho/dS [R S-1 ~> kg m-3 ppt-1] at interfaces + real, allocatable, dimension(:,:,:) :: Tint !< Interface T [C ~> degC] + real, allocatable, dimension(:,:,:) :: Sint !< Interface S [S ~> ppt] real, allocatable, dimension(:,:,:) :: Pint !< Interface pressure [R L2 T-2 ~> Pa] ! Variables needed for discontinuous reconstructions - real, allocatable, dimension(:,:,:,:) :: T_i !< Top edge reconstruction of temperature [degC] - real, allocatable, dimension(:,:,:,:) :: S_i !< Top edge reconstruction of salinity [ppt] + real, allocatable, dimension(:,:,:,:) :: T_i !< Top edge reconstruction of temperature [C ~> degC] + real, allocatable, dimension(:,:,:,:) :: S_i !< Top edge reconstruction of salinity [S ~> ppt] real, allocatable, dimension(:,:,:,:) :: P_i !< Interface pressures [R L2 T-2 ~> Pa] - real, allocatable, dimension(:,:,:,:) :: dRdT_i !< dRho/dT [R degC-1 ~> kg m-3 degC-1] at top edge - real, allocatable, dimension(:,:,:,:) :: dRdS_i !< dRho/dS [R ppt-1 ~> kg m-3 ppt-1] at top edge - integer, allocatable, dimension(:,:) :: ns !< Number of interfacs in a column + real, allocatable, dimension(:,:,:,:) :: dRdT_i !< dRho/dT [R C-1 ~> kg m-3 degC-1] at top edge + real, allocatable, dimension(:,:,:,:) :: dRdS_i !< dRho/dS [R S-1 ~> kg m-3 ppt-1] at top edge + integer, allocatable, dimension(:,:) :: ns !< Number of interfaces in a column logical, allocatable, dimension(:,:,:) :: stable_cell !< True if the cell is stably stratified wrt to the next cell real :: R_to_kg_m3 = 1.0 !< A rescaling factor translating density to kg m-3 for !! use in diagnostic messages [kg m-3 R-1 ~> 1]. @@ -286,8 +286,8 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T !< Potential temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S !< Salinity [S ~> ppt] type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: p_surf !< Surface pressure to include in pressures used !! for equation of state calculations [R L2 T-2 ~> Pa] @@ -372,7 +372,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) enddo ; enddo ; enddo ! Pressures at the interfaces, this is redundant as P_i(k,1) = P_i(k-1,2) however retain this - ! for now to ensure consitency of indexing for diiscontinuous reconstructions + ! for now to ensure consistency of indexing for discontinuous reconstructions if (.not. CS%continuous_reconstruction) then if (present(p_surf)) then do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 @@ -805,9 +805,9 @@ real function ppm_ave(xL, xR, aL, aR, aMean) a6 = 3. * a6o3 if (dx<0.) then - stop 'ppm_ave: dx<0 should not happend!' + stop 'ppm_ave: dx<0 should not happened!' elseif (dx>1.) then - stop 'ppm_ave: dx>1 should not happend!' + stop 'ppm_ave: dx>1 should not happened!' elseif (dx==0.) then ppm_ave = aL + ( aR - aL ) * xR + a6 * xR * ( 1. - xR ) else @@ -954,15 +954,15 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS dRdTr, dRdSr, PoL, PoR, KoL, KoR, hEff, bl_kl, bl_kr, bl_zl, bl_zr) integer, intent(in) :: nk !< Number of levels real, dimension(nk+1), intent(in) :: Pl !< Left-column interface pressure [R L2 T-2 ~> Pa] or other units - real, dimension(nk+1), intent(in) :: Tl !< Left-column interface potential temperature [degC] - real, dimension(nk+1), intent(in) :: Sl !< Left-column interface salinity [ppt] - real, dimension(nk+1), intent(in) :: dRdTl !< Left-column dRho/dT [R degC-1 ~> kg m-3 degC-1] - real, dimension(nk+1), intent(in) :: dRdSl !< Left-column dRho/dS [R ppt-1 ~> kg m-3 ppt-1] + real, dimension(nk+1), intent(in) :: Tl !< Left-column interface potential temperature [C ~> degC] + real, dimension(nk+1), intent(in) :: Sl !< Left-column interface salinity [S ~> ppt] + real, dimension(nk+1), intent(in) :: dRdTl !< Left-column dRho/dT [R C-1 ~> kg m-3 degC-1] + real, dimension(nk+1), intent(in) :: dRdSl !< Left-column dRho/dS [R S-1 ~> kg m-3 ppt-1] real, dimension(nk+1), intent(in) :: Pr !< Right-column interface pressure [R L2 T-2 ~> Pa] or other units - real, dimension(nk+1), intent(in) :: Tr !< Right-column interface potential temperature [degC] - real, dimension(nk+1), intent(in) :: Sr !< Right-column interface salinity [ppt] - real, dimension(nk+1), intent(in) :: dRdTr !< Left-column dRho/dT [R degC-1 ~> kg m-3 degC-1] - real, dimension(nk+1), intent(in) :: dRdSr !< Left-column dRho/dS [R ppt-1 ~> kg m-3 ppt-1] + real, dimension(nk+1), intent(in) :: Tr !< Right-column interface potential temperature [C ~> degC] + real, dimension(nk+1), intent(in) :: Sr !< Right-column interface salinity [S ~> ppt] + real, dimension(nk+1), intent(in) :: dRdTr !< Left-column dRho/dT [R C-1 ~> kg m-3 degC-1] + real, dimension(nk+1), intent(in) :: dRdSr !< Left-column dRho/dS [R S-1 ~> kg m-3 ppt-1] real, dimension(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within !! layer KoL of left column [nondim] real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within @@ -1199,7 +1199,7 @@ real function interpolate_for_nondim_position(dRhoNeg, Pneg, dRhoPos, Ppos) end function interpolate_for_nondim_position !> Higher order version of find_neutral_surface_positions. Returns positions within left/right columns -!! of combined interfaces using intracell reconstructions of T/S. Note that the polynomial reconstrcutions +!! of combined interfaces using intracell reconstructions of T/S. Note that the polynomial reconstructions !! of T and S are optional to aid with unit testing, but will always be passed otherwise subroutine find_neutral_surface_positions_discontinuous(CS, nk, & Pres_l, hcol_l, Tl, Sl, ppoly_T_l, ppoly_S_l, stable_l, & @@ -1211,18 +1211,21 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, & real, dimension(nk,2), intent(in) :: Pres_l !< Left-column interface pressure [R L2 T-2 ~> Pa] real, dimension(nk), intent(in) :: hcol_l !< Left-column layer thicknesses [H ~> m or kg m-2] !! or other units - real, dimension(nk,2), intent(in) :: Tl !< Left-column top interface potential temperature [degC] - real, dimension(nk,2), intent(in) :: Sl !< Left-column top interface salinity [ppt] - real, dimension(:,:), intent(in) :: ppoly_T_l !< Left-column coefficients of T reconstruction [degC] - real, dimension(:,:), intent(in) :: ppoly_S_l !< Left-column coefficients of S reconstruction [ppt] + real, dimension(nk,2), intent(in) :: Tl !< Left-column top interface potential + !! temperature [C ~> degC] + real, dimension(nk,2), intent(in) :: Sl !< Left-column top interface salinity [S ~> ppt] + real, dimension(:,:), intent(in) :: ppoly_T_l !< Left-column coefficients of T reconstruction [C ~> degC] + real, dimension(:,:), intent(in) :: ppoly_S_l !< Left-column coefficients of S reconstruction [S ~> ppt] logical, dimension(nk), intent(in) :: stable_l !< True where the left-column is stable real, dimension(nk,2), intent(in) :: Pres_r !< Right-column interface pressure [R L2 T-2 ~> Pa] real, dimension(nk), intent(in) :: hcol_r !< Left-column layer thicknesses [H ~> m or kg m-2] !! or other units - real, dimension(nk,2), intent(in) :: Tr !< Right-column top interface potential temperature [degC] - real, dimension(nk,2), intent(in) :: Sr !< Right-column top interface salinity [ppt] - real, dimension(:,:), intent(in) :: ppoly_T_r !< Right-column coefficients of T reconstruction [degC] - real, dimension(:,:), intent(in) :: ppoly_S_r !< Right-column coefficients of S reconstruction [ppt] + real, dimension(nk,2), intent(in) :: Tr !< Right-column top interface potential + !! temperature [C ~> degC] + real, dimension(nk,2), intent(in) :: Sr !< Right-column top interface salinity [S ~> ppt] + real, dimension(:,:), intent(in) :: ppoly_T_r !< Right-column coefficients of T + !! reconstruction [C ~> degC] + real, dimension(:,:), intent(in) :: ppoly_S_r !< Right-column coefficients of S reconstruction [S ~> ppt] logical, dimension(nk), intent(in) :: stable_r !< True where the right-column is stable real, dimension(4*nk), intent(inout) :: PoL !< Fractional position of neutral surface within !! layer KoL of left column [nondim] @@ -1233,9 +1236,9 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, & real, dimension(4*nk-1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces !! [H ~> m or kg m-2] or other units taken from hcol_l real, optional, intent(in) :: zeta_bot_L!< Non-dimensional distance to where the boundary layer - !! intersetcs the cell (left) [nondim] + !! intersects the cell (left) [nondim] real, optional, intent(in) :: zeta_bot_R!< Non-dimensional distance to where the boundary layer - !! intersetcs the cell (right) [nondim] + !! intersects the cell (right) [nondim] integer, optional, intent(in) :: k_bot_L !< k-index for the boundary layer (left) [nondim] integer, optional, intent(in) :: k_bot_R !< k-index for the boundary layer (right) [nondim] @@ -1438,8 +1441,8 @@ end subroutine find_neutral_surface_positions_discontinuous subroutine mark_unstable_cells(CS, nk, T, S, P, stable_cell) type(neutral_diffusion_CS), intent(inout) :: CS !< Neutral diffusion control structure integer, intent(in) :: nk !< Number of levels in a column - real, dimension(nk,2), intent(in) :: T !< Temperature at interfaces [degC] - real, dimension(nk,2), intent(in) :: S !< Salinity at interfaces [ppt] + real, dimension(nk,2), intent(in) :: T !< Temperature at interfaces [C ~> degC] + real, dimension(nk,2), intent(in) :: S !< Salinity at interfaces [S ~> ppt] real, dimension(nk,2), intent(in) :: P !< Pressure at interfaces [R L2 T-2 ~> Pa] logical, dimension(nk), intent( out) :: stable_cell !< True if this cell is unstably stratified @@ -1460,25 +1463,27 @@ real function search_other_column(CS, ksurf, pos_last, T_from, S_from, P_from, T integer, intent(in ) :: ksurf !< Current index of neutral surface real, intent(in ) :: pos_last !< Last position within the current layer, used as the lower !! bound in the root finding algorithm [nondim] - real, intent(in ) :: T_from !< Temperature at the searched from interface [degC] - real, intent(in ) :: S_from !< Salinity at the searched from interface [ppt] + real, intent(in ) :: T_from !< Temperature at the searched from interface [C ~> degC] + real, intent(in ) :: S_from !< Salinity at the searched from interface [S ~> ppt] real, intent(in ) :: P_from !< Pressure at the searched from interface [R L2 T-2 ~> Pa] - real, intent(in ) :: T_top !< Temperature at the searched to top interface [degC] - real, intent(in ) :: S_top !< Salinity at the searched to top interface [ppt] + real, intent(in ) :: T_top !< Temperature at the searched to top interface [C ~> degC] + real, intent(in ) :: S_top !< Salinity at the searched to top interface [S ~> ppt] real, intent(in ) :: P_top !< Pressure at the searched to top interface [R L2 T-2 ~> Pa] !! interface [R L2 T-2 ~> Pa] - real, intent(in ) :: T_bot !< Temperature at the searched to bottom interface [degC] - real, intent(in ) :: S_bot !< Salinity at the searched to bottom interface [ppt] + real, intent(in ) :: T_bot !< Temperature at the searched to bottom interface [C ~> degC] + real, intent(in ) :: S_bot !< Salinity at the searched to bottom interface [S ~> ppt] real, intent(in ) :: P_bot !< Pressure at the searched to bottom !! interface [R L2 T-2 ~> Pa] - real, dimension(:), intent(in ) :: T_poly !< Temperature polynomial reconstruction coefficients [degC] - real, dimension(:), intent(in ) :: S_poly !< Salinity polynomial reconstruction coefficients [ppt] + real, dimension(:), intent(in ) :: T_poly !< Temperature polynomial reconstruction + !! coefficients [C ~> degC] + real, dimension(:), intent(in ) :: S_poly !< Salinity polynomial reconstruction + !! coefficients [S ~> ppt] ! Local variables real :: dRhotop, dRhobot ! Density differences [R ~> kg m-3] - real :: dRdT_top, dRdT_bot, dRdT_from ! Partial derivatives of density with temperature [R degC-1 ~> kg m-3 degC-1] - real :: dRdS_top, dRdS_bot, dRdS_from ! Partial derivatives of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + real :: dRdT_top, dRdT_bot, dRdT_from ! Partial derivatives of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: dRdS_top, dRdS_bot, dRdS_from ! Partial derivatives of density with salinity [R S-1 ~> kg m-3 ppt-1] - ! Calculate the differencei in density at the tops or the bottom + ! Calculate the difference in density at the tops or the bottom if (CS%neutral_pos_method == 1 .or. CS%neutral_pos_method == 3) then call calc_delta_rho_and_derivs(CS, T_top, S_top, P_top, T_from, S_from, P_from, dRhoTop) call calc_delta_rho_and_derivs(CS, T_bot, S_bot, P_bot, T_from, S_from, P_from, dRhoBot) @@ -1511,7 +1516,7 @@ real function search_other_column(CS, ksurf, pos_last, T_from, S_from, P_from, T if (CS%neutral_pos_method==1) then pos = interpolate_for_nondim_position( dRhoTop, P_top, dRhoBot, P_bot ) - ! For the 'Linear' case of finding the neutral position, the fromerence pressure to use is the average + ! For the 'Linear' case of finding the neutral position, the reference pressure to use is the average ! of the midpoint of the layer being searched and the interface being searched from elseif (CS%neutral_pos_method == 2) then pos = find_neutral_pos_linear( CS, pos_last, T_from, S_from, dRdT_from, dRdS_from, & @@ -1561,35 +1566,35 @@ function find_neutral_pos_linear( CS, z0, T_ref, S_ref, dRdT_ref, dRdS_ref, & type(neutral_diffusion_CS),intent(in) :: CS !< Control structure with parameters for this module real, intent(in) :: z0 !< Lower bound of position, also serves as the !! initial guess [nondim] - real, intent(in) :: T_ref !< Temperature at the searched from interface [degC] - real, intent(in) :: S_ref !< Salinity at the searched from interface [ppt] + real, intent(in) :: T_ref !< Temperature at the searched from interface [C ~> degC] + real, intent(in) :: S_ref !< Salinity at the searched from interface [S ~> ppt] real, intent(in) :: dRdT_ref !< dRho/dT at the searched from interface - !! [R degC-1 ~> kg m-3 degC-1] + !! [R C-1 ~> kg m-3 degC-1] real, intent(in) :: dRdS_ref !< dRho/dS at the searched from interface - !! [R ppt-1 ~> kg m-3 ppt-1] + !! [R S-1 ~> kg m-3 ppt-1] real, intent(in) :: dRdT_top !< dRho/dT at top of layer being searched - !! [R degC-1 ~> kg m-3 degC-1] + !! [R C-1 ~> kg m-3 degC-1] real, intent(in) :: dRdS_top !< dRho/dS at top of layer being searched - !! [R ppt-1 ~> kg m-3 ppt-1] + !! [R S-1 ~> kg m-3 ppt-1] real, intent(in) :: dRdT_bot !< dRho/dT at bottom of layer being searched - !! [R degC-1 ~> kg m-3 degC-1] + !! [R C-1 ~> kg m-3 degC-1] real, intent(in) :: dRdS_bot !< dRho/dS at bottom of layer being searched - !! [R ppt-1 ~> kg m-3 ppt-1] + !! [R S-1 ~> kg m-3 ppt-1] real, dimension(:), intent(in) :: ppoly_T !< Coefficients of the polynomial reconstruction of T within - !! the layer to be searched [degC]. + !! the layer to be searched [C ~> degC]. real, dimension(:), intent(in) :: ppoly_S !< Coefficients of the polynomial reconstruction of S within - !! the layer to be searched [ppt]. + !! the layer to be searched [S ~> ppt]. real :: z !< Position where drho = 0 [nondim] ! Local variables real :: dRdT_diff ! Difference in the partial derivative of density with temperature across the - ! layer [R degC-1 ~> kg m-3 degC-1] + ! layer [R C-1 ~> kg m-3 degC-1] real :: dRdS_diff ! Difference in the partial derivative of density with salinity across the - ! layer [R ppt-1 ~> kg m-3 ppt-1] - real :: drho, drho_dz ! Density anomaly and its derivative with fracitonal position [R ~> kg m-3] - real :: dRdT_z ! Partial derivative of density with temperature at a point [R degC-1 ~> kg m-3 degC-1] - real :: dRdS_z ! Partial derivative of density with salinity at a point [R ppt-1 ~> kg m-3 ppt-1] - real :: T_z, dT_dz ! Temperature at a point and its derivative with fractional position [degC] - real :: S_z, dS_dz ! Salinity at a point and its derivative with fractional position [ppt] + ! layer [R S-1 ~> kg m-3 ppt-1] + real :: drho, drho_dz ! Density anomaly and its derivative with fractional position [R ~> kg m-3] + real :: dRdT_z ! Partial derivative of density with temperature at a point [R C-1 ~> kg m-3 degC-1] + real :: dRdS_z ! Partial derivative of density with salinity at a point [R S-1 ~> kg m-3 ppt-1] + real :: T_z, dT_dz ! Temperature at a point and its derivative with fractional position [C ~> degC] + real :: S_z, dS_dz ! Salinity at a point and its derivative with fractional position [S ~> ppt] real :: drho_min, drho_max ! Bounds on density differences [R ~> kg m-3] real :: ztest, zmin, zmax ! Fractional positions in the cell [nondim] real :: a1, a2 ! Fractional weights of the top and bottom values [nondim] @@ -1680,15 +1685,15 @@ function find_neutral_pos_full( CS, z0, T_ref, S_ref, P_ref, P_top, P_bot, ppoly type(neutral_diffusion_CS),intent(in) :: CS !< Control structure with parameters for this module real, intent(in) :: z0 !< Lower bound of position, also serves as the !! initial guess [nondim] - real, intent(in) :: T_ref !< Temperature at the searched from interface [degC] - real, intent(in) :: S_ref !< Salinity at the searched from interface [ppt] + real, intent(in) :: T_ref !< Temperature at the searched from interface [C ~> degC] + real, intent(in) :: S_ref !< Salinity at the searched from interface [S ~> ppt] real, intent(in) :: P_ref !< Pressure at the searched from interface [R L2 T-2 ~> Pa] real, intent(in) :: P_top !< Pressure at top of layer being searched [R L2 T-2 ~> Pa] real, intent(in) :: P_bot !< Pressure at bottom of layer being searched [R L2 T-2 ~> Pa] real, dimension(:), intent(in) :: ppoly_T !< Coefficients of the polynomial reconstruction of T within - !! the layer to be searched [degC] + !! the layer to be searched [C ~> degC] real, dimension(:), intent(in) :: ppoly_S !< Coefficients of the polynomial reconstruction of T within - !! the layer to be searched [ppt] + !! the layer to be searched [S ~> ppt] real :: z !< Position where drho = 0 [nondim] ! Local variables integer :: iter @@ -1696,8 +1701,8 @@ function find_neutral_pos_full( CS, z0, T_ref, S_ref, P_ref, P_top, P_bot, ppoly real :: drho_a, drho_b, drho_c ! Density differences [R ~> kg m-3] real :: a, b, c ! Fractional positions [nondim] - real :: Ta, Tb, Tc ! Temperatures [degC] - real :: Sa, Sb, Sc ! Salinities [ppt] + real :: Ta, Tb, Tc ! Temperatures [C ~> degC] + real :: Sa, Sb, Sc ! Salinities [S ~> ppt] real :: Pa, Pb, Pc ! Pressures [R L2 T-2 ~> Pa] integer :: side @@ -1772,22 +1777,22 @@ end function find_neutral_pos_full subroutine calc_delta_rho_and_derivs(CS, T1, S1, p1_in, T2, S2, p2_in, drho, & drdt1_out, drds1_out, drdt2_out, drds2_out ) type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure - real, intent(in ) :: T1 !< Temperature at point 1 [degC] - real, intent(in ) :: S1 !< Salinity at point 1 [ppt] + real, intent(in ) :: T1 !< Temperature at point 1 [C ~> degC] + real, intent(in ) :: S1 !< Salinity at point 1 [S ~> ppt] real, intent(in ) :: p1_in !< Pressure at point 1 [R L2 T-2 ~> Pa] - real, intent(in ) :: T2 !< Temperature at point 2 [degC] - real, intent(in ) :: S2 !< Salinity at point 2 [ppt] + real, intent(in ) :: T2 !< Temperature at point 2 [C ~> degC] + real, intent(in ) :: S2 !< Salinity at point 2 [S ~> ppt] real, intent(in ) :: p2_in !< Pressure at point 2 [R L2 T-2 ~> Pa] real, intent( out) :: drho !< Difference in density between the two points [R ~> kg m-3] - real, optional, intent( out) :: dRdT1_out !< drho_dt at point 1 [R degC-1 ~> kg m-3 degC-1] - real, optional, intent( out) :: dRdS1_out !< drho_ds at point 1 [R ppt-1 ~> kg m-3 ppt-1] - real, optional, intent( out) :: dRdT2_out !< drho_dt at point 2 [R degC-1 ~> kg m-3 degC-1] - real, optional, intent( out) :: dRdS2_out !< drho_ds at point 2 [R ppt-1 ~> kg m-3 ppt-1] + real, optional, intent( out) :: dRdT1_out !< drho_dt at point 1 [R C-1 ~> kg m-3 degC-1] + real, optional, intent( out) :: dRdS1_out !< drho_ds at point 1 [R S-1 ~> kg m-3 ppt-1] + real, optional, intent( out) :: dRdT2_out !< drho_dt at point 2 [R C-1 ~> kg m-3 degC-1] + real, optional, intent( out) :: dRdS2_out !< drho_ds at point 2 [R S-1 ~> kg m-3 ppt-1] ! Local variables real :: rho1, rho2 ! Densities [R ~> kg m-3] real :: p1, p2, pmid ! Pressures [R L2 T-2 ~> Pa] - real :: drdt1, drdt2 ! Partial derivatives of density with temperature [R degC-1 ~> kg m-3 degC-1] - real :: drds1, drds2 ! Partial derivatives of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + real :: drdt1, drdt2 ! Partial derivatives of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: drds1, drds2 ! Partial derivatives of density with salinity [R S-1 ~> kg m-3 ppt-1] ! Use the same reference pressure or the in-situ pressure if (CS%ref_pres > 0.) then @@ -1801,10 +1806,10 @@ subroutine calc_delta_rho_and_derivs(CS, T1, S1, p1_in, T2, S2, p2_in, drho, & ! Use the full linear equation of state to calculate the difference in density (expensive!) if (TRIM(CS%delta_rho_form) == 'full') then pmid = 0.5 * (p1 + p2) - call calculate_density( T1, S1, pmid, rho1, CS%EOS) - call calculate_density( T2, S2, pmid, rho2, CS%EOS) + call calculate_density(T1, S1, pmid, rho1, CS%EOS) + call calculate_density(T2, S2, pmid, rho2, CS%EOS) drho = rho1 - rho2 - ! Use the density derivatives at the average of pressures and the differentces int temperature + ! Use the density derivatives at the average of pressures and the differences in temperature elseif (TRIM(CS%delta_rho_form) == 'mid_pressure') then pmid = 0.5 * (p1 + p2) if (CS%ref_pres>=0) pmid = CS%ref_pres @@ -1832,16 +1837,16 @@ end subroutine calc_delta_rho_and_derivs !! (\gamma^{-1}_1 + \gamma^{-1}_2)*(P_1-P_2) \right] \f$ function delta_rho_from_derivs( T1, S1, P1, dRdT1, dRdS1, & T2, S2, P2, dRdT2, dRdS2 ) result (drho) - real :: T1 !< Temperature at point 1 [degC] - real :: S1 !< Salinity at point 1 [ppt] + real :: T1 !< Temperature at point 1 [C ~> degC] + real :: S1 !< Salinity at point 1 [S ~> ppt] real :: P1 !< Pressure at point 1 [R L2 T-2 ~> Pa] - real :: dRdT1 !< The partial derivative of density with temperature at point 1 [R degC-1 ~> kg m-3 degC-1] - real :: dRdS1 !< The partial derivative of density with salinity at point 1 [R ppt-1 ~> kg m-3 ppt-1] - real :: T2 !< Temperature at point 2 [degC] - real :: S2 !< Salinity at point 2 [ppt] + real :: dRdT1 !< The partial derivative of density with temperature at point 1 [R C-1 ~> kg m-3 degC-1] + real :: dRdS1 !< The partial derivative of density with salinity at point 1 [R S-1 ~> kg m-3 ppt-1] + real :: T2 !< Temperature at point 2 [C ~> degC] + real :: S2 !< Salinity at point 2 [S ~> ppt] real :: P2 !< Pressure at point 2 [R L2 T-2 ~> Pa] - real :: dRdT2 !< The partial derivative of density with temperature at point 2 [R degC-1 ~> kg m-3 degC-1] - real :: dRdS2 !< The partial derivative of density with salinity at point 2 [R ppt-1 ~> kg m-3 ppt-1] + real :: dRdT2 !< The partial derivative of density with temperature at point 2 [R C-1 ~> kg m-3 degC-1] + real :: dRdS2 !< The partial derivative of density with salinity at point 2 [R S-1 ~> kg m-3 ppt-1] ! Local variables real :: drho ! The density difference [R ~> kg m-3] @@ -2015,10 +2020,10 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K end subroutine neutral_surface_flux -!> Evaluate various parts of the reconstructions to calculate gradient-based flux limter +!> Evaluate various parts of the reconstructions to calculate gradient-based flux limiter subroutine neutral_surface_T_eval(nk, ns, k_sub, Ks, Ps, T_mean, T_int, deg, iMethod, T_poly, & T_top, T_bot, T_sub, T_top_int, T_bot_int, T_layer) - integer, intent(in ) :: nk !< Number of cell everages + integer, intent(in ) :: nk !< Number of cell averages integer, intent(in ) :: ns !< Number of neutral surfaces integer, intent(in ) :: k_sub !< Index of current neutral layer integer, dimension(ns), intent(in ) :: Ks !< List of the layers associated with each neutral surface @@ -2033,7 +2038,7 @@ subroutine neutral_surface_T_eval(nk, ns, k_sub, Ks, Ps, T_mean, T_int, deg, iMe real, intent( out) :: T_sub !< Average of the tracer value over the sublayer real, intent( out) :: T_top_int !< Tracer value at top interface of neutral layer real, intent( out) :: T_bot_int !< Tracer value at bottom interface of neutral layer - real, intent( out) :: T_layer !< Cell-average that the the reconstruction belongs to + real, intent( out) :: T_layer !< Cell-average that the reconstruction belongs to integer :: kl, ks_top, ks_bot @@ -2376,8 +2381,8 @@ logical function ndiff_unit_tests_discontinuous(verbose) real, dimension(ns) :: PoL, PoR real, dimension(ns-1) :: hEff type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure - real, dimension(nk,2) :: ppoly_T_l, ppoly_T_r ! Linear reconstruction for T - real, dimension(nk,2) :: ppoly_S_l, ppoly_S_r ! Linear reconstruction for S + real, dimension(nk,2) :: ppoly_T_l, ppoly_T_r ! Linear reconstruction for T [degC] + real, dimension(nk,2) :: ppoly_S_l, ppoly_S_r ! Linear reconstruction for S [ppt] logical, dimension(nk) :: stable_l, stable_r integer :: k logical :: v diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 24252dfedc..22e41c2c1d 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -711,7 +711,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & ! Determine which layers the mixed- and buffer-layers map into... !$OMP parallel do default(shared) do k=1,nkmb ; do j=js-2,je+2 - call calculate_density(tv%T(:,j,k),tv%S(:,j,k), p_ref_cv, rho_coord(:,j,k), & + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref_cv, rho_coord(:,j,k), & tv%eqn_of_state, EOSdom) enddo ; enddo From b8e599034f5a5e9e1e37d3028bcb2d82b1b8384c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 May 2022 08:21:28 -0400 Subject: [PATCH 10/68] +Temperature and salinity rescaling in MOM_EOS.F90 Added rescaling conversion factors for temperature and salinity to the EOS_type and added code to all of the EOS routines that work with dimensionally rescaled arguments to handle these new rescaling factors. Also added new optional arguments to int_density_dz_wright and int_spec_vol_dp_wright to handle rescaling temperature and salinity. There are also many places in MOM_EOS.F90 where comments are altered to reflect the new rescaled units. However, for now these new rescaling factors are hard-coded to 1, so there is no new rescaling yet, and all answers are bitwise identical. There are, however, new optional arguments in two public interfaces. --- src/equation_of_state/MOM_EOS.F90 | 433 +++++++++++++++-------- src/equation_of_state/MOM_EOS_Wright.F90 | 116 ++++-- src/equation_of_state/MOM_EOS_linear.F90 | 16 +- 3 files changed, 385 insertions(+), 180 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 4542c678f2..1b016d044b 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -127,6 +127,10 @@ module MOM_EOS real :: R_to_kg_m3 = 1. !< A constant that translates the units of density to kilograms per meter cubed. real :: RL2_T2_to_Pa = 1.!< Convert pressures from R L2 T-2 to Pa. real :: L_T_to_m_s = 1. !< Convert lateral velocities from L T-1 to m s-1. + real :: degC_to_C = 1. !< A constant that translates degrees Celsius to the units of temperature. + real :: C_to_degC = 1. !< A constant that translates the units of temperature to degrees Celsius. + real :: ppt_to_S = 1. !< A constant that translates parts per thousand to the units of salinity. + real :: S_to_ppt = 1. !< A constant that translates the units of salinity to parts per thousand. ! logical :: test_EOS = .true. ! If true, test the equation of state end type EOS_type @@ -161,8 +165,8 @@ module MOM_EOS !! density can be rescaled with the US. If both the US and scale arguments are present the density !! scaling uses the product of the two scaling factors. subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) - real, intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, intent(in) :: S !< Salinity [S ~> ppt] real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, intent(out) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] type(EOS_type), intent(in) :: EOS !< Equation of state structure @@ -177,7 +181,7 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] pres(1) = EOS%RL2_T2_to_Pa * pressure - Ta(1) = T ; Sa(1) = S + Ta(1) = EOS%C_to_degC * T ; Sa(1) = EOS%S_to_ppt * S if (present(rho_ref)) then call calculate_density_array(Ta, Sa, pres, rho_mks, 1, 1, EOS, EOS%R_to_kg_m3*rho_ref) else @@ -198,11 +202,11 @@ end subroutine calculate_density_scalar !! If rho_ref is present, the anomaly with respect to rho_ref is returned. The !! density can be rescaled using rho_ref. subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, rho, EOS, rho_ref, scale) - real, intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: Tvar !< Variance of potential temperature referenced to the surface [degC2] - real, intent(in) :: TScov !< Covariance of potential temperature and salinity [degC ppt] - real, intent(in) :: Svar !< Variance of salinity [ppt2] + real, intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, intent(in) :: S !< Salinity [S ~> ppt] + real, intent(in) :: Tvar !< Variance of potential temperature referenced to the surface [C2 ~> degC2] + real, intent(in) :: TScov !< Covariance of potential temperature and salinity [C S ~> degC ppt] + real, intent(in) :: Svar !< Variance of salinity [S2 ~> ppt2] real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, intent(out) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] type(EOS_type), intent(in) :: EOS !< Equation of state structure @@ -211,27 +215,32 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r !! combination with scaling given by US [various] ! Local variables real :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] + real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] + real :: T_scale ! A factor to convert temperature to units of degC [degC C-1 ~> 1] + real :: S_scale ! A factor to convert salinity to units of ppt [ppt S-1 ~> 1] call calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref) p_scale = EOS%RL2_T2_to_Pa + T_scale = EOS%C_to_degC + S_scale = EOS%S_to_ppt select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T, S, p_scale*pressure, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP) + call calculate_density_second_derivs_linear(T_scale*T, S_scale*S, p_scale*pressure, & + d2RdSS, d2RdST, d2RdTT, d2RdSp, d2RdTP) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T, S, p_scale*pressure, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP) + call calculate_density_second_derivs_wright(T_scale*T, S_scale*S, p_scale*pressure, & + d2RdSS, d2RdST, d2RdTT, d2RdSp, d2RdTP) case (EOS_TEOS10) - call calculate_density_second_derivs_teos10(T, S, p_scale*pressure, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP) + call calculate_density_second_derivs_teos10(T_scale*T, S_scale*S, p_scale*pressure, & + d2RdSS, d2RdST, d2RdTT, d2RdSp, d2RdTP) case default call MOM_error(FATAL, "calculate_stanley_density_scalar: EOS is not valid.") end select ! Equation 25 of Stanley et al., 2020. - rho = rho + EOS%kg_m3_to_R * ( 0.5 * d2RdTT * Tvar + ( d2RdST * TScov + 0.5 * d2RdSS * Svar ) ) + rho = rho + EOS%kg_m3_to_R * ( 0.5 * (T_scale**2 * d2RdTT) * Tvar + & + ( (S_scale*T_scale * d2RdST) * TScov + 0.5 * (S_scale**2 * d2RdSS) * Svar ) ) if (present(scale)) rho = rho * scale @@ -332,8 +341,8 @@ end subroutine calculate_stanley_density_array !! potentially limiting the domain of indices that are worked on. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, dimension(:), intent(in) :: S !< Salinity [S ~> ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] type(EOS_type), intent(in) :: EOS !< Equation of state structure @@ -344,8 +353,9 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) !! in combination with scaling given by US [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - real :: rho_reference ! rho_ref converted to [kg m-3] real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] + real, dimension(size(rho)) :: Ta ! Temperature converted to [degC] + real, dimension(size(rho)) :: Sa ! Salinity converted to [ppt] integer :: i, is, ie, npts if (present(dom)) then @@ -354,16 +364,20 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) is = 1 ; ie = size(rho) ; npts = 1 + ie - is endif - if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%R_to_kg_m3 == 1.0)) then + if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%R_to_kg_m3 == 1.0) .and. & + (EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then call calculate_density_array(T, S, pressure, rho, is, npts, EOS, rho_ref=rho_ref) - elseif (present(rho_ref)) then ! This is the same as above, but with some extra work to rescale variables. - do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo - rho_reference = EOS%R_to_kg_m3*rho_ref - call calculate_density_array(T, S, pres, rho, is, npts, EOS, rho_ref=rho_reference) - else ! There is rescaling of variables, but rho_ref is not present. Passing a 0 value of rho_ref - ! changes answers at roundoff for some equations of state, like Wright and UNESCO. - do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo - call calculate_density_array(T, S, pres, rho, is, npts, EOS) + else ! This is the same as above, but with some extra work to rescale variables. + do i=is,ie + pres(i) = EOS%RL2_T2_to_Pa * pressure(i) + Ta(i) = EOS%C_to_degC * T(i) + Sa(i) = EOS%S_to_ppt * S(i) + enddo + if (present(rho_ref)) then + call calculate_density_array(Ta, Sa, pres, rho, is, npts, EOS, rho_ref=EOS%R_to_kg_m3*rho_ref) + else + call calculate_density_array(Ta, Sa, pres, rho, is, npts, EOS) + endif endif rho_scale = EOS%kg_m3_to_R @@ -381,12 +395,12 @@ end subroutine calculate_density_1d !! in Stanley et al., 2020. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, EOS, dom, rho_ref, scale) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, dimension(:), intent(in) :: S !< Salinity [S ~> ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] - real, dimension(:), intent(in) :: Tvar !< Variance of potential temperature [degC2] - real, dimension(:), intent(in) :: TScov !< Covariance of potential temperature and salinity [degC ppt] - real, dimension(:), intent(in) :: Svar !< Variance of salinity [ppt2] + real, dimension(:), intent(in) :: Tvar !< Variance of potential temperature [C2 ~> degC2] + real, dimension(:), intent(in) :: TScov !< Covariance of potential temperature and salinity [C S ~> degC ppt] + real, dimension(:), intent(in) :: Svar !< Variance of salinity [S2 ~> ppt2] real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking @@ -396,8 +410,14 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, !! in combination with scaling given by US [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] + real :: T2_scale ! A factor to convert temperature variance to units of degC2 [degC2 C-2 ~> 1] + real :: S2_scale ! A factor to convert salinity variance to units of ppt2 [ppt2 S-2 ~> 1] + real :: TS_scale ! A factor to convert temperture-salinity covariance to units of + ! degC ppt [degC ppt C-1 S-1 ~> 1] real :: rho_reference ! rho_ref converted to [kg m-3] real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] + real, dimension(size(rho)) :: Ta ! Temperature converted to [degC] + real, dimension(size(rho)) :: Sa ! Salinity converted to [ppt] real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p integer :: i, is, ie, npts @@ -409,7 +429,12 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, do i=is,ie pres(i) = EOS%RL2_T2_to_Pa * pressure(i) + Ta(i) = EOS%C_to_degC * T(i) + Sa(i) = EOS%S_to_ppt * S(i) enddo + T2_scale = EOS%C_to_degC**2 + S2_scale = EOS%S_to_ppt**2 + TS_scale = EOS%C_to_degC*EOS%S_to_ppt ! Rho_ref is seems like it is always present when calculate_Stanley_density is called, so ! always set rho_reference, even though a 0 value can change answers at roundoff with @@ -418,17 +443,17 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_linear(T, S, pres, rho, is, npts, & + call calculate_density_linear(Ta, Sa, pres, rho, is, npts, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_reference) - call calculate_density_second_derivs_linear(T, S, pres, d2RdSS, d2RdST, & + call calculate_density_second_derivs_linear(Ta, Sa, pres, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP, 1, npts) case (EOS_WRIGHT) - call calculate_density_wright(T, S, pres, rho, is, npts, rho_reference) - call calculate_density_second_derivs_wright(T, S, pres, d2RdSS, d2RdST, & + call calculate_density_wright(Ta, Sa, pres, rho, is, npts, rho_reference) + call calculate_density_second_derivs_wright(Ta, Sa, pres, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP, 1, npts) case (EOS_TEOS10) - call calculate_density_teos10(T, S, pres, rho, is, npts, rho_reference) - call calculate_density_second_derivs_teos10(T, S, pres, d2RdSS, d2RdST, & + call calculate_density_teos10(Ta, Sa, pres, rho, is, npts, rho_reference) + call calculate_density_second_derivs_teos10(Ta, Sa, pres, d2RdSS, d2RdST, & d2RdTT, d2RdSp, d2RdTP, 1, npts) case default call MOM_error(FATAL, "calculate_stanley_density_scalar: EOS is not valid.") @@ -436,8 +461,9 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, ! Equation 25 of Stanley et al., 2020. do i=is,ie - rho(i) = rho(i) & - + ( 0.5 * d2RdTT(i) * Tvar(i) + ( d2RdST(i) * TScov(i) + 0.5 * d2RdSS(i) * Svar(i) ) ) + rho(i) = rho(i) + ( 0.5 * (T2_scale * d2RdTT(i)) * Tvar(i) + & + ( (TS_scale * d2RdST(i)) * TScov(i) + & + 0.5 * (S2_scale * d2RdSS(i)) * Svar(i) ) ) enddo rho_scale = EOS%kg_m3_to_R @@ -495,8 +521,8 @@ end subroutine calculate_spec_vol_array !> Calls the appropriate subroutine to calculate specific volume of sea water !! for scalar inputs. subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) - real, intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, intent(in) :: S !< Salinity [S ~> ppt] real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, intent(out) :: specvol !< In situ or potential specific volume [R-1 ~> m3 kg-1] !! or other units determined by the scale argument @@ -505,16 +531,17 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] - real, dimension(1) :: Ta, Sa, pres, spv ! Rescaled single element array versions of the arguments. - real :: spv_reference ! spv_ref converted to [m3 kg-1] + real, dimension(1) :: Ta ! Rescaled single element array version of temperature [degC] + real, dimension(1) :: Sa ! Rescaled single element array version of salinity [ppt] + real, dimension(1) :: pres ! Rescaled single element array version of pressure [Pa] + real, dimension(1) :: spv ! Rescaled single element array version of specific volume [m3 kg-1] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] - pres(1) = EOS%RL2_T2_to_Pa*pressure - Ta(1) = T ; Sa(1) = S + pres(1) = EOS%RL2_T2_to_Pa * pressure + Ta(1) = EOS%C_to_degC * T ; Sa(1) = EOS%S_to_ppt * S if (present(spv_ref)) then - spv_reference = EOS%kg_m3_to_R*spv_ref - call calculate_spec_vol_array(Ta, Sa, pres, spv, 1, 1, EOS, spv_reference) + call calculate_spec_vol_array(Ta, Sa, pres, spv, 1, 1, EOS, EOS%kg_m3_to_R*spv_ref) else call calculate_spec_vol_array(Ta, Sa, pres, spv, 1, 1, EOS) endif @@ -531,8 +558,8 @@ end subroutine calc_spec_vol_scalar !> Calls the appropriate subroutine to calculate the specific volume of sea water for 1-D array !! inputs, potentially limiting the domain of indices that are worked on. subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, dimension(:), intent(in) :: S !< Salinity [S ~> ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: specvol !< In situ specific volume [R-1 ~> m3 kg-1] type(EOS_type), intent(in) :: EOS !< Equation of state structure @@ -543,9 +570,10 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) !! output specific volume in combination with !! scaling given by US [various] ! Local variables - real, dimension(size(specvol)) :: pres ! Pressure converted to [Pa] + real, dimension(size(T)) :: pres ! Pressure converted to [Pa] + real, dimension(size(T)) :: Ta ! Temperature converted to [degC] + real, dimension(size(T)) :: Sa ! Salinity converted to [ppt] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] - real :: spv_reference ! spv_ref converted to [m3 kg-1] integer :: i, is, ie, npts if (present(dom)) then @@ -554,16 +582,22 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) is = 1 ; ie = size(specvol) ; npts = 1 + ie - is endif - if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%kg_m3_to_R == 1.0)) then + if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%kg_m3_to_R == 1.0) .and. & + (EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then call calculate_spec_vol_array(T, S, pressure, specvol, is, npts, EOS, spv_ref) - elseif (present(spv_ref)) then ! This is the same as above, but with some extra work to rescale variables. - do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo - spv_reference = EOS%kg_m3_to_R*spv_ref - call calculate_spec_vol_array(T, S, pres, specvol, is, npts, EOS, spv_reference) - else ! There is rescaling of variables, but spv_ref is not present. Passing a 0 value of spv_ref - ! changes answers at roundoff for some equations of state, like Wright and UNESCO. - do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo - call calculate_spec_vol_array(T, S, pres, specvol, is, npts, EOS) + else ! This is the same as above, but with some extra work to rescale variables. + do i=is,ie + pres(i) = EOS%RL2_T2_to_Pa * pressure(i) + Ta(i) = EOS%C_to_degC * T(i) + Sa(i) = EOS%S_to_ppt * S(i) + enddo + if (present(spv_ref)) then + call calculate_spec_vol_array(Ta, Sa, pres, specvol, is, npts, EOS, EOS%kg_m3_to_R*spv_ref) + else + ! There is rescaling of variables, but spv_ref is not present. Passing a 0 value of spv_ref + ! changes answers at roundoff for some equations of state, like Wright and UNESCO. + call calculate_spec_vol_array(Ta, Sa, pres, specvol, is, npts, EOS) + endif endif spv_scale = EOS%R_to_kg_m3 @@ -655,16 +689,17 @@ end subroutine calculate_TFreeze_array !> Calls the appropriate subroutine to calculate the freezing point for a 1-D array, taking !! dimensionally rescaled arguments with factors stored in EOS. subroutine calculate_TFreeze_1d(S, pressure, T_fr, EOS, dom) - real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: S !< Salinity [S ~> ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: T_fr !< Freezing point potential temperature referenced - !! to the surface [degC] + !! to the surface [C ~> degC] type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. ! Local variables - real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] + real, dimension(size(T_fr)) :: pres ! Pressure converted to [Pa] + real, dimension(size(T_fr)) :: Sa ! Salinity converted to [ppt] integer :: i, is, ie, npts if (present(dom)) then @@ -673,7 +708,7 @@ subroutine calculate_TFreeze_1d(S, pressure, T_fr, EOS, dom) is = 1 ; ie = size(T_Fr) ; npts = 1 + ie - is endif - if (EOS%RL2_T2_to_Pa == 1.0) then + if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%S_to_ppt == 1.0)) then select case (EOS%form_of_TFreeze) case (TFREEZE_LINEAR) call calculate_TFreeze_linear(S, pressure, T_fr, is, npts, & @@ -686,20 +721,27 @@ subroutine calculate_TFreeze_1d(S, pressure, T_fr, EOS, dom) call MOM_error(FATAL, "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") end select else - do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo + do i=is,ie + pres(i) = EOS%RL2_T2_to_Pa * pressure(i) + Sa(i) = EOS%S_to_ppt * S(i) + enddo select case (EOS%form_of_TFreeze) case (TFREEZE_LINEAR) - call calculate_TFreeze_linear(S, pres, T_fr, is, npts, & + call calculate_TFreeze_linear(Sa, pres, T_fr, is, npts, & EOS%TFr_S0_P0, EOS%dTFr_dS, EOS%dTFr_dp) case (TFREEZE_MILLERO) - call calculate_TFreeze_Millero(S, pres, T_fr, is, npts) + call calculate_TFreeze_Millero(Sa, pres, T_fr, is, npts) case (TFREEZE_TEOS10) - call calculate_TFreeze_teos10(S, pres, T_fr, is, npts) + call calculate_TFreeze_teos10(Sa, pres, T_fr, is, npts) case default call MOM_error(FATAL, "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") end select endif + if (EOS%degC_to_C /= 1.0) then + do i=is,ie ; T_fr(i) = EOS%degC_to_C * T_fr(i) ; enddo + endif + end subroutine calculate_TFreeze_1d @@ -749,13 +791,13 @@ end subroutine calculate_density_derivs_array !> Calls the appropriate subroutine to calculate density derivatives for 1-D array inputs. subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, dom, scale) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, dimension(:), intent(in) :: S !< Salinity [S ~> ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: drho_dT !< The partial derivative of density with potential - !! temperature [R degC-1 ~> kg m-3 degC-1] + !! temperature [R C-1 ~> kg m-3 degC-1] real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity - !! [R ppt-1 ~> kg m-3 ppt-1] + !! [R S-1 ~> kg m-3 ppt-1] type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. @@ -763,7 +805,11 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do !! in combination with scaling given by US [various] ! Local variables real, dimension(size(drho_dT)) :: pres ! Pressure converted to [Pa] + real, dimension(size(drho_dT)) :: Ta ! Temperature converted to [degC] + real, dimension(size(drho_dT)) :: Sa ! Salinity converted to [ppt] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] + real :: dRdT_scale ! A factor to convert drho_dT to the desired units [R degC m3 C-1 kg-1 ~> 1] + real :: dRdS_scale ! A factor to convert drho_dS to the desired units [R ppt m3 S-1 kg-1 ~> 1] integer :: i, is, ie, npts if (present(dom)) then @@ -772,18 +818,24 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do is = 1 ; ie = size(drho_dT) ; npts = 1 + ie - is endif - if (EOS%RL2_T2_to_Pa == 1.0) then + if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then call calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, is, npts, EOS) else - do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo - call calculate_density_derivs_array(T, S, pres, drho_dT, drho_dS, is, npts, EOS) + do i=is,ie + pres(i) = EOS%RL2_T2_to_Pa * pressure(i) + Ta(i) = EOS%C_to_degC * T(i) + Sa(i) = EOS%S_to_ppt * S(i) + enddo + call calculate_density_derivs_array(Ta, Sa, pres, drho_dT, drho_dS, is, npts, EOS) endif rho_scale = EOS%kg_m3_to_R if (present(scale)) rho_scale = rho_scale * scale - if (rho_scale /= 1.0) then ; do i=is,ie - drho_dT(i) = rho_scale * drho_dT(i) - drho_dS(i) = rho_scale * drho_dS(i) + dRdT_scale = rho_scale * EOS%C_to_degC + dRdS_scale = rho_scale * EOS%S_to_ppt + if ((dRdT_scale /= 1.0) .or. (dRdS_scale /= 1.0)) then ; do i=is,ie + drho_dT(i) = dRdT_scale * drho_dT(i) + drho_dS(i) = dRdS_scale * drho_dS(i) enddo ; endif end subroutine calculate_density_derivs_1d @@ -792,41 +844,49 @@ end subroutine calculate_density_derivs_1d !> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar !! to a one-element array subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS, scale) - real, intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, intent(in) :: S !< Salinity [S ~> ppt] real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, intent(out) :: drho_dT !< The partial derivative of density with potential - !! temperature [R degC-1 ~> kg m-3 degC-1] or other + !! temperature [R C-1 ~> kg m-3 degC-1] or other !! units determined by the optional scale argument real, intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in [R ppt-1 ~> kg m-3 ppt-1] or other units + !! in [R S-1 ~> kg m-3 ppt-1] or other units !! determined by the optional scale argument type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] + real :: dRdT_scale ! A factor to convert drho_dT to the desired units [R degC m3 C-1 kg-1 ~> 1] + real :: dRdS_scale ! A factor to convert drho_dS to the desired units [R ppt m3 S-1 kg-1 ~> 1] + real :: pres ! Pressure converted to [Pa] + real :: Ta ! Temperature converted to [degC] + real :: Sa ! Salinity converted to [ppt] - p_scale = EOS%RL2_T2_to_Pa + pres = EOS%RL2_T2_to_Pa*pressure + Ta = EOS%C_to_degC * T + Sa = EOS%S_to_ppt * S select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_derivs_linear(T, S, p_scale*pressure, drho_dT, drho_dS, & + call calculate_density_derivs_linear(Ta, Sa, pres, drho_dT, drho_dS, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) case (EOS_WRIGHT) - call calculate_density_derivs_wright(T, S, p_scale*pressure, drho_dT, drho_dS) + call calculate_density_derivs_wright(Ta, Sa, pres, drho_dT, drho_dS) case (EOS_TEOS10) - call calculate_density_derivs_teos10(T, S, p_scale*pressure, drho_dT, drho_dS) + call calculate_density_derivs_teos10(Ta, Sa, pres, drho_dT, drho_dS) case default call MOM_error(FATAL, "calculate_density_derivs_scalar: EOS%form_of_EOS is not valid.") end select rho_scale = EOS%kg_m3_to_R if (present(scale)) rho_scale = rho_scale * scale - if (rho_scale /= 1.0) then - drho_dT = rho_scale * drho_dT - drho_dS = rho_scale * drho_dS + dRdT_scale = rho_scale * EOS%C_to_degC + dRdS_scale = rho_scale * EOS%S_to_ppt + if ((dRdT_scale /= 1.0) .or. (dRdS_scale /= 1.0)) then + drho_dT = dRdT_scale * drho_dT + drho_dS = dRdS_scale * drho_dS endif end subroutine calculate_density_derivs_scalar @@ -834,26 +894,28 @@ end subroutine calculate_density_derivs_scalar !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs. subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & drho_dS_dP, drho_dT_dP, EOS, dom, scale) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, dimension(:), intent(in) :: S !< Salinity [S ~> ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: drho_dS_dS !< Partial derivative of beta with respect to S - !! [R ppt-2 ~> kg m-3 ppt-2] + !! [R S-2 ~> kg m-3 ppt-2] real, dimension(:), intent(inout) :: drho_dS_dT !< Partial derivative of beta with respect to T - !! [R ppt-1 degC-1 ~> kg m-3 ppt-1 degC-1] + !! [R S-1 C-1 ~> kg m-3 ppt-1 degC-1] real, dimension(:), intent(inout) :: drho_dT_dT !< Partial derivative of alpha with respect to T - !! [R degC-2 ~> kg m-3 degC-2] + !! [R C-2 ~> kg m-3 degC-2] real, dimension(:), intent(inout) :: drho_dS_dP !< Partial derivative of beta with respect to pressure - !! [T2 ppt-1 L-2 ~> kg m-3 ppt-1 Pa-1] + !! [T2 S-1 L-2 ~> kg m-3 ppt-1 Pa-1] real, dimension(:), intent(inout) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure - !! [T2 degC-1 L-2 ~> kg m-3 degC-1 Pa-1] + !! [T2 C-1 L-2 ~> kg m-3 degC-1 Pa-1] type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables - real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] + real, dimension(size(T)) :: pres ! Pressure converted to [Pa] + real, dimension(size(T)) :: Ta ! Temperature converted to [degC] + real, dimension(size(T)) :: Sa ! Salinity converted to [ppt] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] integer :: i, is, ie, npts @@ -863,7 +925,7 @@ subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_d is = 1 ; ie = size(T) ; npts = 1 + ie - is endif - if (EOS%RL2_T2_to_Pa == 1.0) then + if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & @@ -878,16 +940,20 @@ subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_d call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") end select else - do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo + do i=is,ie + pres(i) = EOS%RL2_T2_to_Pa * pressure(i) + Ta(i) = EOS%C_to_degC * T(i) + Sa(i) = EOS%S_to_ppt * S(i) + enddo select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T, S, pres, drho_dS_dS, drho_dS_dT, & + call calculate_density_second_derivs_linear(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T, S, pres, drho_dS_dS, drho_dS_dT, & + call calculate_density_second_derivs_wright(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case (EOS_TEOS10) - call calculate_density_second_derivs_teos10(T, S, pres, drho_dS_dS, drho_dS_dT, & + call calculate_density_second_derivs_teos10(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP, is, npts) case default call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") @@ -909,42 +975,59 @@ subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_d drho_dT_dP(i) = EOS%RL2_T2_to_Pa * drho_dT_dP(i) enddo ; endif + if (EOS%C_to_degC /= 1.0) then ; do i=is,ie + drho_dS_dT(i) = EOS%C_to_degC * drho_dS_dT(i) + drho_dT_dT(i) = EOS%C_to_degC**2 * drho_dT_dT(i) + drho_dT_dP(i) = EOS%C_to_degC * drho_dT_dP(i) + enddo ; endif + + if (EOS%S_to_ppt /= 1.0) then ; do i=is,ie + drho_dS_dS(i) = EOS%S_to_ppt**2 * drho_dS_dS(i) + drho_dS_dT(i) = EOS%S_to_ppt * drho_dS_dT(i) + drho_dS_dP(i) = EOS%S_to_ppt * drho_dS_dP(i) + enddo ; endif + end subroutine calculate_density_second_derivs_1d !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & drho_dS_dP, drho_dT_dP, EOS, scale) - real, intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, intent(in) :: S !< Salinity [S ~> ppt] real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S - !! [R ppt-2 ~> kg m-3 ppt-2] + !! [R S-2 ~> kg m-3 ppt-2] real, intent(out) :: drho_dS_dT !< Partial derivative of beta with respect to T - !! [R ppt-1 degC-1 ~> kg m-3 ppt-1 degC-1] + !! [R S-1 C-1 ~> kg m-3 ppt-1 degC-1] real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T - !! [R degC-2 ~> kg m-3 degC-2] + !! [R C-2 ~> kg m-3 degC-2] real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure - !! [T2 ppt-1 L-2 ~> kg m-3 ppt-1 Pa-1] + !! [T2 S-1 L-2 ~> kg m-3 ppt-1 Pa-1] real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure - !! [T2 degC-1 L-2 ~> kg m-3 degC-1 Pa-1] + !! [T2 C-1 L-2 ~> kg m-3 degC-1 Pa-1] type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] + real :: pres ! Pressure converted to [Pa] + real :: Ta ! Temperature converted to [degC] + real :: Sa ! Salinity converted to [ppt] - p_scale = EOS%RL2_T2_to_Pa + pres = EOS%RL2_T2_to_Pa*pressure + Ta = EOS%C_to_degC * T + Sa = EOS%S_to_ppt * S select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T, S, p_scale*pressure, drho_dS_dS, drho_dS_dT, & + call calculate_density_second_derivs_linear(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T, S, p_scale*pressure, drho_dS_dS, drho_dS_dT, & + call calculate_density_second_derivs_wright(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP) case (EOS_TEOS10) - call calculate_density_second_derivs_teos10(T, S, p_scale*pressure, drho_dS_dS, drho_dS_dT, & + call calculate_density_second_derivs_teos10(Ta, Sa, pres, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP) case default call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") @@ -965,6 +1048,18 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr drho_dT_dP = p_scale * drho_dT_dP endif + if (EOS%C_to_degC /= 1.0) then + drho_dS_dT = EOS%C_to_degC * drho_dS_dT + drho_dT_dT = EOS%C_to_degC**2 * drho_dT_dT + drho_dT_dP = EOS%C_to_degC * drho_dT_dP + endif + + if (EOS%S_to_ppt /= 1.0) then + drho_dS_dS = EOS%S_to_ppt**2 * drho_dS_dS + drho_dS_dT = EOS%S_to_ppt * drho_dS_dT + drho_dS_dP = EOS%S_to_ppt * drho_dS_dP + endif + end subroutine calculate_density_second_derivs_scalar !> Calls the appropriate subroutine to calculate specific volume derivatives for an array. @@ -1017,13 +1112,13 @@ end subroutine calculate_spec_vol_derivs_array !> Calls the appropriate subroutine to calculate specific volume derivatives for 1-d array inputs, !! potentially limiting the domain of indices that are worked on. subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, scale) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, dimension(:), intent(in) :: S !< Salinity [S ~> ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: dSV_dT !< The partial derivative of specific volume with potential - !! temperature [R-1 degC-1 ~> m3 kg-1 degC-1] + !! temperature [R-1 C-1 ~> m3 kg-1 degC-1] real, dimension(:), intent(inout) :: dSV_dS !< The partial derivative of specific volume with salinity - !! [R-1 ppt-1 ~> m3 kg-1 ppt-1] + !! [R-1 S-1 ~> m3 kg-1 ppt-1] type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. @@ -1031,8 +1126,12 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca !! volume in combination with scaling given by US [various] ! Local variables - real, dimension(size(dSV_dT)) :: press ! Pressure converted to [Pa] + real, dimension(size(T)) :: pres ! Pressure converted to [Pa] + real, dimension(size(T)) :: Ta ! Temperature converted to [degC] + real, dimension(size(T)) :: Sa ! Salinity converted to [ppt] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] + real :: dSVdT_scale ! A factor to convert dSV_dT to the desired units [kg degC R-1 C-1 m-3 ~> 1] + real :: dSVdS_scale ! A factor to convert dSV_dS to the desired units [kg ppt R-1 S-1 m-3 ~> 1] integer :: i, is, ie, npts if (present(dom)) then @@ -1041,18 +1140,24 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca is = 1 ; ie = size(dSV_dT) ; npts = 1 + ie - is endif - if (EOS%RL2_T2_to_Pa == 1.0) then + if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then call calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, is, npts, EOS) else - do i=is,ie ; press(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo - call calculate_spec_vol_derivs_array(T, S, press, dSV_dT, dSV_dS, is, npts, EOS) + do i=is,ie + pres(i) = EOS%RL2_T2_to_Pa * pressure(i) + Ta(i) = EOS%C_to_degC * T(i) + Sa(i) = EOS%S_to_ppt * S(i) + enddo + call calculate_spec_vol_derivs_array(Ta, Sa, pres, dSV_dT, dSV_dS, is, npts, EOS) endif spv_scale = EOS%R_to_kg_m3 if (present(scale)) spv_scale = spv_scale * scale + dSVdT_scale = spv_scale * EOS%C_to_degC + dSVdS_scale = spv_scale * EOS%S_to_ppt if (spv_scale /= 1.0) then ; do i=is,ie - dSV_dT(i) = spv_scale * dSV_dT(i) - dSV_dS(i) = spv_scale * dSV_dS(i) + dSV_dT(i) = dSVdT_scale * dSV_dT(i) + dSV_dS(i) = dSVdS_scale * dSV_dS(i) enddo ; endif end subroutine calc_spec_vol_derivs_1d @@ -1060,10 +1165,10 @@ end subroutine calc_spec_vol_derivs_1d !> Calls the appropriate subroutine to calculate the density and compressibility for 1-D array !! inputs. The inputs and outputs use dimensionally rescaled units. -subroutine calculate_compress_1d(T, S, press, rho, drho_dp, EOS, dom) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(:), intent(in) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: press !< Pressure [R L2 T-2 ~> Pa] +subroutine calculate_compress_1d(T, S, pressure, rho, drho_dp, EOS, dom) + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, dimension(:), intent(in) :: S !< Salinity [S ~> ppt] + real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: rho !< In situ density [R ~> kg m-3] real, dimension(:), intent(inout) :: drho_dp !< The partial derivative of density with pressure !! (also the inverse of the square of sound speed) @@ -1073,7 +1178,9 @@ subroutine calculate_compress_1d(T, S, press, rho, drho_dp, EOS, dom) !! into account that arrays start at 1. ! Local variables - real, dimension(size(press)) :: pressure ! Pressure converted to [Pa] + real, dimension(size(T)) :: pres ! Pressure converted to [Pa] + real, dimension(size(T)) :: Ta ! Temperature converted to [degC] + real, dimension(size(T)) :: Sa ! Salinity converted to [ppt] integer :: i, is, ie, npts if (present(dom)) then @@ -1082,20 +1189,24 @@ subroutine calculate_compress_1d(T, S, press, rho, drho_dp, EOS, dom) is = 1 ; ie = size(rho) ; npts = 1 + ie - is endif - do i=is,ie ; pressure(i) = EOS%RL2_T2_to_Pa * press(i) ; enddo + do i=is,ie + pres(i) = EOS%RL2_T2_to_Pa * pressure(i) + Ta(i) = EOS%C_to_degC * T(i) + Sa(i) = EOS%S_to_ppt * S(i) + enddo select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_compress_linear(T, S, pressure, rho, drho_dp, is, npts, & + call calculate_compress_linear(Ta, Sa, pres, rho, drho_dp, is, npts, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) case (EOS_UNESCO) - call calculate_compress_unesco(T, S, pressure, rho, drho_dp, is, npts) + call calculate_compress_unesco(Ta, Sa, pres, rho, drho_dp, is, npts) case (EOS_WRIGHT) - call calculate_compress_wright(T, S, pressure, rho, drho_dp, is, npts) + call calculate_compress_wright(Ta, Sa, pres, rho, drho_dp, is, npts) case (EOS_TEOS10) - call calculate_compress_teos10(T, S, pressure, rho, drho_dp, is, npts) + call calculate_compress_teos10(Ta, Sa, pres, rho, drho_dp, is, npts) case (EOS_NEMO) - call calculate_compress_nemo(T, S, pressure, rho, drho_dp, is, npts) + call calculate_compress_nemo(Ta, Sa, pres, rho, drho_dp, is, npts) case default call MOM_error(FATAL, "calculate_compress: EOS%form_of_EOS is not valid.") end select @@ -1113,8 +1224,8 @@ end subroutine calculate_compress_1d !! with a singleton dimension and calls calculate_compress_1d. The inputs and outputs use !! dimensionally rescaled units. subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) - real, intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] + real, intent(in) :: S !< Salinity [S ~> ppt] real, intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, intent(out) :: rho !< In situ density [R ~> kg m-3] real, intent(out) :: drho_dp !< The partial derivative of density with pressure (also the @@ -1122,9 +1233,10 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables + ! These arrays use the same units as their counterparts in calcluate_compress_1d. real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa - Ta(1) = T ; Sa(1) = S; pa(1) = pressure + Ta(1) = T ; Sa(1) = S ; pa(1) = pressure call calculate_compress_1d(Ta, Sa, pa, rhoa, drho_dpa, EOS) rho = rhoa(1) ; drho_dp = drho_dpa(1) @@ -1150,7 +1262,6 @@ function EOS_domain(HI, halo) result(EOSdom) end function EOS_domain - !> Calls the appropriate subroutine to calculate analytical and nearly-analytical !! integrals in pressure across layers of geopotential anomalies, which are !! required for calculating the finite-volume form pressure accelerations in a @@ -1162,9 +1273,9 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & bathyP, dP_tiny, useMassWghtInterp) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: T !< Potential temperature referenced to the surface [degC] + intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity [ppt] + intent(in) :: S !< Salinity [S ~> ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & @@ -1197,20 +1308,29 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. + ! Local variables + real :: dRdT_scale ! A factor to convert drho_dT to the desired units [R degC m3 C-1 kg-1 ~> 1] + real :: dRdS_scale ! A factor to convert drho_dS to the desired units [R ppt m3 S-1 kg-1 ~> 1] + + + ! We should never reach this point with quadrature. EOS_quadrature indicates that numerical ! integration be used instead of analytic. This is a safety check. if (EOS%EOS_quadrature) call MOM_error(FATAL, "EOS_quadrature is set!") select case (EOS%form_of_EOS) case (EOS_LINEAR) + dRdT_scale = EOS%kg_m3_to_R * EOS%C_to_degC + dRdS_scale = EOS%kg_m3_to_R * EOS%S_to_ppt call int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, EOS%kg_m3_to_R*EOS%Rho_T0_S0, & - EOS%kg_m3_to_R*EOS%dRho_dT, EOS%kg_m3_to_R*EOS%dRho_dS, dza, & + dRdT_scale*EOS%dRho_dT, dRdS_scale*EOS%dRho_dS, dza, & intp_dza, intx_dza, inty_dza, halo_size, & bathyP, dP_tiny, useMassWghtInterp) case (EOS_WRIGHT) call int_spec_vol_dp_wright(T, S, p_t, p_b, alpha_ref, HI, dza, intp_dza, intx_dza, & inty_dza, halo_size, bathyP, dP_tiny, useMassWghtInterp, & - SV_scale=EOS%R_to_kg_m3, pres_scale=EOS%RL2_T2_to_Pa) + SV_scale=EOS%R_to_kg_m3, pres_scale=EOS%RL2_T2_to_Pa, & + temp_scale=EOS%C_to_degC, saln_scale=EOS%S_to_ppt) case default call MOM_error(FATAL, "No analytic integration option is available with this EOS!") end select @@ -1224,9 +1344,9 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp, Z_0p) type(hor_index_type), intent(in) :: HI !< Ocean horizontal index structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: T !< Potential temperature referenced to the surface [degC] + intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity [ppt] + intent(in) :: S !< Salinity [S ~> ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & @@ -1265,6 +1385,8 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, ! Local variables real :: rho_scale ! A multiplicative factor by which to scale density from kg m-3 to the ! desired units [R m3 kg-1 ~> 1] + real :: dRdT_scale ! A factor to convert drho_dT to the desired units [R degC m3 C-1 kg-1 ~> 1] + real :: dRdS_scale ! A factor to convert drho_dS to the desired units [R ppt m3 S-1 kg-1 ~> 1] real :: pres_scale ! A multiplicative factor to convert pressure into Pa [Pa T2 R-1 L-2 ~> 1] ! We should never reach this point with quadrature. EOS_quadrature indicates that numerical @@ -1274,9 +1396,11 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, select case (EOS%form_of_EOS) case (EOS_LINEAR) rho_scale = EOS%kg_m3_to_R - if (rho_scale /= 1.0) then + dRdT_scale = EOS%kg_m3_to_R * EOS%C_to_degC + dRdS_scale = EOS%kg_m3_to_R * EOS%S_to_ppt + if ((rho_scale /= 1.0) .or. (dRdT_scale /= 1.0) .or. (dRdS_scale /= 1.0)) then call int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & - rho_scale*EOS%Rho_T0_S0, rho_scale*EOS%dRho_dT, rho_scale*EOS%dRho_dS, & + rho_scale*EOS%Rho_T0_S0, dRdT_scale*EOS%dRho_dT, dRdS_scale*EOS%dRho_dS, & dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) else call int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & @@ -1286,10 +1410,11 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, case (EOS_WRIGHT) rho_scale = EOS%kg_m3_to_R pres_scale = EOS%RL2_T2_to_Pa - if ((rho_scale /= 1.0) .or. (pres_scale /= 1.0)) then + if ((rho_scale /= 1.0) .or. (pres_scale /= 1.0) .or. (EOS%C_to_degC /= 1.0) .or. (EOS%S_to_ppt /= 1.0)) then call int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & - dz_neglect, useMassWghtInterp, rho_scale, pres_scale, Z_0p=Z_0p) + dz_neglect, useMassWghtInterp, rho_scale, pres_scale, & + temp_scale=EOS%C_to_degC, saln_scale=EOS%S_to_ppt, Z_0p=Z_0p) else call int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & @@ -1315,7 +1440,7 @@ subroutine EOS_init(param_file, EOS, US) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type optional :: US ! Local variables -#include "version_variable.h" +# include "version_variable.h" character(len=40) :: mdl = "MOM_EOS" ! This module's name. character(len=40) :: tmpstr @@ -1411,6 +1536,10 @@ subroutine EOS_init(param_file, EOS, US) EOS%R_to_kg_m3 = 1. ; if (present(US)) EOS%R_to_kg_m3 = US%R_to_kg_m3 EOS%RL2_T2_to_Pa = 1. ; if (present(US)) EOS%RL2_T2_to_Pa = US%RL2_T2_to_Pa EOS%L_T_to_m_s = 1. ; if (present(US)) EOS%L_T_to_m_s = US%L_T_to_m_s + EOS%degC_to_C = 1. !### ; if (present(US)) EOS%degC_to_C = US%degC_to_C + EOS%C_to_degC = 1. !### ; if (present(US)) EOS%C_to_degC = US%C_to_degC + EOS%ppt_to_S = 1. !### ; if (present(US)) EOS%ppt_to_S = US%ppt_to_S + EOS%S_to_ppt = 1. !### ; if (present(US)) EOS%S_to_ppt = US%S_to_ppt end subroutine EOS_init diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index 4b22a112db..c2e50287b2 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -407,14 +407,14 @@ end subroutine calculate_compress_wright !! pressure anomalies across layers, which are required for calculating the !! finite-volume form pressure accelerations in a Boussinesq model. subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & - dpa, intz_dpa, intx_dpa, inty_dpa, & - bathyT, dz_neglect, useMassWghtInterp, rho_scale, pres_scale, Z_0p) + dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, & + useMassWghtInterp, rho_scale, pres_scale, temp_scale, saln_scale, Z_0p) type(hor_index_type), intent(in) :: HI !< The horizontal index type for the arrays. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature relative to the surface - !! [degC]. + !! [C ~> degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity [PSU]. + intent(in) :: S !< Salinity [S ~> PSU]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & @@ -451,19 +451,29 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & !! from kg m-3 to the desired units [R m3 kg-1 ~> 1] real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure !! into Pa [Pa T2 R-1 L-2 ~> 1]. + real, optional, intent(in) :: temp_scale !< A multiplicative factor by which to scale + !! temperature into degC [degC C-1 ~> 1] + real, optional, intent(in) :: saln_scale !< A multiplicative factor to convert pressure + !! into ppt [ppt S-1 ~> 1]. real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] ! Local variables - real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d, p0_2d, lambda_2d - real :: al0, p0, lambda + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d ! A term in the Wright EOS [m3 kg-1] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: p0_2d ! A term in the Wright EOS [Pa] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: lambda_2d ! A term in the Wright EOS [m2 s-2] + real :: al0 ! A term in the Wright EOS [m3 kg-1] + real :: p0 ! A term in the Wright EOS [Pa] + real :: lambda ! A term in the Wright EOS [m2 s-2] real :: rho_anom ! The density anomaly from rho_ref [kg m-3]. - real :: eps, eps2, rem + real :: eps, eps2 ! A nondimensional ratio and its square [nondim] + real :: rem ! [kg m-1 s-2] real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] real :: g_Earth ! The gravitational acceleration [m2 Z-1 s-2 ~> m s-2] real :: I_Rho ! The inverse of the Boussinesq density [m3 kg-1] - real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] + real :: rho_ref_mks ! The reference density in MKS units [kg m-3] real :: p_ave ! The layer averaged pressure [Pa] - real :: I_al0, I_Lzz + real :: I_al0 ! The inverse of al0 [kg m-3] + real :: I_Lzz ! The inverse of the denominator [Pa-1] real :: dz ! The layer thickness [Z ~> m]. real :: hWght ! A pressure-thickness below topography [Z ~> m]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. @@ -477,6 +487,18 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real :: Pa_to_RL2_T2 ! A conversion factor of pressures from Pa to the output units indicated by ! pres_scale [R L2 T-2 Pa-1 ~> 1]. real :: z0pres ! The height at which the pressure is zero [Z ~> m] + real :: a1s ! Partly rescaled version of a1 [m3 kg-1 C-1 ~> m3 kg-1 degC-1] + real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 ppt-1] + real :: b1s ! Partly rescaled version of b1 [Pa C-1 ~> Pa degC-1] + real :: b2s ! Partly rescaled version of b2 [Pa C-2 ~> Pa degC-2] + real :: b3s ! Partly rescaled version of b3 [Pa C-3 ~> Pa degC-3] + real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa ppt-1] + real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 ppt-1] + real :: c1s ! Partly rescaled version of c1 [m2 s-2 C-1 ~> m2 s-2 degC-1] + real :: c2s ! Partly rescaled version of c2 [m2 s-2 C-2 ~> m2 s-2 degC-2] + real :: c3s ! Partly rescaled version of c3 [m2 s-2 C-3 ~> m2 s-2 degC-3] + real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 ppt-1] + real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 ppt-1] logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants. @@ -504,6 +526,24 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & endif z0pres = 0.0 ; if (present(Z_0p)) z0pres = Z_0p + a1s = a1 ; a2s = a2 + b1s = b1 ; b2s = b2 ; b3s = b3 ; b4s = b4 ; b5s = b5 + c1s = c1 ; c2s = c2 ; c3s = c3 ; c4s = c4 ; c5s = c5 + + if (present(temp_scale)) then ; if (temp_scale /= 1.0) then + a1s = a1s * temp_scale + b1s = b1s * temp_scale ; b2s = b2s * temp_scale**2 + b3s = b3s * temp_scale**3 ; b5s = b5s * temp_scale + c1s = c1s * temp_scale ; c2s = c2s * temp_scale**2 + c3s = c3s * temp_scale**3 ; c5s = c5s * temp_scale + endif ; endif + + if (present(saln_scale)) then ; if (saln_scale /= 1.0) then + a2s = a2s * saln_scale + b4s = b4s * saln_scale ; b5s = b5s * saln_scale + c4s = c4s * saln_scale ; c5s = c5s * saln_scale + endif ; endif + do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then do_massWeight = .true. @@ -514,9 +554,9 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & endif ; endif do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - al0_2d(i,j) = (a0 + a1*T(i,j)) + a2*S(i,j) - p0_2d(i,j) = (b0 + b4*S(i,j)) + T(i,j) * (b1 + T(i,j)*((b2 + b3*T(i,j))) + b5*S(i,j)) - lambda_2d(i,j) = (c0 +c4*S(i,j)) + T(i,j) * (c1 + T(i,j)*((c2 + c3*T(i,j))) + c5*S(i,j)) + al0_2d(i,j) = (a0 + a1s*T(i,j)) + a2s*S(i,j) + p0_2d(i,j) = (b0 + b4s*S(i,j)) + T(i,j) * (b1s + T(i,j)*((b2s + b3s*T(i,j))) + b5s*S(i,j)) + lambda_2d(i,j) = (c0 +c4s*S(i,j)) + T(i,j) * (c1s + T(i,j)*((c2s + c3s*T(i,j))) + c5s*S(i,j)) al0 = al0_2d(i,j) ; p0 = p0_2d(i,j) ; lambda = lambda_2d(i,j) @@ -628,14 +668,14 @@ end subroutine int_density_dz_wright !! Boole's rule to do the horizontal integrals, and from a truncation in the !! series for log(1-eps/1+eps) that assumes that |eps| < 0.34. subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & - intp_dza, intx_dza, inty_dza, halo_size, & - bathyP, dP_neglect, useMassWghtInterp, SV_scale, pres_scale) + intp_dza, intx_dza, inty_dza, halo_size, bathyP, dP_neglect, & + useMassWghtInterp, SV_scale, pres_scale, temp_scale, saln_scale) type(hor_index_type), intent(in) :: HI !< The ocean's horizontal index type. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature relative to the surface - !! [degC]. + !! [C ~> degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity [PSU]. + intent(in) :: S !< Salinity [S ~> PSU]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & @@ -673,9 +713,15 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & !! volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure !! into Pa [Pa T2 R-1 L-2 ~> 1]. + real, optional, intent(in) :: temp_scale !< A multiplicative factor by which to scale + !! temperature into degC [degC C-1 ~> 1] + real, optional, intent(in) :: saln_scale !< A multiplicative factor to convert pressure + !! into ppt [ppt S-1 ~> 1]. ! Local variables - real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d, p0_2d, lambda_2d + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d ! A term in the Wright EOS [R-1 ~> m3 kg-1] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: p0_2d ! A term in the Wright EOS [R L2 T-2 ~> Pa] + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: lambda_2d ! A term in the Wright EOS [L2 T-2 ~> m2 s-2] 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] @@ -696,6 +742,18 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations [L2 T-2 ~> m2 s-2]. + real :: a1s ! Partly rescaled version of a1 [m3 kg-1 C-1 ~> m3 kg-1 degC-1] + real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 ppt-1] + real :: b1s ! Partly rescaled version of b1 [Pa C-1 ~> Pa degC-1] + real :: b2s ! Partly rescaled version of b2 [Pa C-2 ~> Pa degC-2] + real :: b3s ! Partly rescaled version of b3 [Pa C-3 ~> Pa degC-3] + real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa ppt-1] + real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 ppt-1] + real :: c1s ! Partly rescaled version of c1 [m2 s-2 C-1 ~> m2 s-2 degC-1] + real :: c2s ! Partly rescaled version of c2 [m2 s-2 C-2 ~> m2 s-2 degC-2] + real :: c3s ! Partly rescaled version of c3 [m2 s-2 C-3 ~> m2 s-2 degC-3] + real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 ppt-1] + real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 ppt-1] logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants. @@ -715,6 +773,24 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & endif ; endif lam_scale = al0_scale * p0_scale + a1s = a1 ; a2s = a2 + b1s = b1 ; b2s = b2 ; b3s = b3 ; b4s = b4 ; b5s = b5 + c1s = c1 ; c2s = c2 ; c3s = c3 ; c4s = c4 ; c5s = c5 + + if (present(temp_scale)) then ; if (temp_scale /= 1.0) then + a1s = a1s * temp_scale + b1s = b1s * temp_scale ; b2s = b2s * temp_scale**2 + b3s = b3s * temp_scale**3 ; b5s = b5s * temp_scale + c1s = c1s * temp_scale ; c2s = c2s * temp_scale**2 + c3s = c3s * temp_scale**3 ; c5s = c5s * temp_scale + endif ; endif + + if (present(saln_scale)) then ; if (saln_scale /= 1.0) then + a2s = a2s * saln_scale + b4s = b4s * saln_scale ; b5s = b5s * saln_scale + c4s = c4s * saln_scale ; c5s = c5s * saln_scale + endif ; endif + do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then do_massWeight = .true. @@ -726,9 +802,9 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & ! alpha(j) = (lambda + al0*(pressure(j) + p0)) / (pressure(j) + p0) do j=jsh,jeh ; do i=ish,ieh - al0_2d(i,j) = al0_scale * ( (a0 + a1*T(i,j)) + a2*S(i,j) ) - p0_2d(i,j) = p0_scale * ( (b0 + b4*S(i,j)) + T(i,j) * (b1 + T(i,j)*((b2 + b3*T(i,j))) + b5*S(i,j)) ) - lambda_2d(i,j) = lam_scale * ( (c0 + c4*S(i,j)) + T(i,j) * (c1 + T(i,j)*((c2 + c3*T(i,j))) + c5*S(i,j)) ) + al0_2d(i,j) = al0_scale * ( (a0 + a1s*T(i,j)) + a2s*S(i,j) ) + p0_2d(i,j) = p0_scale * ( (b0 + b4s*S(i,j)) + T(i,j) * (b1s + T(i,j)*((b2s + b3s*T(i,j))) + b5s*S(i,j)) ) + lambda_2d(i,j) = lam_scale * ( (c0 + c4s*S(i,j)) + T(i,j) * (c1s + T(i,j)*((c2s + c3s*T(i,j))) + c5s*S(i,j)) ) al0 = al0_2d(i,j) ; p0 = p0_2d(i,j) ; lambda = lambda_2d(i,j) dp = p_b(i,j) - p_t(i,j) diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 5650481558..2b4f99adf0 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -329,9 +329,9 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, & type(hor_index_type), intent(in) :: HI !< The horizontal index type for the arrays. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature relative to the surface - !! [degC]. + !! [C ~> degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity [PSU]. + intent(in) :: S !< Salinity [S ?~> PSU]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & @@ -346,9 +346,9 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, & !! [L2 Z-1 T-2 ~> m s-2] real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [R ~> kg m-3] real, intent(in) :: dRho_dT !< The derivative of density with temperature, - !! [R degC-1 ~> kg m-3 degC-1] + !! [R C-1 ~> kg m-3 degC-1] real, intent(in) :: dRho_dS !< The derivative of density with salinity, - !! in [R ppt-1 ~> kg m-3 ppt-1] + !! in [R S-1 ~> kg m-3 ppt-1] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the !! layer [R L2 T-2 ~> Pa] @@ -500,9 +500,9 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & type(hor_index_type), intent(in) :: HI !< The ocean's horizontal index type. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature relative to the surface - !! [degC]. + !! [C ~> degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity [PSU]. + intent(in) :: S !< Salinity [S ~> PSU]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & @@ -513,9 +513,9 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & !! alpha_ref, but this reduces the effects of roundoff. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [R ~> kg m-3] real, intent(in) :: dRho_dT !< The derivative of density with temperature - !! [R degC-1 ~> kg m-3 degC-1] + !! [R C-1 ~> kg m-3 degC-1] real, intent(in) :: dRho_dS !< The derivative of density with salinity, - !! in [R ppt-1 ~> kg m-3 ppt-1] + !! in [R S-1 ~> kg m-3 ppt-1] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dza !< The change in the geopotential anomaly across !! the layer [L2 T-2 ~> m2 s-2] From 14a222ea387dd83f74be36d649f8df0351cf8555 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 May 2022 08:22:22 -0400 Subject: [PATCH 11/68] Use simpler calculate_TFreeze interfaces Use the new, clearer interfaces for calculate_TFreeze in MOM6.F90 and MOM_diabatic_aux.F90, and use tv%C_p instead of fluxes%C_p in several places. tv%C_p is not used outside of the code under the MOM6 src directory, whereas fluxes%C_p is, so it is preferable to use tv%C_p to permit clean rescaling of the temperature-related variables without touching anything outside of the src directories. All answers are bitwise identical. --- src/core/MOM.F90 | 42 ++++++++++++------- src/core/MOM_forcing_type.F90 | 26 ++++++------ .../vertical/MOM_bulk_mixed_layer.F90 | 6 +-- .../vertical/MOM_diabatic_aux.F90 | 16 +++---- 4 files changed, 50 insertions(+), 40 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c4f3d40343..56e661f678 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -3194,12 +3194,13 @@ subroutine extract_surface_state(CS, sfc_state_in) !! layer properties [Z ~> m] or [H ~> m or kg m-2] real :: dh !< Thickness of a layer within the mixed layer [Z ~> m] or [H ~> m or kg m-2] real :: mass !< Mass per unit area of a layer [R Z ~> kg m-2] - real :: T_freeze !< freezing temperature [degC] real :: I_depth !< The inverse of depth [Z-1 ~> m-1] or [H-1 ~> m-1 or m2 kg-1] real :: missing_depth !< The portion of depth_ml that can not be found in a column [H ~> m or kg m-2] real :: H_rescale !< A conversion factor from thickness units to the units used in the !! calculation of properties of the uppermost ocean [nondim] or [Z H-1 ~> 1 or m3 kg-1] ! After the ANSWERS_2018 flag has been obsoleted, H_rescale will be 1. + real :: T_freeze(SZI_(CS%G)) !< freezing temperature [C] + real :: pres(SZI_(CS%G)) !< Pressure to use for the freezing temperature calculation [R L2 T-2 ~> Pa] real :: delT(SZI_(CS%G)) !< Depth integral of T-T_freeze [Z degC ~> m degC] logical :: use_temperature !< If true, temperature and salinity are used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors, ig, jg @@ -3408,28 +3409,37 @@ subroutine extract_surface_state(CS, sfc_state_in) if (allocated(sfc_state%melt_potential)) then - !$OMP parallel do default(shared) private(depth_ml, dh, T_freeze, depth, delT) + !$OMP parallel do default(shared) private(depth_ml, dh, T_freeze, depth, pres, delT) do j=js,je do i=is,ie depth(i) = 0.0 delT(i) = 0.0 + pres(i) = 0.0 + ! Here it is assumed that p=0 is OK, since HFrz ~ 10 to 20m, but under ice-shelves this + ! can be a very bad assumption. ###To fix this, uncomment the following... + ! pres(i) = p_surface(i) + 0.5*(GV%g_Earth*GV%H_to_RZ)*h(i,j,1) enddo - do k=1,nz ; do i=is,ie - depth_ml = min(CS%HFrz, CS%visc%MLD(i,j)) - if (depth(i) + h(i,j,k)*GV%H_to_Z < depth_ml) then - dh = h(i,j,k)*GV%H_to_Z - elseif (depth(i) < depth_ml) then - dh = depth_ml - depth(i) - else - dh = 0.0 - endif + do k=1,nz + call calculate_TFreeze(CS%tv%S(is:ie,j,k), pres(is:ie), T_freeze(is:ie), CS%tv%eqn_of_state) + do i=is,ie + depth_ml = min(CS%HFrz, CS%visc%MLD(i,j)) + if (depth(i) + h(i,j,k)*GV%H_to_Z < depth_ml) then + dh = h(i,j,k)*GV%H_to_Z + elseif (depth(i) < depth_ml) then + dh = depth_ml - depth(i) + else + dh = 0.0 + endif - ! p=0 OK, HFrz ~ 10 to 20m - call calculate_TFreeze(CS%tv%S(i,j,k), 0.0, T_freeze, CS%tv%eqn_of_state) - depth(i) = depth(i) + dh - delT(i) = delT(i) + dh * (CS%tv%T(i,j,k) - T_freeze) - enddo ; enddo + depth(i) = depth(i) + dh + delT(i) = delT(i) + dh * (CS%tv%T(i,j,k) - T_freeze(i)) + enddo + ! If there is a pressure-dependent freezing point calculation uncomment the following. + ! if (k 0.0) Ih_limit = 1.0 / FluxRescaleDepth - I_Cp = 1.0 / fluxes%C_p - I_Cp_Hconvert = 1.0 / (GV%H_to_RZ * fluxes%C_p) + I_Cp = 1.0 / tv%C_p + I_Cp_Hconvert = 1.0 / (GV%H_to_RZ * tv%C_p) is = G%isc ; ie = G%iec ; nz = GV%ke @@ -742,9 +742,9 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & if (associated(fluxes%heat_content_massin)) then if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" - fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_RZ / dt + fluxes%heat_content_massin(i,j) = -tv%C_p * netMassOut(i) * T(i,1) * GV%H_to_RZ / dt else ! net is "out" - fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & + fluxes%heat_content_massin(i,j) = tv%C_p * ( netMassInout(i) - netMassOut(i) ) * & T(i,1) * GV%H_to_RZ / dt endif else @@ -757,9 +757,9 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & if (associated(fluxes%heat_content_massout)) then if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" - fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_RZ / dt + fluxes%heat_content_massout(i,j) = tv%C_p * netMassOut(i) * T(i,1) * GV%H_to_RZ / dt else ! net is "out" - fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & + fluxes%heat_content_massout(i,j) = -tv%C_p * ( netMassInout(i) - netMassOut(i) ) * & T(i,1) * GV%H_to_RZ / dt endif else @@ -776,7 +776,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! wait until MOM_diabatic_driver.F90. if (associated(fluxes%heat_content_lprec)) then if (fluxes%lprec(i,j) > 0.0) then - fluxes%heat_content_lprec(i,j) = fluxes%C_p*fluxes%lprec(i,j)*T(i,1) + fluxes%heat_content_lprec(i,j) = tv%C_p*fluxes%lprec(i,j)*T(i,1) else fluxes%heat_content_lprec(i,j) = 0.0 endif @@ -787,7 +787,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! and until we do so fprec is treated like lprec and enters at SST. -AJA if (associated(fluxes%heat_content_fprec)) then if (fluxes%fprec(i,j) > 0.0) then - fluxes%heat_content_fprec(i,j) = fluxes%C_p*fluxes%fprec(i,j)*T(i,1) + fluxes%heat_content_fprec(i,j) = tv%C_p*fluxes%fprec(i,j)*T(i,1) else fluxes%heat_content_fprec(i,j) = 0.0 endif @@ -796,7 +796,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! Following lprec and fprec, water flux due to sea ice melt (seaice_melt) enters at SST - GMM if (associated(fluxes%heat_content_icemelt)) then if (fluxes%seaice_melt(i,j) > 0.0) then - fluxes%heat_content_icemelt(i,j) = fluxes%C_p*fluxes%seaice_melt(i,j)*T(i,1) + fluxes%heat_content_icemelt(i,j) = tv%C_p*fluxes%seaice_melt(i,j)*T(i,1) else fluxes%heat_content_icemelt(i,j) = 0.0 endif @@ -807,7 +807,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! vprec < 0 means remove water from ocean; set heat_content_vprec in MOM_diabatic_driver.F90 if (associated(fluxes%heat_content_vprec)) then if (fluxes%vprec(i,j) > 0.0) then - fluxes%heat_content_vprec(i,j) = fluxes%C_p*fluxes%vprec(i,j)*T(i,1) + fluxes%heat_content_vprec(i,j) = tv%C_p*fluxes%vprec(i,j)*T(i,1) else fluxes%heat_content_vprec(i,j) = 0.0 endif @@ -821,7 +821,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! Condensation is assumed to drop into the ocean at the SST, just like lprec. if (associated(fluxes%heat_content_cond)) then if (fluxes%evap(i,j) > 0.0) then - fluxes%heat_content_cond(i,j) = fluxes%C_p*fluxes%evap(i,j)*T(i,1) + fluxes%heat_content_cond(i,j) = tv%C_p*fluxes%evap(i,j)*T(i,1) else fluxes%heat_content_cond(i,j) = 0.0 endif @@ -830,14 +830,14 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! Liquid runoff enters ocean at SST if land model does not provide runoff heat content. if (.not. useRiverHeatContent) then if (associated(fluxes%lrunoff) .and. associated(fluxes%heat_content_lrunoff)) then - fluxes%heat_content_lrunoff(i,j) = fluxes%C_p*fluxes%lrunoff(i,j)*T(i,1) + fluxes%heat_content_lrunoff(i,j) = tv%C_p*fluxes%lrunoff(i,j)*T(i,1) endif endif ! Icebergs enter ocean at SST if land model does not provide calving heat content. if (.not. useCalvingHeatContent) then if (associated(fluxes%frunoff) .and. associated(fluxes%heat_content_frunoff)) then - fluxes%heat_content_frunoff(i,j) = fluxes%C_p*fluxes%frunoff(i,j)*T(i,1) + fluxes%heat_content_frunoff(i,j) = tv%C_p*fluxes%frunoff(i,j)*T(i,1) endif endif diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 73fc288731..3477938746 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -1061,7 +1061,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Conv_En(i) = 0.0 ; dKE_FC(i) = 0.0 if (associated(fluxes%heat_content_massin)) & fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & - T_precip * netMassIn(i) * GV%H_to_RZ * fluxes%C_p * Idt + T_precip * netMassIn(i) * GV%H_to_RZ * tv%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & T_precip * netMassIn(i) * GV%H_to_RZ else ! This is a massless column, but zero out the summed variables anyway for safety. @@ -1112,12 +1112,12 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & d_eb(i,k) = d_eb(i,k) - h_evap ! smg: when resolve the A=B code, we will set - ! heat_content_massout = heat_content_massout - T(i,k)*h_evap*GV%H_to_RZ*fluxes%C_p*Idt + ! heat_content_massout = heat_content_massout - T(i,k)*h_evap*GV%H_to_RZ*tv%C_p*Idt ! by uncommenting the lines here. ! we will also then completely remove TempXpme from the model. if (associated(fluxes%heat_content_massout)) & fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) - & - T(i,k)*h_evap*GV%H_to_RZ * fluxes%C_p * Idt + T(i,k)*h_evap*GV%H_to_RZ * tv%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) - & T(i,k)*h_evap*GV%H_to_RZ diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 86df042646..aa04526a21 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -162,8 +162,8 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) T_fr_set = .false. do i=is,ie ; if (tv%frazil(i,j) > 0.0) then if (.not.T_fr_set) then - call calculate_TFreeze(tv%S(i:,j,1), pressure(i:,1), T_freeze(i:), & - 1, ie-i+1, tv%eqn_of_state, pres_scale=US%RL2_T2_to_Pa) + call calculate_TFreeze(tv%S(i:ie,j,1), pressure(i:ie,1), T_freeze(i:ie), & + tv%eqn_of_state) T_fr_set = .true. endif @@ -188,8 +188,8 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) if ((G%mask2dT(i,j) > 0.0) .and. & ((tv%T(i,j,k) < 0.0) .or. (fraz_col(i) > 0.0))) then if (.not.T_fr_set) then - call calculate_TFreeze(tv%S(i:,j,k), pressure(i:,k), T_freeze(i:), & - 1, ie-i+1, tv%eqn_of_state, pres_scale=US%RL2_T2_to_Pa) + call calculate_TFreeze(tv%S(i:ie,j,k), pressure(i:ie,k), T_freeze(i:ie), & + tv%eqn_of_state) T_fr_set = .true. endif @@ -1284,10 +1284,10 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Diagnostics of heat content associated with mass fluxes if (associated(fluxes%heat_content_massin)) & fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & - T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt + T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * tv%C_p * Idt if (associated(fluxes%heat_content_massout)) & fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & - T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt + T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * tv%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & T2d(i,k) * dThickness * GV%H_to_RZ @@ -1367,10 +1367,10 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Diagnostics of heat content associated with mass fluxes if (associated(fluxes%heat_content_massin)) & fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & - T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt + T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * tv%C_p * Idt if (associated(fluxes%heat_content_massout)) & fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & - T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt + T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * tv%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & T2d(i,k) * dThickness * GV%H_to_RZ From 47f13924c95482198a4763306e825a056d283abb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 May 2022 09:33:11 -0400 Subject: [PATCH 12/68] Modify more units in temperature and saln comments Modified comments in 5 more files to prepare for the addition of dimensional rescaling of temperature and salinity. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 24 ++-- src/core/MOM_density_integrals.F90 | 129 +++++++++++----------- src/core/MOM_isopycnal_slopes.F90 | 32 +++--- src/user/user_change_diffusivity.F90 | 4 +- src/user/user_initialization.F90 | 4 +- 5 files changed, 99 insertions(+), 94 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 7d20409453..003bd2c3ec 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -91,9 +91,9 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! in seawater, but p will still be close to the pressure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter - ! than the mixed layer have the mixed layer's properties [degC]. + ! than the mixed layer have the mixed layer's properties [C ~> degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties [ppt]. + ! than the mixed layer have the mixed layer's properties [S ~> ppt]. real, dimension(SZI_(G)) :: Rho_cv_BL ! The coordinate potential density in the ! deepest variable density near-surface layer [R ~> kg m-3]. @@ -386,9 +386,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! in seawater, but e will still be close to the interface depth. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter - ! than the mixed layer have the mixed layer's properties [degC]. + ! than the mixed layer have the mixed layer's properties [C ~> degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties [ppt]. + ! than the mixed layer have the mixed layer's properties [S ~> ppt]. real :: Rho_cv_BL(SZI_(G)) ! The coordinate potential density in ! the deepest variable density near-surface layer [R ~> kg m-3]. @@ -626,10 +626,10 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses [H-1 ~> m-1 or m2 kg-1]. real :: press(SZI_(G)) ! Interface pressure [R L2 T-2 ~> Pa]. - real :: T_int(SZI_(G)) ! Interface temperature [degC]. - real :: S_int(SZI_(G)) ! Interface salinity [ppt]. - real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: T_int(SZI_(G)) ! Interface temperature [C ~> degC] + real :: S_int(SZI_(G)) ! Interface salinity [S ~> ppt] + real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: rho_in_situ(SZI_(G)) ! In-situ density at the top of a layer [R ~> kg m-3]. real :: G_Rho0 ! A scaled version of g_Earth / Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] real :: Rho0xG ! g_Earth * Rho0 [R L2 Z-1 T-2 ~> kg s-2 m-2] @@ -727,10 +727,10 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) dpbce, & ! A barotropic correction to the pbce to enable the use of ! a reduced gravity form of the equations [L2 H-1 T-2 ~> m4 kg-1 s-2]. C_htot ! dP_dH divided by the total ocean pressure [H-1 ~> m2 kg-1]. - real :: T_int(SZI_(G)) ! Interface temperature [degC]. - real :: S_int(SZI_(G)) ! Interface salinity [ppt]. - real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: T_int(SZI_(G)) ! Interface temperature [C ~> degC] + real :: S_int(SZI_(G)) ! Interface salinity [S ~> ppt] + real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: rho_in_situ(SZI_(G)) ! In-situ density at an interface [R ~> kg m-3]. real :: alpha_Lay(SZK_(GV)) ! The specific volume of each layer [R-1 ~> m3 kg-1]. real :: dalpha_int(SZK_(GV)+1) ! The change in specific volume across each interface [R-1 ~> m3 kg-1]. diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index cfb61e897b..a617ee514d 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -40,9 +40,9 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, US, dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp, Z_0p) type(hor_index_type), intent(in) :: HI !< Ocean horizontal index structures for the arrays real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: T !< Potential temperature referenced to the surface [degC] + intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: S !< Salinity [ppt] + intent(in) :: S !< Salinity [S ~> ppt] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & @@ -97,9 +97,9 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & dz_neglect, useMassWghtInterp, use_inaccurate_form, Z_0p) type(hor_index_type), intent(in) :: HI !< Horizontal index type for input variables. real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: T !< Potential temperature of the layer [degC] + intent(in) :: T !< Potential temperature of the layer [C ~> degC] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: S !< Salinity of the layer [ppt] + intent(in) :: S !< Salinity of the layer [S ~> ppt] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & @@ -139,7 +139,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] ! Local variables - real :: T5(5), S5(5) ! Temperatures and salinities at five quadrature points [degC] and [ppt] + real :: T5(5), S5(5) ! Temperatures and salinities at five quadrature points [C ~> degC] and [S ~> ppt] real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] real :: r5(5) ! Densities at five quadrature points [R ~> kg m-3] real :: rho_anom ! The depth averaged density anomaly [R ~> kg m-3] @@ -317,13 +317,13 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), & - intent(in) :: T_t !< Potential temperature at the cell top [degC] + intent(in) :: T_t !< Potential temperature at the cell top [C ~> degC] real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), & - intent(in) :: T_b !< Potential temperature at the cell bottom [degC] + intent(in) :: T_b !< Potential temperature at the cell bottom [C ~> degC] real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), & - intent(in) :: S_t !< Salinity at the cell top [ppt] + intent(in) :: S_t !< Salinity at the cell top [S ~> ppt] real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), & - intent(in) :: S_b !< Salinity at the cell bottom [ppt] + intent(in) :: S_b !< Salinity at the cell bottom [S ~> ppt] real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)+1), & intent(in) :: e !< Height of interfaces [Z ~> m] real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is subtracted @@ -368,21 +368,26 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & ! a linear interpolation is used to compute intermediate values. ! Local variables - real :: T5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Temperatures along a line of subgrid locations [degC] - real :: S5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Salinities along a line of subgrid locations [ppt] - real :: T25((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS temperature variance along a line of subgrid locations [degC2] - real :: TS5((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS temp-salt covariance along a line of subgrid locations [degC ppt] - real :: S25((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS salinity variance along a line of subgrid locations [ppt2] + real :: T5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Temperatures along a line of subgrid locations [C ~> degC] + real :: S5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Salinities along a line of subgrid locations [S ~> ppt] + real :: T25((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS temperature variance along a line of subgrid + ! locations [C2 ~> degC2] + real :: TS5((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS temp-salt covariance along a line of subgrid + ! locations [C S ~> degC ppt] + real :: S25((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS salinity variance along a line of subgrid locations [S2 ~> ppt2] real :: p5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Pressures along a line of subgrid locations [R L2 T-2 ~> Pa] real :: r5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Densities anomalies along a line of subgrid ! locations [R ~> kg m-3] real :: u5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Densities anomalies along a line of subgrid locations ! (used for inaccurate form) [R ~> kg m-3] - real :: T15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Temperatures at an array of subgrid locations [degC] - real :: S15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Salinities at an array of subgrid locations [ppt] - real :: T215((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS temperature variance along a line of subgrid locations [degC2] - real :: TS15((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS temp-salt covariance along a line of subgrid locations [degC ppt] - real :: S215((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS salinity variance along a line of subgrid locations [ppt2] + real :: T15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Temperatures at an array of subgrid locations [C ~> degC] + real :: S15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Salinities at an array of subgrid locations [S ~> ppt] + real :: T215((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS temperature variance along a line of subgrid + ! locations [C2 ~> degC2] + real :: TS15((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS temp-salt covariance along a line of subgrid + ! locations [C S ~> degC ppt] + real :: S215((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS salinity variance along a line of subgrid + ! locations [S2 ~> ppt2] real :: p15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Pressures at an array of subgrid locations [R L2 T-2 ~> Pa] real :: r15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Densities at an array of subgrid locations [R ~> kg m-3] real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim] @@ -397,8 +402,8 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real :: dz_x(5,HI%iscB:HI%iecB) ! Layer thicknesses along an x-line of subgrid locations [Z ~> m] real :: dz_y(5,HI%isc:HI%iec) ! Layer thicknesses along a y-line of subgrid locations [Z ~> m] real :: massWeightToggle ! A non-dimensional toggle factor (0 or 1) [nondim] - real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners [degC] - real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners [ppt] + real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners [C ~> degC] + real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners [S ~> ppt] real :: z0pres ! The height at which the pressure is zero [Z ~> m] real :: hWght ! A topographically limited thickness weight [Z ~> m] real :: hL, hR ! Thicknesses to the left and right [Z ~> m] @@ -712,13 +717,13 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), & - intent(in) :: T_t !< Potential temperature at the cell top [degC] + intent(in) :: T_t !< Potential temperature at the cell top [C ~> degC] real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), & - intent(in) :: T_b !< Potential temperature at the cell bottom [degC] + intent(in) :: T_b !< Potential temperature at the cell bottom [C ~> degC] real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), & - intent(in) :: S_t !< Salinity at the cell top [ppt] + intent(in) :: S_t !< Salinity at the cell top [S ~> ppt] real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), & - intent(in) :: S_b !< Salinity at the cell bottom [ppt] + intent(in) :: S_b !< Salinity at the cell bottom [S ~> ppt] real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)+1), & intent(in) :: e !< Height of interfaces [Z ~> m] real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is @@ -761,11 +766,11 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & ! a parabolic interpolation is used to compute intermediate values. ! Local variables - real :: T5(5) ! Temperatures along a line of subgrid locations [degC] - real :: S5(5) ! Salinities along a line of subgrid locations [ppt] - real :: T25(5) ! SGS temperature variance along a line of subgrid locations [degC2] - real :: TS5(5) ! SGS temperature-salinity covariance along a line of subgrid locations [degC ppt] - real :: S25(5) ! SGS salinity variance along a line of subgrid locations [ppt2] + real :: T5(5) ! Temperatures along a line of subgrid locations [C ~> degC] + real :: S5(5) ! Salinities along a line of subgrid locations [S ~> ppt] + real :: T25(5) ! SGS temperature variance along a line of subgrid locations [C2 ~> degC2] + real :: TS5(5) ! SGS temperature-salinity covariance along a line of subgrid locations [C S ~> degC ppt] + real :: S25(5) ! SGS salinity variance along a line of subgrid locations [S2 ~> ppt2] real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] real :: r5(5) ! Density anomalies from rho_ref at quadrature points [R ~> kg m-3] real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim] @@ -778,12 +783,12 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] real :: dz ! Layer thicknesses at tracer points [Z ~> m] real :: massWeightToggle ! A non-dimensional toggle factor (0 or 1) [nondim] - real :: Ttl, Tbl, Tml, Ttr, Tbr, Tmr ! Temperatures at the velocity cell corners [degC] - real :: Stl, Sbl, Sml, Str, Sbr, Smr ! Salinities at the velocity cell corners [ppt] - real :: s6 ! PPM curvature coefficient for S [ppt] - real :: t6 ! PPM curvature coefficient for T [degC] - real :: T_top, T_mn, T_bot ! Left edge, cell mean and right edge values used in PPM reconstructions of T - real :: S_top, S_mn, S_bot ! Left edge, cell mean and right edge values used in PPM reconstructions of S + real :: Ttl, Tbl, Tml, Ttr, Tbr, Tmr ! Temperatures at the velocity cell corners [C ~> degC] + real :: Stl, Sbl, Sml, Str, Sbr, Smr ! Salinities at the velocity cell corners [S ~> ppt] + real :: s6 ! PPM curvature coefficient for S [S ~> ppt] + real :: t6 ! PPM curvature coefficient for T [C ~> degC] + real :: T_top, T_mn, T_bot ! Left edge, cell mean and right edge values used in PPM reconstructions of T [C ~> degC] + real :: S_top, S_mn, S_bot ! Left edge, cell mean and right edge values used in PPM reconstructions of S [S ~> ppt] real :: z0pres ! The height at which the pressure is zero [Z ~> m] real :: hWght ! A topographically limited thickness weight [Z ~> m] real :: hL, hR ! Thicknesses to the left and right [Z ~> m] @@ -1042,9 +1047,9 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, US, & bathyP, dP_tiny, useMassWghtInterp) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: T !< Potential temperature referenced to the surface [degC] + intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: S !< Salinity [ppt] + intent(in) :: S !< Salinity [S ~> ppt] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & @@ -1100,9 +1105,9 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d bathyP, dP_neglect, useMassWghtInterp) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: T !< Potential temperature of the layer [degC] + intent(in) :: T !< Potential temperature of the layer [C ~> degC] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: S !< Salinity of the layer [ppt] + intent(in) :: S !< Salinity of the layer [S ~> ppt] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: p_t !< Pressure atop the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & @@ -1145,8 +1150,8 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d ! series for log(1-eps/1+eps) that assumes that |eps| < 0.34. ! Local variables - real :: T5(5) ! Temperatures at five quadrature points [degC] - real :: S5(5) ! Salinities at five quadrature points [ppt] + real :: T5(5) ! Temperatures at five quadrature points [C ~> degC] + real :: S5(5) ! Salinities at five quadrature points [S ~> ppt] real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1] real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1] @@ -1295,13 +1300,13 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, intp_dza, intx_dza, inty_dza, useMassWghtInterp) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: T_t !< Potential temperature at the top of the layer [degC] + intent(in) :: T_t !< Potential temperature at the top of the layer [C ~> degC] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: T_b !< Potential temperature at the bottom of the layer [degC] + intent(in) :: T_b !< Potential temperature at the bottom of the layer [C ~> degC] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: S_t !< Salinity at the top the layer [ppt] + intent(in) :: S_t !< Salinity at the top the layer [S ~> ppt] real, dimension(SZI_(HI),SZJ_(HI)), & - intent(in) :: S_b !< Salinity at the bottom the layer [ppt] + intent(in) :: S_b !< Salinity at the bottom the layer [S ~> ppt] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: p_t !< Pressure atop the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & @@ -1342,17 +1347,17 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, ! Boole's rule to do the horizontal integrals, and from a truncation in the ! series for log(1-eps/1+eps) that assumes that |eps| < 0.34. - real :: T5(5) ! Temperatures at five quadrature points [degC] - real :: S5(5) ! Salinities at five quadrature points [ppt] + real :: T5(5) ! Temperatures at five quadrature points [C ~> degC] + real :: S5(5) ! Salinities at five quadrature points [S ~> ppt] real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1] - real :: T15(15) ! Temperatures at fifteen interior quadrature points [degC] - real :: S15(15) ! Salinities at fifteen interior quadrature points [ppt] + real :: T15(15) ! Temperatures at fifteen interior quadrature points [C ~> degC] + real :: S15(15) ! Salinities at fifteen interior quadrature points [S ~> ppt] real :: p15(15) ! Pressures at fifteen quadrature points [R L2 T-2 ~> Pa] real :: a15(15) ! Specific volumes at fifteen quadrature points [R-1 ~> m3 kg-1] real :: wt_t(5), wt_b(5) ! Weights of top and bottom values at quadrature points [nondim] - real :: T_top, T_bot ! Horizontally interpolated temperature at the cell top and bottom [degC] - real :: S_top, S_bot ! Horizontally interpolated salinity at the cell top and bottom [ppt] + real :: T_top, T_bot ! Horizontally interpolated temperature at the cell top and bottom [C ~> degC] + real :: S_top, S_bot ! Horizontally interpolated salinity at the cell top and bottom [S ~> ppt] real :: P_top, P_bot ! Horizontally interpolated pressure at the cell top and bottom [R L2 T-2 ~> Pa] real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1] @@ -1522,10 +1527,10 @@ end subroutine int_spec_vol_dp_generic_plm !> Find the depth at which the reconstructed pressure matches P_tgt subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_tgt, & rho_ref, G_e, EOS, US, P_b, z_out, z_tol) - real, intent(in) :: T_t !< Potential temperature at the cell top [degC] - real, intent(in) :: T_b !< Potential temperature at the cell bottom [degC] - real, intent(in) :: S_t !< Salinity at the cell top [ppt] - real, intent(in) :: S_b !< Salinity at the cell bottom [ppt] + real, intent(in) :: T_t !< Potential temperature at the cell top [C ~> degC] + real, intent(in) :: T_b !< Potential temperature at the cell bottom [C ~> degC] + real, intent(in) :: S_t !< Salinity at the cell top [S ~> ppt] + real, intent(in) :: S_b !< Salinity at the cell bottom [S ~> ppt] real, intent(in) :: z_t !< Absolute height of top of cell [Z ~> m] (Boussinesq ????) real, intent(in) :: z_b !< Absolute height of bottom of cell [Z ~> m] real, intent(in) :: P_t !< Anomalous pressure of top of cell, relative @@ -1604,10 +1609,10 @@ end subroutine find_depth_of_pressure_in_cell !> Returns change in anomalous pressure change from top to non-dimensional !! position pos between z_t and z_b [R L2 T-2 ~> Pa] real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EOS) - real, intent(in) :: T_t !< Potential temperature at the cell top [degC] - real, intent(in) :: T_b !< Potential temperature at the cell bottom [degC] - real, intent(in) :: S_t !< Salinity at the cell top [ppt] - real, intent(in) :: S_b !< Salinity at the cell bottom [ppt] + real, intent(in) :: T_t !< Potential temperature at the cell top [C ~> degC] + real, intent(in) :: T_b !< Potential temperature at the cell bottom [C ~> degC] + real, intent(in) :: S_t !< Salinity at the cell top [S ~> ppt] + real, intent(in) :: S_b !< Salinity at the cell bottom [S ~> ppt] real, intent(in) :: z_t !< The geometric height at the top of the layer [Z ~> m] real, intent(in) :: z_b !< The geometric height at the bottom of the layer [Z ~> m] real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is subtracted out to @@ -1621,8 +1626,8 @@ real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EO real :: dz ! Distance from the layer top [Z ~> m] real :: top_weight, bottom_weight ! Fractional weights at quadrature points [nondim] real :: rho_ave ! Average density [R ~> kg m-3] - real, dimension(5) :: T5 ! Temperatures at quadrature points [degC] - real, dimension(5) :: S5 ! Salinities at quadrature points [ppt] + real, dimension(5) :: T5 ! Temperatures at quadrature points [C ~> degC] + real, dimension(5) :: S5 ! Salinities at quadrature points [S ~> ppt] real, dimension(5) :: p5 ! Pressures at quadrature points [R L2 T-2 ~> Pa] real, dimension(5) :: rho5 ! Densities at quadrature points [R ~> kg m-3] integer :: n diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 38a3544703..65b51ba310 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -63,26 +63,26 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! (This argument has been tested but for now serves no purpose.) !! of eta to m; US%Z_to_m by default. ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & - T, & ! The temperature [degC], with the values in + T, & ! The temperature [C ~> degC], with the values in ! in massless layers filled vertically by diffusion. - S !, & ! The filled salinity [ppt], with the values in + S !, & ! The filled salinity [S ~> ppt], with the values in ! in massless layers filled vertically by diffusion. ! Rho ! Density itself, when a nonlinear equation of state is not in use [R ~> kg m-3]. real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & pres ! The pressure at an interface [R L2 T-2 ~> Pa]. real, dimension(SZIB_(G)) :: & - drho_dT_u, & ! The derivative of density with temperature at u points [R degC-1 ~> kg m-3 degC-1]. - drho_dS_u ! The derivative of density with salinity at u points [R ppt-1 ~> kg m-3 ppt-1]. + drho_dT_u, & ! The derivative of density with temperature at u points [R C-1 ~> kg m-3 degC-1]. + drho_dS_u ! The derivative of density with salinity at u points [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)) :: & - drho_dT_v, & ! The derivative of density with temperature at v points [R degC-1 ~> kg m-3 degC-1]. - drho_dS_v ! The derivative of density with salinity at v points [R ppt-1 ~> kg m-3 ppt-1]. + drho_dT_v, & ! The derivative of density with temperature at v points [R C-1 ~> kg m-3 degC-1]. + drho_dS_v ! The derivative of density with salinity at v points [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZIB_(G)) :: & - T_u, & ! Temperature on the interface at the u-point [degC]. - S_u, & ! Salinity on the interface at the u-point [ppt]. + T_u, & ! Temperature on the interface at the u-point [C ~> degC]. + S_u, & ! Salinity on the interface at the u-point [S ~> ppt]. pres_u ! Pressure on the interface at the u-point [R L2 T-2 ~> Pa]. real, dimension(SZI_(G)) :: & - T_v, & ! Temperature on the interface at the v-point [degC]. - S_v, & ! Salinity on the interface at the v-point [ppt]. + T_v, & ! Temperature on the interface at the v-point [C ~> degC]. + S_v, & ! Salinity on the interface at the v-point [S ~> ppt]. pres_v ! Pressure on the interface at the v-point [R L2 T-2 ~> Pa]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below (B) the @@ -341,8 +341,8 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & T_v(i) = 0.25*((T(i,j,k) + T(i,j+1,k)) + (T(i,j,k-1) + T(i,j+1,k-1))) S_v(i) = 0.25*((S(i,j,k) + S(i,j+1,k)) + (S(i,j,k-1) + S(i,j+1,k-1))) enddo - call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, tv%eqn_of_state, & - EOSdom_v) + call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, & + tv%eqn_of_state, EOSdom_v) endif do i=is,ie if (use_EOS) then @@ -435,12 +435,12 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, lar type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T_in !< Input temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S_in !< Input salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T_in !< Input temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S_in !< Input salinity [S ~> ppt] real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing !! times a smoothing timescale [Z2 ~> m2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T_f !< Filled temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S_f !< Filled salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T_f !< Filled temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S_f !< Filled salinity [S ~> ppt] integer, optional, intent(in) :: halo_here !< Number of halo points to work on, !! 0 by default logical, optional, intent(in) :: larger_h_denom !< Present and true, add a large diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index f0ed674cf9..762cee5446 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -59,9 +59,9 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity !! at each interface [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: T_f !< Temperature with massless - !! layers filled in vertically [degC]. + !! layers filled in vertically [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: S_f !< Salinity with massless - !! layers filled in vertically [ppt]. + !! layers filled in vertically [S ~> ppt]. real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal !! diffusivity that is being added at !! each interface [Z2 T-1 ~> m2 s-1]. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index e115cd8f30..08c75a6ced 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -130,8 +130,8 @@ end subroutine USER_initialize_velocity subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt]. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. From 44a78617831a59c200199dc6ee2da338d4feab60 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 May 2022 09:33:59 -0400 Subject: [PATCH 13/68] +Add scale argument to set_up_ALE_sponge Added optional scaling arguments to the set_up_ALE_sponge routines, to allow input fields to be rescaled before use. This change is necessary to permit the dimensional rescaling of temperature, salinity, and other tracers because of the way that some versions repeatedly read new values from files as the runs progress. All answers are bitwise identical, but there are new optional arguments to public interfaces. --- .../vertical/MOM_ALE_sponge.F90 | 53 +++++++++++++------ 1 file changed, 36 insertions(+), 17 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 7be84d2522..9409a07fc1 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -78,6 +78,7 @@ module MOM_ALE_sponge integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field integer :: num_tlevs !< The number of time records contained in the file + real :: scale = 1.0 !< A multiplicative factor by which to rescale input data real, dimension(:,:), pointer :: p => NULL() !< pointer the data. real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid. end type p2d @@ -617,7 +618,7 @@ end subroutine init_ALE_sponge_diags !> This subroutine stores the reference profile at h points for the variable !! whose address is given by f_ptr. -subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS) +subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS, scale) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure (in/out). @@ -626,12 +627,17 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS) !! arbitrary number of layers. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & target, intent(in) :: f_ptr !< Pointer to the field to be damped + real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any + !! contributions due to dimensional rescaling. The default is 1. + real :: scale_fac ! A factor by which to scale sp_val before storing it. integer :: k, col character(len=256) :: mesg ! String for error messages if (.not.associated(CS)) return + scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + CS%fldno = CS%fldno + 1 if (CS%fldno > MAX_FIELDS_) then write(mesg,'("Increase MAX_FIELDS_ to at least ",I3," in MOM_memory.h or decrease & @@ -645,7 +651,7 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS) allocate(CS%Ref_val(CS%fldno)%p(CS%nz_data,CS%num_col), source=0.0) do col=1,CS%num_col do k=1,CS%nz_data - CS%Ref_val(CS%fldno)%p(k,col) = sp_val(CS%col_i(col),CS%col_j(col),k) + CS%Ref_val(CS%fldno)%p(k,col) = scale_fac*sp_val(CS%col_i(col),CS%col_j(col),k) enddo enddo @@ -655,7 +661,7 @@ end subroutine set_up_ALE_sponge_field_fixed !> This subroutine stores the reference profile at h points for the variable !! whose address is given by filename and fieldname. -subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, f_ptr, CS) +subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, f_ptr, CS, scale) character(len=*), intent(in) :: filename !< The name of the file with the !! time varying field data character(len=*), intent(in) :: fieldname !< The name of the field in the file @@ -667,6 +673,8 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). type(ALE_sponge_CS), pointer :: CS !< Sponge control structure (in/out). + real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any + !! contributions due to dimensional rescaling. The default is 1. ! Local variables integer :: isd, ied, jsd, jed @@ -697,6 +705,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, nz_data = fld_sz(3) CS%Ref_val(CS%fldno)%nz_data = nz_data !< individual sponge fields may reside on a different vertical grid CS%Ref_val(CS%fldno)%num_tlevs = fld_sz(4) + CS%Ref_val(CS%fldno)%scale = 1.0 ; if (present(scale)) CS%Ref_val(CS%fldno)%scale = scale ! initializes the target profile array for this field ! for all columns which will be masked allocate(CS%Ref_val(CS%fldno)%p(nz_data,CS%num_col), source=0.0) @@ -707,7 +716,7 @@ end subroutine set_up_ALE_sponge_field_varying !> This subroutine stores the reference profile at u and v points for the variable !! whose address is given by u_ptr and v_ptr. -subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, GV, u_ptr, v_ptr, CS) +subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, GV, u_ptr, v_ptr, CS, scale) type(ocean_grid_type), intent(in) :: G !< Grid structure (in). type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). @@ -721,23 +730,28 @@ subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, GV, u_ptr, v_ptr, !! have fewer layers than the model itself, but not more. real, target, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_ptr !< u-field to be damped [L T-1 ~> m s-1] real, target, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v_ptr !< v-field to be damped [L T-1 ~> m s-1] + real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any + !! contributions due to dimensional rescaling. The default is 1. + real :: scale_fac integer :: k, col if (.not.associated(CS)) return + scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + ! stores the reference profile allocate(CS%Ref_val_u%p(CS%nz_data,CS%num_col_u), source=0.0) do col=1,CS%num_col_u do k=1,CS%nz_data - CS%Ref_val_u%p(k,col) = u_val(CS%col_i_u(col),CS%col_j_u(col),k) + CS%Ref_val_u%p(k,col) = scale_fac*u_val(CS%col_i_u(col),CS%col_j_u(col),k) enddo enddo CS%var_u%p => u_ptr allocate(CS%Ref_val_v%p(CS%nz_data,CS%num_col_v), source=0.0) do col=1,CS%num_col_v do k=1,CS%nz_data - CS%Ref_val_v%p(k,col) = v_val(CS%col_i_v(col),CS%col_j_v(col),k) + CS%Ref_val_v%p(k,col) = scale_fac*v_val(CS%col_i_v(col),CS%col_j_v(col),k) enddo enddo CS%var_v%p => v_ptr @@ -747,7 +761,7 @@ end subroutine set_up_ALE_sponge_vel_field_fixed !> This subroutine stores the reference profile at u and v points for the variable !! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename_v, fieldname_v, & - Time, G, GV, US, CS, u_ptr, v_ptr) + Time, G, GV, US, CS, u_ptr, v_ptr, scale) character(len=*), intent(in) :: filename_u !< File name for u field character(len=*), intent(in) :: fieldname_u !< Name of u variable in file character(len=*), intent(in) :: filename_v !< File name for v field @@ -759,6 +773,9 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). real, target, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_ptr !< u-field to be damped [L T-1 ~> m s-1] real, target, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v_ptr !< v-field to be damped [L T-1 ~> m s-1] + real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any + !! contributions due to dimensional rescaling. For varying + !! velocities the default is the same using US%m_s_to_L_T. ! Local variables logical :: override @@ -783,6 +800,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename call get_external_field_info(CS%Ref_val_u%id, size=fld_sz) CS%Ref_val_u%nz_data = fld_sz(3) CS%Ref_val_u%num_tlevs = fld_sz(4) + CS%Ref_val_u%scale = US%m_s_to_L_T ; if (present(scale)) CS%Ref_val_u%scale = scale if (CS%spongeDataOngrid) then CS%Ref_val_v%id = init_external_field(filename_v, fieldname_v, domain=G%Domain%mpp_domain) @@ -793,6 +811,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename call get_external_field_info(CS%Ref_val_v%id, size=fld_sz) CS%Ref_val_v%nz_data = fld_sz(3) CS%Ref_val_v%num_tlevs = fld_sz(4) + CS%Ref_val_v%scale = US%m_s_to_L_T ; if (present(scale)) CS%Ref_val_v%scale = scale ! stores the reference profile allocate(CS%Ref_val_u%p(fld_sz(3),CS%num_col_u), source=0.0) @@ -860,8 +879,8 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%time_varying_sponges) then do m=1,CS%fldno nz_data = CS%Ref_val(m)%nz_data - call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, 1.0, G, sp_val, mask_z, z_in, & - z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & + call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, CS%Ref_val(m)%scale, G, sp_val, & + mask_z, z_in, z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & answers_2018=CS%hor_regrid_answers_2018) allocate( hsrc(nz_data) ) @@ -944,10 +963,10 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%time_varying_sponges) then nz_data = CS%Ref_val_u%nz_data ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, US%m_s_to_L_T, G, sp_val, mask_z, z_in, & - z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & - spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& - answers_2018=CS%hor_regrid_answers_2018) + call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, CS%Ref_val_u%scale, G, sp_val, & + mask_z, z_in, z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & + spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& + answers_2018=CS%hor_regrid_answers_2018) ! Initialize mask_z halos to zero before pass_var, in case of no update mask_z(G%isc-1, G%jsc:G%jec, :) = 0. @@ -993,10 +1012,10 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) deallocate(sp_val, mask_u, mask_z, hsrc) nz_data = CS%Ref_val_v%nz_data ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, US%m_s_to_L_T, G, sp_val, mask_z, z_in, & - z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & - spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& - answers_2018=CS%hor_regrid_answers_2018) + call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, CS%Ref_val_v%scale, G, sp_val, & + mask_z, z_in, z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & + spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& + answers_2018=CS%hor_regrid_answers_2018) ! Initialize mask_z halos to zero before pass_var, in case of no update mask_z(G%isc:G%iec, G%jsc-1, :) = 0. mask_z(G%isc:G%iec, G%jec+1, :) = 0. From 5a89a9d0c22948d58d9e4aeb69c4048859b534e9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 May 2022 10:57:02 -0400 Subject: [PATCH 14/68] +Add rescaling for temperature and salinity (1) Added dimensional rescaling for temperature and salinity, as determined by the new runtime parameters C_RESCALE_POWER and S_RESCALE_POWER. With this change there are 4 new elements in the transparent unit_scale_type, and these are widely used in the code. In addition, ### other files were added that had checksum calls or diagnostics rescaled by these new factors, and where comments were changed, but were otherwise unaltered as a result of the new dimensional rescaling. There will be another commit very shortly that completes the changes and leads to fully functional dimensional rescaling for temperatures and salinities, but these will involve more extensive code or interface changes, but this commit will be useful for any possible git-bisection of any potential changes that do not involve dimensional rescaling. All solutions in existing test cases are bitwise identical. --- src/ALE/MOM_ALE.F90 | 16 +-- src/core/MOM_PressureForce_FV.F90 | 28 ++-- src/core/MOM_checksum_packages.F90 | 37 ++--- src/diagnostics/MOM_PointAccel.F90 | 26 ++-- src/diagnostics/MOM_diagnostics.F90 | 57 ++++---- src/diagnostics/MOM_wave_structure.F90 | 2 +- src/framework/MOM_unit_scaling.F90 | 35 ++++- src/ocean_data_assim/MOM_oda_incupd.F90 | 10 +- .../lateral/MOM_thickness_diffuse.F90 | 36 ++--- .../vertical/MOM_CVMix_KPP.F90 | 47 ++++--- .../vertical/MOM_diabatic_aux.F90 | 67 ++++----- .../vertical/MOM_diabatic_driver.F90 | 131 ++++++++++-------- .../vertical/MOM_diapyc_energy_req.F90 | 120 ++++++++-------- .../vertical/MOM_regularize_layers.F90 | 14 +- .../vertical/MOM_set_diffusivity.F90 | 34 ++--- .../vertical/MOM_set_viscosity.F90 | 36 ++--- src/tracer/MOM_generic_tracer.F90 | 9 +- 17 files changed, 385 insertions(+), 320 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 4ebc395d7a..810f152e4a 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -318,9 +318,9 @@ subroutine ALE_register_diags(Time, G, GV, US, diag, CS) 'Layer Thickness before remapping', get_thickness_units(GV), conversion=GV%H_to_MKS, & v_extensive=.true.) CS%id_T_preale = register_diag_field('ocean_model', 'T_preale', diag%axesTL, Time, & - 'Temperature before remapping', 'degC') + 'Temperature before remapping', 'degC', conversion=US%C_to_degC) CS%id_S_preale = register_diag_field('ocean_model', 'S_preale', diag%axesTL, Time, & - 'Salinity before remapping', 'PSU') + 'Salinity before remapping', 'PSU', conversion=US%S_to_ppt) CS%id_e_preale = register_diag_field('ocean_model', 'e_preale', diag%axesTi, Time, & 'Interface Heights before remapping', 'm', conversion=US%Z_to_m) @@ -451,8 +451,8 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) if (CS%debug) then call hchksum(h, "Post-ALE_main h", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(tv%T, "Post-ALE_main T", G%HI, haloshift=0) - call hchksum(tv%S, "Post-ALE_main S", G%HI, haloshift=0) + call hchksum(tv%T, "Post-ALE_main T", G%HI, haloshift=0, scale=US%C_to_degC) + call hchksum(tv%S, "Post-ALE_main S", G%HI, haloshift=0, scale=US%S_to_ppt) call uvchksum("Post-ALE_main [uv]", u, v, G%HI, haloshift=0, scale=US%L_T_to_m_s) endif @@ -1160,13 +1160,13 @@ subroutine TS_PLM_edge_values( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_extrap 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 + 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 + 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 + 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 + 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] diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 2a79486a5f..ffd2c61d97 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -98,14 +98,14 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: p ! Interface pressure [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter - ! than the mixed layer have the mixed layer's properties [degC]. + ! than the mixed layer have the mixed layer's properties [C ~> degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties [ppt]. + ! than the mixed layer have the mixed layer's properties [S ~> ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & S_t, & ! Top and bottom edge values for linear reconstructions - S_b, & ! of salinity within each layer [ppt]. + S_b, & ! of salinity within each layer [S ~> ppt]. T_t, & ! Top and bottom edge values for linear reconstructions - T_b ! of temperature within each layer [degC]. + T_b ! of temperature within each layer [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & dza, & ! The change in geopotential anomaly between the top and bottom ! of a layer [L2 T-2 ~> m2 s-2]. @@ -467,12 +467,14 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter - ! than the mixed layer have the mixed layer's properties [degC]. + ! than the mixed layer have the mixed layer's properties [C ~> degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties [ppt]. + ! than the mixed layer have the mixed layer's properties [S ~> ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions - ! of salinity and temperature within each layer. + S_t, & ! Top and bottom edge values for linear reconstructions + S_b, & ! of salinity within each layer [S ~> ppt]. + T_t, & ! Top and bottom edge values for linear reconstructions + T_b ! of temperature within each layer [C ~> degC]. real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). @@ -487,9 +489,9 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: Tl(5) ! copy and T in local stencil [degC] - real :: mn_T ! mean of T in local stencil [degC] - real :: mn_T2 ! mean of T**2 in local stencil [degC2] + real :: Tl(5) ! copy and 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, parameter :: C1_6 = 1.0/6.0 @@ -699,7 +701,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm ! where the layers are located. if ( use_ALE .and. CS%Recon_Scheme > 0 ) then if ( CS%Recon_Scheme == 1 ) then - call int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, & + call int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & G%HI, GV, tv%eqn_of_state, US, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp=CS%useMassWghtInterp, & @@ -866,7 +868,7 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS "Negative values disable the scheme.", units="nondim", default=-1.0) if (CS%Stanley_T2_det_coeff>=0.) then CS%id_tvar_sgs = register_diag_field('ocean_model', 'tvar_sgs_pgf', diag%axesTL, & - Time, 'SGS temperature variance used in PGF', 'degC2') + Time, 'SGS temperature variance used in PGF', 'degC2', conversion=US%C_to_degC**2) endif if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index d9855a98d3..bc6f206b33 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -124,12 +124,12 @@ subroutine MOM_thermo_chksum(mesg, tv, G, US, haloshift) integer :: hs hs=1 ; if (present(haloshift)) hs=haloshift - if (associated(tv%T)) call hchksum(tv%T, mesg//" T", G%HI, haloshift=hs) - if (associated(tv%S)) call hchksum(tv%S, mesg//" S", G%HI, haloshift=hs) + if (associated(tv%T)) call hchksum(tv%T, mesg//" T", G%HI, haloshift=hs, scale=US%C_to_degC) + if (associated(tv%S)) call hchksum(tv%S, mesg//" S", G%HI, haloshift=hs, scale=US%S_to_ppt) if (associated(tv%frazil)) call hchksum(tv%frazil, mesg//" frazil", G%HI, haloshift=hs, & scale=US%Q_to_J_kg*US%R_to_kg_m3*US%Z_to_m) - if (associated(tv%salt_deficit)) & - call hchksum(tv%salt_deficit, mesg//" salt deficit", G%HI, haloshift=hs, scale=US%RZ_to_kg_m2) + if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, mesg//" salt deficit", G%HI, haloshift=hs, & + scale=US%S_to_ppt*US%RZ_to_kg_m2) end subroutine MOM_thermo_chksum @@ -240,9 +240,9 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, pointer, dimension(:,:,:), & - intent(in) :: Temp !< Temperature [degC]. + intent(in) :: Temp !< Temperature [C ~> degC]. real, pointer, dimension(:,:,:), & - intent(in) :: Salt !< Salinity [ppt]. + intent(in) :: Salt !< Salinity [S ~> ppt]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, optional, intent(in) :: allowChange !< do not flag an error !! if the statistics change. @@ -258,8 +258,11 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe real :: Vol, dV ! The total ocean volume and its change [m3] (unscaled to permit reproducing sum). real :: Area ! The total ocean surface area [m2] (unscaled to permit reproducing sum). real :: h_minimum ! The minimum layer thicknesses [H ~> m or kg m-2] + real :: T_scale ! The scaling conversion factor for temperatures [degC C-1 ~> 1] + real :: S_scale ! The scaling conversion factor for salinities [ppt S-1 ~> 1] logical :: do_TS ! If true, evaluate statistics for temperature and salinity - type(stats) :: T, S, delT, delS + type(stats) :: T, delT ! Temperature statistics in unscaled units [degC] + type(stats) :: S, delS ! Salinity statistics in unscaled units [ppt] ! NOTE: save data is not normally allowed but we use it for debugging purposes here on the ! assumption we will not turn this on with threads @@ -278,6 +281,8 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe tmp_T(:,:) = 0.0 tmp_S(:,:) = 0.0 + T_scale = US%C_to_degC ; S_scale = US%S_to_ppt + ! First collect local stats do j=js,je ; do i=is,ie tmp_A(i,j) = tmp_A(i,j) + US%L_to_m**2*G%areaT(i,j) @@ -290,12 +295,12 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe dV = US%L_to_m**2*G%areaT(i,j)*GV%H_to_m*h(i,j,k) tmp_V(i,j) = tmp_V(i,j) + dV if (do_TS .and. h(i,j,k)>0.) then - T%minimum = min( T%minimum, Temp(i,j,k) ) ; T%maximum = max( T%maximum, Temp(i,j,k) ) - T%average = T%average + dV*Temp(i,j,k) - S%minimum = min( S%minimum, Salt(i,j,k) ) ; S%maximum = max( S%maximum, Salt(i,j,k) ) - S%average = S%average + dV*Salt(i,j,k) - tmp_T(i,j) = tmp_T(i,j) + dV*Temp(i,j,k) - tmp_S(i,j) = tmp_S(i,j) + dV*Salt(i,j,k) + T%minimum = min( T%minimum, T_scale*Temp(i,j,k) ) ; T%maximum = max( T%maximum, T_scale*Temp(i,j,k) ) + T%average = T%average + dV*T_scale*Temp(i,j,k) + S%minimum = min( S%minimum, S_scale*Salt(i,j,k) ) ; S%maximum = max( S%maximum, S_scale*Salt(i,j,k) ) + S%average = S%average + dV*S_scale*Salt(i,j,k) + tmp_T(i,j) = tmp_T(i,j) + dV*T_scale*Temp(i,j,k) + tmp_S(i,j) = tmp_S(i,j) + dV*S_scale*Salt(i,j,k) endif if (h_minimum > h(i,j,k)) h_minimum = h(i,j,k) endif @@ -343,11 +348,11 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe if (do_TS .and. T%minimum<-5.0) then do j=js,je ; do i=is,ie - if (minval(Temp(i,j,:)) == T%minimum) then + if (minval(T_scale*Temp(i,j,:)) == T%minimum) then write(0,'(a,2f12.5)') 'x,y=', G%geoLonT(i,j), G%geoLatT(i,j) write(0,'(a3,3a12)') 'k','h','Temp','Salt' do k = 1, nz - write(0,'(i3,3es12.4)') k, h(i,j,k), Temp(i,j,k), Salt(i,j,k) + write(0,'(i3,3es12.4)') k, h(i,j,k), T_scale*Temp(i,j,k), S_scale*Salt(i,j,k) enddo stop 'Extremum detected' endif @@ -360,7 +365,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe write(0,'(a,2f12.5)') 'x,y=',G%geoLonT(i,j),G%geoLatT(i,j) write(0,'(a3,3a12)') 'k','h','Temp','Salt' do k = 1, nz - write(0,'(i3,3es12.4)') k, h(i,j,k), Temp(i,j,k), Salt(i,j,k) + write(0,'(i3,3es12.4)') k, h(i,j,k), T_scale*Temp(i,j,k), S_scale*Salt(i,j,k) enddo stop 'Negative thickness detected' endif diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index e52feec697..423ef2b4f9 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -50,8 +50,8 @@ module MOM_PointAccel v_av => NULL(), & !< Time average velocity [L T-1 ~> m s-1] u_prev => NULL(), & !< Previous u-velocity [L T-1 ~> m s-1] v_prev => NULL(), & !< Previous v-velocity [L T-1 ~> m s-1] - T => NULL(), & !< Temperature [degC] - S => NULL(), & !< Salinity [ppt] + T => NULL(), & !< Temperature [C ~> degC] + S => NULL(), & !< Salinity [S ~> ppt] u_accel_bt => NULL(), & !< Barotropic u-accelerations [L T-2 ~> m s-2] v_accel_bt => NULL() !< Barotropic v-accelerations [L T-2 ~> m s-2] end type PointAccel_CS @@ -94,6 +94,8 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real :: h_scale ! A scaling factor for thicknesses [m H-1 ~> 1 or m3 kg-1] real :: vel_scale ! A scaling factor for velocities [m T s-1 L-1 ~> 1] real :: uh_scale ! A scaling factor for transport per unit length [m2 T s-1 L-1 H-1 ~> 1 or m3 kg-1] + real :: temp_scale ! A scaling factor for temperatures [degC C-1 ~> 1] + real :: saln_scale ! A scaling factor for salinities [ppt S-1 ~> 1] integer :: yr, mo, day, hr, minute, sec, yearday integer :: k, ks, ke integer :: nz @@ -103,6 +105,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st Angstrom = GV%Angstrom_H + GV%H_subroundoff h_scale = GV%H_to_m ; vel_scale = US%L_T_to_m_s ; uh_scale = GV%H_to_m*US%L_T_to_m_s + temp_scale = US%C_to_degC ; saln_scale = US%S_to_ppt ! if (.not.associated(CS)) return nz = GV%ke @@ -257,15 +260,15 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') e(K) ; enddo if (associated(CS%T)) then write(file,'(/,"T-: ")', advance='no') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%T(i,j,k) ; enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') temp_scale*CS%T(i,j,k) ; enddo write(file,'(/,"T+: ")', advance='no') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%T(i+1,j,k) ; enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') temp_scale*CS%T(i+1,j,k) ; enddo endif if (associated(CS%S)) then write(file,'(/,"S-: ")', advance='no') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%S(i,j,k) ; enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') saln_scale*CS%S(i,j,k) ; enddo write(file,'(/,"S+: ")', advance='no') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%S(i+1,j,k) ; enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') saln_scale*CS%S(i+1,j,k) ; enddo endif if (prev_avail) then @@ -426,6 +429,8 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real :: h_scale ! A scaling factor for thicknesses [m H-1 ~> 1 or m3 kg-1] real :: vel_scale ! A scaling factor for velocities [m T s-1 L-1 ~> 1] real :: uh_scale ! A scaling factor for transport per unit length [m2 T s-1 L-1 H-1 ~> 1 or m3 kg-1] + real :: temp_scale ! A scaling factor for temperatures [degC C-1 ~> 1] + real :: saln_scale ! A scaling factor for salinities [ppt S-1 ~> 1] integer :: yr, mo, day, hr, minute, sec, yearday integer :: k, ks, ke integer :: nz @@ -435,6 +440,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st Angstrom = GV%Angstrom_H + GV%H_subroundoff h_scale = GV%H_to_m ; vel_scale = US%L_T_to_m_s ; uh_scale = GV%H_to_m*US%L_T_to_m_s + temp_scale = US%C_to_degC ; saln_scale = US%S_to_ppt ! if (.not.associated(CS)) return nz = GV%ke @@ -592,15 +598,15 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') e(K) ; enddo if (associated(CS%T)) then write(file,'(/,"T-: ")', advance='no') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%T(i,j,k) ; enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') temp_scale*CS%T(i,j,k) ; enddo write(file,'(/,"T+: ")', advance='no') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%T(i,j+1,k) ; enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') temp_scale*CS%T(i,j+1,k) ; enddo endif if (associated(CS%S)) then write(file,'(/,"S-: ")', advance='no') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%S(i,j,k) ; enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') saln_scale*CS%S(i,j,k) ; enddo write(file,'(/,"S+: ")', advance='no') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%S(i,j+1,k) ; enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') saln_scale*CS%S(i,j+1,k) ; enddo endif if (prev_avail) then diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 6d5417e9cb..acdf02f5f6 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -209,7 +209,6 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! tmp array for surface properties - real :: surface_field(SZI_(G),SZJ_(G)) ! The surface temperature or salinity [degC] or [ppt] real :: pressure_1d(SZI_(G)) ! Temporary array for pressure when calling EOS [R L2 T-2 ~> Pa] real :: wt, wt_p ! The fractional weights of two successive values when interpolating from ! a list [nondim], scaled so that wt + wt_p = 1. @@ -374,7 +373,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(i) = pressure_1d(i) + 0.5*(GV%H_to_RZ*GV%g_Earth)*h(i,j,k) enddo ! Store in-situ density [R ~> kg m-3] in work_3d - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, rho_in_situ, & + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, rho_in_situ, & tv%eqn_of_state, EOSdom) do i=is,ie ! Cell thickness = dz = dp/(g*rho) (meter); store in work_3d work_3d(i,j,k) = (GV%H_to_RZ*h(i,j,k)) / rho_in_situ(i) @@ -401,7 +400,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! for some diagnostics using TEOS-10 function calls. if ((CS%id_Tpot > 0) .or. (CS%id_tob > 0)) then do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = gsw_pt_from_ct(tv%S(i,j,k),tv%T(i,j,k)) + work_3d(i,j,k) = US%degC_to_C*gsw_pt_from_ct(US%S_to_ppt*tv%S(i,j,k),US%C_to_degC*tv%T(i,j,k)) enddo ; 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) @@ -418,7 +417,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! for some diagnostics using TEOS-10 function calls. if ((CS%id_Sprac > 0) .or. (CS%id_sob > 0)) then do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = gsw_sp_from_sr(tv%S(i,j,k)) + work_3d(i,j,k) = US%ppt_to_S*gsw_sp_from_sr(US%S_to_ppt*tv%S(i,j,k)) enddo ; 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) @@ -430,43 +429,37 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! volume mean potential temperature if (CS%id_thetaoga>0) then - thetaoga = global_volume_mean(tv%T, h, G, GV) + thetaoga = global_volume_mean(tv%T, h, G, GV, scale=US%C_to_degC) call post_data(CS%id_thetaoga, thetaoga, CS%diag) endif ! area mean SST if (CS%id_tosga > 0) then - do j=js,je ; do i=is,ie - surface_field(i,j) = tv%T(i,j,1) - enddo ; enddo - tosga = global_area_mean(tv%T(:,:,1), G) + tosga = global_area_mean(tv%T(:,:,1), G, scale=US%C_to_degC) call post_data(CS%id_tosga, tosga, CS%diag) endif ! volume mean salinity if (CS%id_soga>0) then - soga = global_volume_mean(tv%S, h, G, GV) + soga = global_volume_mean(tv%S, h, G, GV, scale=US%S_to_ppt) call post_data(CS%id_soga, soga, CS%diag) endif ! area mean SSS if (CS%id_sosga > 0) then - do j=js,je ; do i=is,ie - surface_field(i,j) = tv%S(i,j,1) - enddo ; enddo - sosga = global_area_mean(surface_field, G) + sosga = global_area_mean(tv%S(:,:,1), G, scale=US%S_to_ppt) call post_data(CS%id_sosga, sosga, CS%diag) endif ! layer mean potential temperature if (CS%id_temp_layer_ave>0) then - temp_layer_ave = global_layer_mean(tv%T, h, G, GV) + temp_layer_ave = global_layer_mean(tv%T, h, G, GV, scale=US%C_to_degC) call post_data(CS%id_temp_layer_ave, temp_layer_ave, CS%diag) endif ! layer mean salinity if (CS%id_salt_layer_ave>0) then - salt_layer_ave = global_layer_mean(tv%S, h, G, GV) + salt_layer_ave = global_layer_mean(tv%S, h, G, GV, scale=US%S_to_ppt) call post_data(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) endif @@ -481,7 +474,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = tv%P_Ref !$OMP parallel do default(shared) do k=1,nz ; do j=js-1,je+1 - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), tv%eqn_of_state, & + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), tv%eqn_of_state, & EOSdom) enddo ; enddo else ! Rcv should not be used much in this case, so fill in sensible values. @@ -607,7 +600,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = 0. !$OMP parallel do default(shared) do k=1,nz ; do j=js,je - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & tv%eqn_of_state, EOSdom) enddo ; enddo if (CS%id_rhopot0 > 0) call post_data(CS%id_rhopot0, Rcv, CS%diag) @@ -616,7 +609,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = 2.0e7*US%kg_m3_to_R*US%m_s_to_L_T**2 ! 2000 dbars !$OMP parallel do default(shared) do k=1,nz ; do j=js,je - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & tv%eqn_of_state, EOSdom) enddo ; enddo if (CS%id_rhopot2 > 0) call post_data(CS%id_rhopot2, Rcv, CS%diag) @@ -627,7 +620,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = 0. ! Start at p=0 Pa at surface do k=1,nz pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure in middle of layer k - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & tv%eqn_of_state, EOSdom) pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure at bottom of layer k enddo @@ -1597,19 +1590,21 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag if (use_temperature) then if (tv%T_is_conT) then CS%id_Tpot = register_diag_field('ocean_model', 'temp', diag%axesTL, & - Time, 'Potential Temperature', 'degC') + Time, 'Potential Temperature', 'degC', conversion=US%C_to_degC) endif if (tv%S_is_absS) then CS%id_Sprac = register_diag_field('ocean_model', 'salt', diag%axesTL, & - Time, 'Salinity', 'psu') + Time, 'Salinity', 'psu', conversion=US%S_to_ppt) endif CS%id_tob = register_diag_field('ocean_model','tob', diag%axesT1, Time, & long_name='Sea Water Potential Temperature at Sea Floor', & - standard_name='sea_water_potential_temperature_at_sea_floor', units='degC') + standard_name='sea_water_potential_temperature_at_sea_floor', & + units='degC', conversion=US%C_to_degC) CS%id_sob = register_diag_field('ocean_model','sob',diag%axesT1, Time, & long_name='Sea Water Salinity at Sea Floor', & - standard_name='sea_water_salinity_at_sea_floor', units='psu') + standard_name='sea_water_salinity_at_sea_floor', & + units='psu', conversion=US%S_to_ppt) CS%id_temp_layer_ave = register_diag_field('ocean_model', 'temp_layer_ave', & diag%axesZL, Time, 'Layer Average Ocean Temperature', 'degC') @@ -1670,10 +1665,10 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'In situ density', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_drho_dT = register_diag_field('ocean_model', 'drho_dT', diag%axesTL, Time, & 'Partial derivative of rhoinsitu with respect to temperature (alpha)', & - 'kg m-3 degC-1', conversion=US%R_to_kg_m3) + 'kg m-3 degC-1', conversion=US%R_to_kg_m3*US%degC_to_C) CS%id_drho_dS = register_diag_field('ocean_model', 'drho_dS', diag%axesTL, Time, & 'Partial derivative of rhoinsitu with respect to salinity (beta)', & - 'kg^2 g-1 m-3', conversion=US%R_to_kg_m3) + 'kg^2 g-1 m-3', conversion=US%R_to_kg_m3*US%ppt_to_S) CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) @@ -1795,13 +1790,15 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 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%RZ_to_kg_m2, & + '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%RZ_to_kg_m2, & + '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') @@ -1890,7 +1887,7 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) IDs%id_salt_deficit = register_diag_field('ocean_model', 'salt_deficit', diag%axesT1, Time, & 'Salt source in ocean required to supply excessive ice salt fluxes', & - 'ppt kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) + 'ppt kg m-2 s-1', conversion=US%S_to_ppt*US%RZ_T_to_kg_m2s) IDs%id_Heat_PmE = register_diag_field('ocean_model', 'Heat_PmE', diag%axesT1, Time, & 'Heat flux into ocean from mass flux into ocean', & 'W m-2', conversion=US%QRZ_T_to_W_m2) @@ -2119,7 +2116,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) use_temperature = associated(tv%T) if (use_temperature) then id = register_static_field('ocean_model','C_p', diag%axesNull, & - 'heat capacity of sea water', 'J kg-1 K-1', conversion=US%Q_to_J_kg, & + 'heat capacity of sea water', 'J kg-1 K-1', conversion=US%Q_to_J_kg*US%degC_to_C, & cmor_field_name='cpocean', & cmor_standard_name='specific_heat_capacity_of_sea_water', & cmor_long_name='specific_heat_capacity_of_sea_water') diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 41b296036f..c6b582a72d 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -127,7 +127,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(GV)) :: & Hc, & !< A column of layer thicknesses after convective instabilities are removed [Z ~> m] Tc, & !< A column of layer temperatures after convective instabilities are removed [C ~> degC] - Sc, & !< A column of layer salinites after convective instabilities are removed [S ~> ppt] + Sc, & !< A column of layer salinities after convective instabilities are removed [S ~> ppt] Rc !< A column of layer densities after convective instabilities are removed [R ~> kg m-3] real, dimension(SZI_(G),SZJ_(G)) :: & htot !< The vertical sum of the thicknesses [Z ~> m] diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index bf8fd24b44..6defa492a8 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -30,6 +30,10 @@ module MOM_unit_scaling real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density [R m3 kg-1 ~> 1] real :: Q_to_J_kg !< A constant that translates the units of enthalpy to Joules per kilogram [J kg-1 Q-1 ~> 1] real :: J_kg_to_Q !< A constant that translates Joules per kilogram to the units of enthalpy [Q kg J-1 ~> 1] + real :: C_to_degC !< A constant that translates the units of temperature to degrees Celsius [degC C-1 ~> 1] + real :: degC_to_C !< A constant that translates degrees Celsius to the units of temperature [C degC-1 ~> 1] + real :: S_to_ppt !< A constant that translates the units of salinity to parts per thousand [ppt S-1 ~> 1] + real :: ppt_to_S !< A constant that translates parts per thousand to the units of salinity [S ppt-1 ~> 1] ! These are useful combinations of the fundamental scale conversion factors above. real :: Z_to_L !< Convert vertical distances to lateral lengths [L Z-1 ~> 1] @@ -68,8 +72,9 @@ subroutine unit_scaling_init( param_file, US ) ! This routine initializes a unit_scale_type structure (US). ! Local variables - integer :: Z_power, L_power, T_power, R_power, Q_power + integer :: Z_power, L_power, T_power, R_power, Q_power, C_power, S_power real :: Z_rescale_factor, L_rescale_factor, T_rescale_factor, R_rescale_factor, Q_rescale_factor + real :: C_rescale_factor, S_rescale_factor ! This include declares and sets the variable "version". # include "version_variable.h" character(len=16) :: mdl = "MOM_unit_scaling" @@ -99,8 +104,16 @@ subroutine unit_scaling_init( param_file, US ) units="nondim", default=0, debuggingParam=.true.) call get_param(param_file, mdl, "Q_RESCALE_POWER", Q_power, & "An integer power of 2 that is used to rescale the model's "//& - "internal units of heat content. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + "internal units of heat content. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) + call get_param(param_file, mdl, "C_RESCALE_POWER", C_power, & + "An integer power of 2 that is used to rescale the model's "//& + "internal units of temperature. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) + call get_param(param_file, mdl, "S_RESCALE_POWER", S_power, & + "An integer power of 2 that is used to rescale the model's "//& + "internal units of salinity. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) if (abs(Z_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& "Z_RESCALE_POWER is outside of the valid range of -300 to 300.") @@ -112,6 +125,10 @@ subroutine unit_scaling_init( param_file, US ) "R_RESCALE_POWER is outside of the valid range of -300 to 300.") if (abs(Q_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& "Q_RESCALE_POWER is outside of the valid range of -300 to 300.") + if (abs(C_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& + "C_RESCALE_POWER is outside of the valid range of -300 to 300.") + if (abs(S_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& + "S_RESCALE_POWER is outside of the valid range of -300 to 300.") Z_rescale_factor = 1.0 if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power @@ -138,6 +155,16 @@ subroutine unit_scaling_init( param_file, US ) US%Q_to_J_kg = 1.0 * Q_Rescale_factor US%J_kg_to_Q = 1.0 / Q_Rescale_factor + C_Rescale_factor = 1.0 + if (C_power /= 0) C_Rescale_factor = 2.0**C_power + US%C_to_degC = 1.0 * C_Rescale_factor + US%degC_to_C = 1.0 / C_Rescale_factor + + S_Rescale_factor = 1.0 + if (S_power /= 0) S_Rescale_factor = 2.0**S_power + US%S_to_ppt = 1.0 * S_Rescale_factor + US%ppt_to_S = 1.0 / S_Rescale_factor + call set_unit_scaling_combos(US) end subroutine unit_scaling_init @@ -154,6 +181,8 @@ subroutine unit_no_scaling_init(US) US%T_to_s = 1.0 ; US%s_to_T = 1.0 US%R_to_kg_m3 = 1.0 ; US%kg_m3_to_R = 1.0 US%Q_to_J_kg = 1.0 ; US%J_kg_to_Q = 1.0 + US%C_to_degC = 1.0 ; US%degC_to_C = 1.0 + US%S_to_ppt = 1.0 ; US%ppt_to_S = 1.0 call set_unit_scaling_combos(US) end subroutine unit_no_scaling_init diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index 511bd89d7d..623f7da7b9 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -324,8 +324,10 @@ subroutine calc_oda_increments(h, tv, u, v, G, GV, US, CS) !! that is set by a previous call to initialize_oda_incupd (in). - real, dimension(SZK_(GV)) :: tmp_val1 ! data values on the model grid - real, allocatable, dimension(:) :: tmp_val2 ! data values remapped to increment grid + real, dimension(SZK_(GV)) :: tmp_val1 ! data values on the model grid, in rescaled units + ! like [S ~> ppt] for salinity. + real, allocatable, dimension(:) :: tmp_val2 ! data values remapped to increment grid, in rescaled units + ! like [S ~> ppt] for salinity. real, allocatable, dimension(:,:,:) :: h_obs !< Layer-thicknesses of increments [H ~> m or kg m-2] real, allocatable, dimension(:) :: tmp_h ! temporary array for corrected h_obs [H ~> m or kg m-2] real, allocatable, dimension(:) :: hu_obs ! A column of observation-grid thicknesses at u points [H ~> m or kg m-2] @@ -764,9 +766,9 @@ subroutine output_oda_incupd_inc(Time, G, GV, param_file, CS, US) ! register the variables to write call register_restart_field(CS%Inc(1)%p, "T_inc", .true., restart_CSp_tmp, & - "Pot. T. increment", "degC") + "Pot. T. increment", "degC", conversion=US%C_to_degC) call register_restart_field(CS%Inc(2)%p, "S_inc", .true., restart_CSp_tmp, & - "Salinity increment", "psu") + "Salinity increment", "psu", conversion=US%S_to_ppt) call register_restart_field(CS%Ref_h%p, "h_obs", .true., restart_CSp_tmp, & "Observational h", units=get_thickness_units(GV), conversion=GV%H_to_MKS) if (CS%uv_inc) then diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 036337a8de..f979008f1d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -440,8 +440,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp G%HI, haloshift=0, scale=US%Z_to_L) endif if (associated(tv%eqn_of_state)) then - call hchksum(tv%T, "thickness_diffuse T", G%HI, haloshift=1) - call hchksum(tv%S, "thickness_diffuse S", G%HI, haloshift=1) + call hchksum(tv%T, "thickness_diffuse T", G%HI, haloshift=1, scale=US%C_to_degC) + call hchksum(tv%S, "thickness_diffuse S", G%HI, haloshift=1, scale=US%S_to_ppt) endif endif @@ -594,9 +594,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - T, & ! The temperature [degC], with the values in + T, & ! The temperature [C ~> degC], with the values in ! in massless layers filled vertically by diffusion. - S, & ! The filled salinity [ppt], with the values in + S, & ! The filled salinity [S ~> ppt], with the values in ! in massless layers filled vertically by diffusion. h_avail, & ! The mass available for diffusion out of each face, divided ! by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -614,23 +614,23 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV pres, & ! The pressure at an interface [R L2 T-2 ~> Pa]. h_avail_rsum ! The running sum of h_avail above an interface [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & - drho_dT_u, & ! The derivative of density with temperature at u points [R degC-1 ~> kg m-3 degC-1] - drho_dS_u, & ! The derivative of density with salinity at u points [R ppt-1 ~> kg m-3 ppt-1]. - drho_dT_dT_u ! The second derivative of density with temperature at u points [R degC-2 ~> kg m-3 degC-2] + drho_dT_u, & ! The derivative of density with temperature at u points [R C-1 ~> kg m-3 degC-1] + drho_dS_u, & ! The derivative of density with salinity at u points [R S-1 ~> kg m-3 ppt-1]. + drho_dT_dT_u ! The second derivative of density with temperature at u points [R C-2 ~> kg m-3 degC-2] real, dimension(SZIB_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ignored. real, dimension(SZI_(G)) :: & - drho_dT_v, & ! The derivative of density with temperature at v points [R degC-1 ~> kg m-3 degC-1] - drho_dS_v, & ! The derivative of density with salinity at v points [R ppt-1 ~> kg m-3 ppt-1]. - drho_dT_dT_v ! The second derivative of density with temperature at v points [R degC-2 ~> kg m-3 degC-2] + drho_dT_v, & ! The derivative of density with temperature at v points [R C-1 ~> kg m-3 degC-1] + drho_dS_v, & ! The derivative of density with salinity at v points [R S-1 ~> kg m-3 ppt-1]. + drho_dT_dT_v ! The second derivative of density with temperature at v points [R C-2 ~> kg m-3 degC-2] real :: uhtot(SZIB_(G),SZJ_(G)) ! The vertical sum of uhD [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: vhtot(SZI_(G),SZJB_(G)) ! The vertical sum of vhD [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & - T_u, & ! Temperature on the interface at the u-point [degC]. - S_u, & ! Salinity on the interface at the u-point [ppt]. + T_u, & ! Temperature on the interface at the u-point [C ~> degC]. + S_u, & ! Salinity on the interface at the u-point [S ~> ppt]. pres_u ! Pressure on the interface at the u-point [R L2 T-2 ~> Pa]. real, dimension(SZI_(G)) :: & - T_v, & ! Temperature on the interface at the v-point [degC]. - S_v, & ! Salinity on the interface at the v-point [ppt]. + T_v, & ! Temperature on the interface at the v-point [C ~> degC]. + S_v, & ! Salinity on the interface at the v-point [S ~> ppt]. pres_v ! Pressure on the interface at the v-point [R L2 T-2 ~> Pa]. real :: Work_u(SZIB_(G),SZJ_(G)) ! The work being done by the thickness real :: Work_v(SZI_(G),SZJB_(G)) ! diffusion integrated over a cell [R Z L4 T-3 ~> W] @@ -687,12 +687,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: G_rho0 ! g/Rho0 [L2 R-1 Z-1 T-2 ~> m4 kg-1 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver ! times unit conversion factors [T-2 L2 Z-2 ~> s-2] - real :: Tl(5) ! copy of T in local stencil [degC] - real :: mn_T ! mean of T in local stencil [degC] - real :: mn_T2 ! mean of T**2 in local stencil [degC2] + 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 :: Tsgs2(SZI_(G),SZJ_(G),SZK_(GV)) ! Sub-grid temperature variance [degC2] + 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] diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 30818a6f1f..7b9e89edf1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -162,8 +162,8 @@ module MOM_CVMix_KPP real, allocatable, dimension(:,:,:) :: Kt_KPP !< Temp diffusivity from KPP [m2 s-1] real, allocatable, dimension(:,:,:) :: Ks_KPP !< Scalar diffusivity from KPP [m2 s-1] real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP [m2 s-1] - real, allocatable, dimension(:,:) :: Tsurf !< Temperature of surface layer [degC] - real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer [ppt] + real, allocatable, dimension(:,:) :: Tsurf !< Temperature of surface layer [C ~> degC] + real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer [S ~> ppt] real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer [m s-1] real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer [m s-1] real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient @@ -535,11 +535,14 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) CS%id_uStar = register_diag_field('ocean_model', 'KPP_uStar', diag%axesT1, Time, & 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & - 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) + 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', & + 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & - 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s', conversion=GV%H_to_m*US%s_to_T) + 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', & + 'K m/s', conversion=US%C_to_degC*GV%H_to_m*US%s_to_T) CS%id_netS = register_diag_field('ocean_model', 'KPP_netSalt', diag%axesT1, Time, & - 'Effective net surface salt flux, as used by [CVMix] KPP', 'ppt m/s', conversion=GV%H_to_m*US%s_to_T) + 'Effective net surface salt flux, as used by [CVMix] KPP', & + 'ppt m/s', conversion=US%S_to_ppt*GV%H_to_m*US%s_to_T) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & @@ -554,20 +557,20 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim') CS%id_NLT_dTdt = register_diag_field('ocean_model', 'KPP_NLT_dTdt', diag%axesTL, Time, & 'Temperature tendency due to non-local transport of heat, as calculated by [CVMix] KPP', & - 'K/s', conversion=US%s_to_T) + 'K/s', conversion=US%C_to_degC*US%s_to_T) CS%id_NLT_dSdt = register_diag_field('ocean_model', 'KPP_NLT_dSdt', diag%axesTL, Time, & 'Salinity tendency due to non-local transport of salt, as calculated by [CVMix] KPP', & - 'ppt/s', conversion=US%s_to_T) + 'ppt/s', conversion=US%S_to_ppt*US%s_to_T) CS%id_NLT_temp_budget = register_diag_field('ocean_model', 'KPP_NLT_temp_budget', diag%axesTL, Time, & 'Heat content change due to non-local transport, as calculated by [CVMix] KPP', & 'W/m^2', conversion=US%QRZ_T_to_W_m2) CS%id_NLT_saln_budget = register_diag_field('ocean_model', 'KPP_NLT_saln_budget', diag%axesTL, Time, & 'Salt content change due to non-local transport, as calculated by [CVMix] KPP', & - 'kg/(sec*m^2)', conversion=US%RZ_T_to_kg_m2s) + 'kg/(sec*m^2)', conversion=US%S_to_ppt*US%RZ_T_to_kg_m2s) !### Should be multiplied by 1000? CS%id_Tsurf = register_diag_field('ocean_model', 'KPP_Tsurf', diag%axesT1, Time, & - 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'C') + 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'C', conversion=US%C_to_degC) CS%id_Ssurf = register_diag_field('ocean_model', 'KPP_Ssurf', diag%axesT1, Time, & - 'Salinity of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'ppt') + 'Salinity of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'ppt', conversion=US%S_to_ppt) CS%id_Usurf = register_diag_field('ocean_model', 'KPP_Usurf', diag%axesCu1, Time, & 'i-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'm/s') CS%id_Vsurf = register_diag_field('ocean_model', 'KPP_Vsurf', diag%axesCv1, Time, & @@ -916,8 +919,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Temp !< potential/cons temp [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Temp !< potential/cons temp [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< Salinity [S ~> ppt] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Velocity i-component [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Velocity j-component [L T-1 ~> m s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. @@ -940,8 +943,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! for EOS calculation real, dimension( 3*GV%ke ) :: rho_1D ! A column of densities [R ~> kg m-3] real, dimension( 3*GV%ke ) :: pres_1D ! A column of pressures [R L2 T-2 ~> Pa] - real, dimension( 3*GV%ke ) :: Temp_1D ! A column of temperatures [degC] - real, dimension( 3*GV%ke ) :: Salt_1D ! A column of salinities [ppt] + real, dimension( 3*GV%ke ) :: Temp_1D ! A column of temperatures [C ~> degC] + real, dimension( 3*GV%ke ) :: Salt_1D ! A column of salinities [S ~> ppt] real :: surfFricVel, surfBuoyFlux, Coriolis real :: GoRho ! Gravitational acceleration divided by density in MKS units [m R-1 s-2 ~> m4 kg-1 s-2] @@ -953,8 +956,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real :: hTot ! Running sum of thickness used in the surface layer average [m] real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] real :: delH ! Thickness of a layer [m] - real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer - real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer + real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer [C ~> degC] + real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer [S ~> ppt] real :: surfHu, surfU ! Integral and average of u over the surface layer real :: surfHv, surfV ! Integral and average of v over the surface layer real :: dh ! The local thickness used for calculating interface positions [m] @@ -971,8 +974,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl "KPP_compute_BLD: The Waves control structure must be associated if STOKES_MIXING is True.") if (CS%debug) then - call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) - call hchksum(Temp, "KPP in: T",G%HI,haloshift=0) + call hchksum(Salt, "KPP in: S", G%HI, haloshift=0, scale=US%S_to_ppt) + call hchksum(Temp, "KPP in: T", G%HI, haloshift=0, scale=US%C_to_degC) call hchksum(u, "KPP in: u",G%HI,haloshift=0,scale=US%L_T_to_m_s) call hchksum(v, "KPP in: v",G%HI,haloshift=0,scale=US%L_T_to_m_s) endif @@ -1389,11 +1392,11 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of temperature - !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + !! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, intent(in) :: dt !< Time-step [T ~> s] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< temperature [degC] real, intent(in) :: C_p !< Seawater specific heat capacity - !! [Q degC-1 ~> J kg-1 degC-1] + !! [Q C-1 ~> J kg-1 degC-1] integer :: i, j, k real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [degC T-1 ~> degC s-1] @@ -1453,7 +1456,7 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt - !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + !! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] real, intent(in) :: dt !< Time-step [T ~> s] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [ppt] @@ -1493,7 +1496,7 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec - ! Here dtracer has units of [ppt R Z T-1 ~> ppt kg m-2 s-1] + ! Here dtracer has units of [S R Z T-1 ~> ppt kg m-2 s-1] dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & surfFlux(i,j) * GV%H_to_RZ enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index aa04526a21..11c168c2cc 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -106,7 +106,7 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any available !! thermodynamic fields. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init. real, dimension(SZI_(G),SZJ_(G)), & @@ -116,12 +116,12 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) ! Local variables real, dimension(SZI_(G)) :: & fraz_col, & ! The accumulated heat requirement due to frazil [Q R Z ~> J m-2]. - T_freeze, & ! The freezing potential temperature at the current salinity [degC]. + T_freeze, & ! The freezing potential temperature at the current salinity [C ~> degC]. ps ! Surface pressure [R L2 T-2 ~> Pa] 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] - real :: hc ! A layer's heat capacity [Q R Z degC-1 ~> J m-2 degC-1]. + real :: hc ! A layer's heat capacity [Q R Z C-1 ~> J m-2 degC-1]. logical :: T_fr_set ! True if the freezing point has been calculated for a ! row of points. integer :: i, j, k, is, ie, js, je, nz @@ -228,9 +228,9 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: T !< Potential temperature [degC]. + intent(inout) :: T !< Potential temperature [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: S !< Salinity [PSU] or [gSalt/kg], generically [ppt]. + intent(inout) :: S !< Salinity [PSU] or [gSalt/kg], generically [S ~> ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: Kd_T !< The extra diffusivity of temperature due to !! double diffusion relative to the diffusivity of @@ -329,8 +329,8 @@ subroutine adjust_salt(h, tv, G, GV, CS) !! call to diabatic_aux_init. ! local variables - real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement [ppt R Z ~> gSalt m-2] - real :: S_min !< The minimum salinity [ppt]. + real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement [S R Z ~> gSalt m-2] + real :: S_min !< The minimum salinity [S ~> ppt]. real :: mc !< A layer's mass [R Z ~> kg m-2]. integer :: i, j, k, is, ie, js, je, nz @@ -386,8 +386,8 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) !! above within this time step [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< The amount of fluid entrained from the layer !! below within this time step [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: T !< Layer potential temperatures [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: T !< Layer potential temperatures [C ~> degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [S ~> ppt]. ! Local variables real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. @@ -434,8 +434,8 @@ subroutine triDiagTS_Eulerian(G, GV, is, ie, js, je, hold, ent, T, S) !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: ent !< The amount of fluid mixed across an interface !! within this time step [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: T !< Layer potential temperatures [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: T !< Layer potential temperatures [C ~> degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [S ~> ppt]. ! Local variables real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. @@ -672,8 +672,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences [R ~> kg m-3]. real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures [R L2 T-2 ~> Pa]. real, dimension(SZI_(G)) :: H_subML, dH_N2 ! Summed thicknesses used in N2 calculation [H ~> m]. - real, dimension(SZI_(G)) :: T_subML, T_deeper ! Temperatures used in the N2 calculation [degC]. - real, dimension(SZI_(G)) :: S_subML, S_deeper ! Salinities used in the N2 calculation [ppt]. + real, dimension(SZI_(G)) :: T_subML, T_deeper ! Temperatures used in the N2 calculation [C ~> degC]. + real, dimension(SZI_(G)) :: S_subML, S_deeper ! Salinities used in the N2 calculation [S ~> ppt]. real, dimension(SZI_(G)) :: rho_subML, rho_deeper ! Densities used in the N2 calculation [R ~> kg m-3]. real, dimension(SZI_(G)) :: dK, dKm1 ! Depths [Z ~> m]. real, dimension(SZI_(G)) :: rhoSurf ! Density used in finding the mixed layer depth [R ~> kg m-3]. @@ -1036,10 +1036,10 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !! forcing through each layer [R Z3 T-2 ~> J m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: dSV_dT !< Partial derivative of specific volume with - !! potential temperature [R-1 degC-1 ~> m3 kg-1 degC-1]. + !! potential temperature [R-1 C-1 ~> m3 kg-1 degC-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with - !! salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + !! salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3]. @@ -1061,32 +1061,32 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t netMassIn, & ! mass entering ocean surface [H ~> m or kg m-2] over a time step netMassOut, & ! mass leaving ocean surface [H ~> m or kg m-2] over a time step netHeat, & ! heat via surface fluxes excluding Pen_SW_bnd and netMassOut - ! [degC H ~> degC m or degC kg m-2] + ! [C H ~> degC m or degC kg m-2] netSalt, & ! surface salt flux ( g(salt)/m2 for non-Bouss and ppt*H for Bouss ) - ! [ppt H ~> ppt m or ppt kg m-2] + ! [S H ~> ppt m or ppt kg m-2] nonpenSW, & ! non-downwelling SW, which is absorbed at ocean surface - ! [degC H ~> degC m or degC kg m-2] + ! [C H ~> degC m or degC kg m-2] SurfPressure, & ! Surface pressure (approximated as 0.0) [R L2 T-2 ~> Pa] - dRhodT, & ! change in density per change in temperature [R degC-1 ~> kg m-3 degC-1] - dRhodS, & ! change in density per change in salinity [R ppt-1 ~> kg m-3 ppt-1] - netheat_rate, & ! netheat but for dt=1 [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + dRhodT, & ! change in density per change in temperature [R C-1 ~> kg m-3 degC-1] + dRhodS, & ! change in density per change in salinity [R S-1 ~> kg m-3 ppt-1] + netheat_rate, & ! netheat but for dt=1 [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] netsalt_rate, & ! netsalt but for dt=1 (e.g. returns a rate) - ! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + ! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] netMassInOut_rate! netmassinout but for dt=1 [H T-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G), SZK_(GV)) :: & h2d, & ! A 2-d copy of the thicknesses [H ~> m or kg m-2] - T2d, & ! A 2-d copy of the layer temperatures [degC] + T2d, & ! A 2-d copy of the layer temperatures [C ~> degC] pen_TKE_2d, & ! The TKE required to homogenize the heating by shortwave radiation within ! a layer [R Z3 T-2 ~> J m-2] - dSV_dT_2d ! The partial derivative of specific volume with temperature [R-1 degC-1 ~> m3 kg-1 degC-1] + dSV_dT_2d ! The partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1] real, dimension(SZI_(G)) :: & netPen_rate ! The surface penetrative shortwave heating rate summed over all bands - ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1),SZI_(G)) :: & Pen_SW_bnd, & ! The penetrative shortwave heating integrated over a timestep by band - ! [degC H ~> degC m or degC kg m-2] + ! [C H ~> degC m or degC kg m-2] Pen_SW_bnd_rate ! The penetrative shortwave heating rate by band - ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1),SZI_(G),SZK_(GV)) :: & opacityBand ! The opacity (inverse of the exponential absorption length) of each frequency ! band of shortwave radiation in each layer [H-1 ~> m-1 or m2 kg-1] @@ -1190,9 +1190,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! note that lprec generally has sea ice melt/form included. ! netMassOut = net mass leaving ocean surface [H ~> m or kg m-2] over a time step. ! netMassOut < 0 means mass leaves ocean. - ! netHeat = heat via surface fluxes [degC H ~> degC m or degC kg m-2], excluding the part + ! netHeat = heat via surface fluxes [C H ~> degC m or degC kg m-2], excluding the part ! contained in Pen_SW_bnd; and excluding heat_content of netMassOut < 0. - ! netSalt = surface salt fluxes [ppt H ~> ppt m or gSalt m-2] + ! netSalt = surface salt fluxes [S H ~> ppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation split according to bands. ! This field provides that portion of SW from atmosphere that in fact ! enters to the ocean and participates in penetrative SW heating. @@ -1395,8 +1395,10 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t elseif (h2d(i,k) < 0.0) then ! h2d==0 is a special limit that needs no extra handling call forcing_SinglePointPrint(fluxes,G,i,j,'applyBoundaryFluxesInOut (h<0)') write(0,*) 'applyBoundaryFluxesInOut(): lon,lat=',G%geoLonT(i,j),G%geoLatT(i,j) - write(0,*) 'applyBoundaryFluxesInOut(): netT,netS,netH=',netHeat(i),netSalt(i),netMassInOut(i) - write(0,*) 'applyBoundaryFluxesInOut(): dT,dS,dH=',dTemp,dSalt,dThickness + write(0,*) 'applyBoundaryFluxesInOut(): netT,netS,netH=', & + US%C_to_degC*netHeat(i), US%S_to_ppt*netSalt(i), netMassInOut(i) + write(0,*) 'applyBoundaryFluxesInOut(): dT,dS,dH=', & + US%C_to_degC*dTemp, US%S_to_ppt*dSalt, dThickness write(0,*) 'applyBoundaryFluxesInOut(): h(n),h(n+1),k=',hOld,h2d(i,k),k call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//& "Complete mass loss in column!") @@ -1411,7 +1413,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t call forcing_SinglePointPrint(fluxes,G,i,j,'applyBoundaryFluxesInOut (land)') write(0,*) 'applyBoundaryFluxesInOut(): lon,lat=',G%geoLonT(i,j),G%geoLatT(i,j) write(0,*) 'applyBoundaryFluxesInOut(): netHeat,netSalt,netMassIn,netMassOut=',& - netHeat(i),netSalt(i),netMassIn(i),netMassOut(i) + US%C_to_degC*netHeat(i), US%S_to_ppt*netSalt(i), netMassIn(i), netMassOut(i) call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//& "Mass loss over land?") @@ -1476,6 +1478,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! convergence of SW into a layer do k=1,nz ; do i=is,ie + ! Note that the units of penSW_diag change here, from [C ~> degC] to [Q R Z T-1 ~> W m-2]. CS%penSW_diag(i,j,k) = (T2d(i,k)-CS%penSW_diag(i,j,k))*h(i,j,k) * Idt * tv%C_p * GV%H_to_RZ enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 19c7245f3f..acd3ef6a89 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -249,9 +249,9 @@ module MOM_diabatic_driver real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [nondim] real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux - !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + !! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux - !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + !! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type diabatic_CS @@ -298,14 +298,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & eta ! Interface heights before diapycnal mixing [Z ~> m] real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & cn_IGW ! baroclinic internal gravity wave speeds [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: temp_diag ! Previous temperature for diagnostics [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: temp_diag ! Previous temperature for diagnostics [C ~> degC] integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, allocatable, dimension(:,:,:) :: h_in ! thickness before thermodynamics - real, allocatable, dimension(:,:,:) :: t_in ! temperature before thermodynamics - real, allocatable, dimension(:,:,:) :: s_in ! salinity before thermodynamics - real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT + real, allocatable, dimension(:,:,:) :: h_in ! thickness before thermodynamics [H ~> m or kg m-2] + real, allocatable, dimension(:,:,:) :: t_in ! temperature before thermodynamics [C ~> degC] + real, allocatable, dimension(:,:,:) :: s_in ! salinity before thermodynamics [S ~> ppt] + real :: t_tend,s_tend,h_tend ! holder for tendency needed for SPPT real :: t_pert,s_pert,h_pert ! holder for perturbations needed for SPPT if (G%ke == 1) return @@ -315,9 +315,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & allocate(h_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) allocate(t_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) allocate(s_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) - h_in(:,:,:)=h(:,:,:) - t_in(:,:,:)=tv%T(:,:,:) - s_in(:,:,:)=tv%S(:,:,:) + h_in(:,:,:) = h(:,:,:) + t_in(:,:,:) = tv%T(:,:,:) + s_in(:,:,:) = tv%S(:,:,:) if (stoch_CS%id_sppt_wts > 0) then call post_data(stoch_CS%id_sppt_wts, stoch_CS%sppt_wts, CS%diag) @@ -488,9 +488,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & h_tend = (h(i,j,k)-h_in(i,j,k))*stoch_CS%sppt_wts(i,j) t_tend = (tv%T(i,j,k)-t_in(i,j,k))*stoch_CS%sppt_wts(i,j) s_tend = (tv%S(i,j,k)-s_in(i,j,k))*stoch_CS%sppt_wts(i,j) - h_pert=h_tend+h_in(i,j,k) - t_pert=t_tend+t_in(i,j,k) - s_pert=s_tend+s_in(i,j,k) + h_pert = h_tend+h_in(i,j,k) + t_pert = t_tend+t_in(i,j,k) + s_pert = s_tend+s_in(i,j,k) if (h_pert > GV%Angstrom_H) then h(i,j,k) = h_pert else @@ -541,13 +541,13 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_orig, & ! Initial layer thicknesses [H ~> m or kg m-2] - dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 degC-1 ~> m3 kg-1 degC-1] - dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [R Z3 T-2 ~> J m-2]. u_h, & ! Zonal velocities interpolated to thickness points [L T-1 ~> m s-1] v_h, & ! Meridional velocities interpolated to thickness points [L T-1 ~> m s-1] - temp_diag, & ! Diagnostic array of previous temperatures [degC] - saln_diag ! Diagnostic array of previous salinity [ppt] + temp_diag, & ! Diagnostic array of previous temperatures [C ~> degC] + saln_diag ! Diagnostic array of previous salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ent_s, & ! The diffusive coupling across interfaces within one time step for @@ -562,8 +562,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to ! Kd_int [Z2 T-1 ~> m2 s-1]. Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] - Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] - Sdif_flx ! diffusive diapycnal salt flux across interfaces [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] + Sdif_flx ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)) :: & SkinBuoyFlux ! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -728,8 +728,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & + scale=US%C_to_degC*GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & + scale=US%S_to_ppt*GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif @@ -826,8 +828,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call hchksum(ent_s, "after applyBoundaryFluxes ent_s", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(cTKE, "after applyBoundaryFluxes cTKE", G%HI, haloshift=0, & scale=US%RZ3_T3_to_W_m2*US%T_to_s) - call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT", G%HI, haloshift=0, scale=US%kg_m3_to_R) - call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS", G%HI, haloshift=0, scale=US%kg_m3_to_R) + call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT", G%HI, haloshift=0, & + scale=US%kg_m3_to_R*US%degC_to_C) + call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS", G%HI, haloshift=0, & + scale=US%kg_m3_to_R*US%ppt_to_S) endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) @@ -1122,13 +1126,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_orig, & ! Initial layer thicknesses [H ~> m or kg m-2] - dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 degC-1 ~> m3 kg-1 degC-1] - dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [R Z3 T-2 ~> J m-2]. u_h, & ! Zonal velocities interpolated to thickness points [L T-1 ~> m s-1] v_h, & ! Meridional velocities interpolated to thickness points [L T-1 ~> m s-1] - temp_diag, & ! Diagnostic array of previous temperatures [degC] - saln_diag ! Diagnostic array of previous salinity [ppt] + temp_diag, & ! Diagnostic array of previous temperatures [C ~> degC] + saln_diag ! Diagnostic array of previous salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ent_s, & ! The diffusive coupling across interfaces within one time step for @@ -1143,8 +1147,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to ! Kd_int returned from set_diffusivity [Z2 T-1 ~> m2 s-1]. Kd_ePBL, & ! boundary layer or convective diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] - Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] - Sdif_flx ! diffusive diapycnal salt flux across interfaces [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] + Sdif_flx ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)) :: & SkinBuoyFlux ! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -1301,8 +1305,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & + scale=US%C_to_degC*GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & + scale=US%S_to_ppt*GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif @@ -1360,8 +1366,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call hchksum(ent_s, "after applyBoundaryFluxes ent_s", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(cTKE, "after applyBoundaryFluxes cTKE", G%HI, haloshift=0, & scale=US%RZ3_T3_to_W_m2*US%T_to_s) - call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT", G%HI, haloshift=0, scale=US%kg_m3_to_R) - call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS", G%HI, haloshift=0, scale=US%kg_m3_to_R) + call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT", G%HI, haloshift=0, & + scale=US%kg_m3_to_R*US%degC_to_C) + call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS", G%HI, haloshift=0, & + scale=US%kg_m3_to_R*US%ppt_to_S) endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) @@ -1637,8 +1645,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! layer thicknesses (if a mixed layer is used) [H ~> m or kg m-2] u_h, & ! Zonal velocities at thickness points after entrainment [L T-1 ~> m s-1] v_h, & ! Meridional velocities at thickness points after entrainment [L T-1 ~> m s-1] - temp_diag, & ! Diagnostic array of previous temperatures [degC] - saln_diag ! Diagnostic array of previous salinity [ppt] + temp_diag, & ! Diagnostic array of previous temperatures [C ~> degC] + saln_diag ! Diagnostic array of previous salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml ! Coordinate density of mixed layer [R ~> kg m-3], used for applying sponges @@ -1656,10 +1664,10 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Kd_int [Z2 T-1 ~> m2 s-1]. Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to ! Kd_int [Z2 T-1 ~> m2 s-1]. - Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] - Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] - Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] - Sadv_flx ! advective diapycnal salt flux across interfaces [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] + Tadv_flx, & ! advective diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + Sadv_flx ! advective diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] ! The following 3 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & @@ -1917,8 +1925,10 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%useKPP) then call cpu_clock_begin(id_clock_kpp) if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & + scale=US%C_to_degC*GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & + scale=US%S_to_ppt*GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif @@ -2613,8 +2623,9 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: temp_old !< temperature prior to diabatic physics - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: saln_old !< salinity prior to diabatic physics [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: temp_old !< temperature prior to diabatic + !! physics [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: saln_old !< salinity prior to diabatic physics [S ~> ppt] real, intent(in) :: dt !< time step [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure @@ -2623,7 +2634,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d real :: Idt ! The inverse of the timestep [T-1 ~> s-1] - real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg. + real :: ppt2mks ! Conversion factor from S to kg/kg [S-1 ~> ppt-1]. integer :: i, j, k, is, ie, js, je, nz logical :: do_saln_tend ! Calculate salinity-based tendency diagnosics @@ -2673,6 +2684,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, ! salt tendency if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then + ppt2mks = US%S_to_ppt*0.001 do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = h(i,j,k)*GV%H_to_RZ * ppt2mks * work_3d(i,j,k) enddo ; enddo ; enddo @@ -2704,9 +2716,9 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< thickness after boundary flux application [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: temp_old !< temperature prior to boundary flux application [degC] + intent(in) :: temp_old !< temperature prior to boundary flux application [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: saln_old !< salinity prior to boundary flux application [ppt] + intent(in) :: saln_old !< salinity prior to boundary flux application [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< thickness prior to boundary flux application [H ~> m or kg m-2] real, intent(in) :: dt !< time step [T ~> s] @@ -2717,7 +2729,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d real :: Idt ! The inverse of the timestep [T-1 ~> s-1] - real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg. + real :: ppt2mks ! Conversion factor from S to kg/kg [S-1 ~> ppt-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -2768,6 +2780,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, ! salt tendency if (CS%id_boundary_forcing_salt_tend > 0 .or. CS%id_boundary_forcing_salt_tend_2d > 0) then + ppt2mks = US%S_to_ppt*0.001 do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = GV%H_to_RZ * ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k)) enddo ; enddo ; enddo @@ -2795,7 +2808,7 @@ subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, US, CS) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: temp_old !< temperature prior to frazil formation [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: temp_old !< temperature prior to frazil formation [C ~> degC] real, intent(in) :: dt !< time step [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure @@ -3143,19 +3156,19 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (use_temperature) then CS%id_Tdif = register_diag_field('ocean_model',"Tflx_dia_diff", diag%axesTi, & Time, "Diffusive diapycnal temperature flux across interfaces", & - "degC m s-1", conversion=GV%H_to_m*US%s_to_T) + "degC m s-1", conversion=US%C_to_degC*GV%H_to_m*US%s_to_T) if (.not.CS%useALEalgorithm) then CS%id_Tadv = register_diag_field('ocean_model',"Tflx_dia_adv", diag%axesTi, & Time, "Advective diapycnal temperature flux across interfaces", & - "degC m s-1", conversion=GV%H_to_m*US%s_to_T) + "degC m s-1", conversion=US%C_to_degC*GV%H_to_m*US%s_to_T) endif CS%id_Sdif = register_diag_field('ocean_model',"Sflx_dia_diff", diag%axesTi, & Time, "Diffusive diapycnal salnity flux across interfaces", & - "psu m s-1", conversion=GV%H_to_m*US%s_to_T) + "psu m s-1", conversion=US%S_to_ppt*GV%H_to_m*US%s_to_T) if (.not.CS%useALEalgorithm) then CS%id_Sadv = register_diag_field('ocean_model',"Sflx_dia_adv", diag%axesTi, & Time, "Advective diapycnal salnity flux across interfaces", & - "psu m s-1", conversion=GV%H_to_m*US%s_to_T) + "psu m s-1", conversion=US%S_to_ppt*GV%H_to_m*US%s_to_T) endif CS%id_MLD_003 = register_diag_field('ocean_model', 'MLD_003', diag%axesT1, Time, & 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=US%Z_to_m, & @@ -3216,9 +3229,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Interface Heights before diabatic forcing', 'm', conversion=US%Z_to_m) if (use_temperature) then CS%id_T_predia = register_diag_field('ocean_model', 'temp_predia', diag%axesTL, Time, & - 'Potential Temperature', 'degC') + 'Potential Temperature', 'degC', conversion=US%C_to_degC) CS%id_S_predia = register_diag_field('ocean_model', 'salt_predia', diag%axesTL, Time, & - 'Salinity', 'PSU') + 'Salinity', 'PSU', conversion=US%S_to_ppt) endif CS%id_Kd_int = register_diag_field('ocean_model', 'Kd_interface', diag%axesTi, Time, & @@ -3260,14 +3273,14 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%useALEalgorithm) then CS%id_diabatic_diff_temp_tend = register_diag_field('ocean_model', & 'diabatic_diff_temp_tendency', diag%axesTL, Time, & - 'Diabatic diffusion temperature tendency', 'degC s-1', conversion=US%s_to_T) + 'Diabatic diffusion temperature tendency', 'degC s-1', conversion=US%C_to_degC*US%s_to_T) if (CS%id_diabatic_diff_temp_tend > 0) then CS%diabatic_diff_tendency_diag = .true. endif CS%id_diabatic_diff_saln_tend = register_diag_field('ocean_model',& 'diabatic_diff_saln_tendency', diag%axesTL, Time, & - 'Diabatic diffusion salinity tendency', 'psu s-1', conversion=US%s_to_T) + 'Diabatic diffusion salinity tendency', 'psu s-1', conversion=US%S_to_ppt*US%s_to_T) if (CS%id_diabatic_diff_saln_tend > 0) then CS%diabatic_diff_tendency_diag = .true. endif @@ -3340,14 +3353,14 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_boundary_forcing_temp_tend = register_diag_field('ocean_model',& 'boundary_forcing_temp_tendency', diag%axesTL, Time, & - 'Boundary forcing temperature tendency', 'degC s-1', conversion=US%s_to_T) + 'Boundary forcing temperature tendency', 'degC s-1', conversion=US%C_to_degC*US%s_to_T) if (CS%id_boundary_forcing_temp_tend > 0) then CS%boundary_forcing_tendency_diag = .true. endif CS%id_boundary_forcing_saln_tend = register_diag_field('ocean_model',& 'boundary_forcing_saln_tendency', diag%axesTL, Time, & - 'Boundary forcing saln tendency', 'psu s-1', conversion=US%s_to_T) + 'Boundary forcing saln tendency', 'psu s-1', conversion=US%S_to_ppt*US%s_to_T) if (CS%id_boundary_forcing_saln_tend > 0) then CS%boundary_forcing_tendency_diag = .true. endif @@ -3395,7 +3408,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! diagnostic for tendency of temp due to frazil CS%id_frazil_temp_tend = register_diag_field('ocean_model',& 'frazil_temp_tendency', diag%axesTL, Time, & - 'Temperature tendency due to frazil formation', 'degC s-1', conversion=US%s_to_T) + 'Temperature tendency due to frazil formation', 'degC s-1', conversion=US%C_to_degC*US%s_to_T) if (CS%id_frazil_temp_tend > 0) then CS%frazil_tendency_diag = .true. endif diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index f55f1e27a5..c2e05dc930 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -62,7 +62,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) ! Local variables real, dimension(GV%ke) :: & - T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities [degC] and g/kg. + T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities [C ~> degC] and [S ~> ppt]. h_col ! h_col is a column of thicknesses h at tracer points [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]. @@ -127,8 +127,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment, !! [H ~> m or kg m-2]. - real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures [degC]. - real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities [ppt]. + real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures [C ~> degC]. + real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities [S ~> ppt]. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities !! [Z2 T-1 ~> m2 s-1]. real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]. @@ -151,40 +151,40 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke) :: & p_lay, & ! Average pressure of a layer [R L2 T-2 ~> Pa]. - dSV_dT, & ! Partial derivative of specific volume with temperature [R-1 degC-1 ~> m3 kg-1 degC-1]. - dSV_dS, & ! Partial derivative of specific volume with salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. - T0, S0, & ! Initial temperatures and salinities [degC] and [ppt]. - Te, Se, & ! Running incomplete estimates of the new temperatures and salinities [degC] and [ppt]. - Te_a, Se_a, & ! Running incomplete estimates of the new temperatures and salinities [degC] and [ppt]. - Te_b, Se_b, & ! Running incomplete estimates of the new temperatures and salinities [degC] and [ppt]. - Tf, Sf, & ! New final values of the temperatures and salinities [degC] and [ppt]. - dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change [degC] and [ppt]. + dSV_dT, & ! Partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1]. + dSV_dS, & ! Partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. + T0, S0, & ! Initial temperatures and salinities [C ~> degC] and [S ~> ppt]. + Te, Se, & ! Running incomplete estimates of the new temperatures and salinities [C ~> degC] and [S ~> ppt] + Te_a, Se_a, & ! Running incomplete estimates of the new temperatures and salinities [C ~> degC] and [S ~> ppt] + Te_b, Se_b, & ! Running incomplete estimates of the new temperatures and salinities [C ~> degC] and [S ~> ppt] + Tf, Sf, & ! New final values of the temperatures and salinities [C ~> degC] and [S ~> ppt]. + dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change [C ~> degC] and [S ~> ppt]. Th_a, & ! An effective temperature times a thickness in the layer above, including implicit - ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2]. + ! mixing effects with other yet higher layers [C H ~> degC m or degC kg m-2]. Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit - ! mixing effects with other yet higher layers [ppt H ~> ppt m or ppt kg m-2]. + ! mixing effects with other yet higher layers [S H ~> ppt m or ppt kg m-2]. Th_b, & ! An effective temperature times a thickness in the layer below, including implicit - ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. + ! mixing effects with other yet lower layers [C H ~> degC m or degC kg m-2]. Sh_b, & ! An effective salinity times a thickness in the layer below, including implicit - ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. + ! mixing effects with other yet lower layers [S H ~> ppt m or ppt kg m-2]. dT_to_dPE, & ! Partial derivative of column potential energy with the temperature and salinity - dS_to_dPE, & ! changes within a layer [R Z L2 T-2 degC-1 ~> J m-2 degC-1] and [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. + dS_to_dPE, & ! changes within a layer [R Z L2 T-2 C-1 ~> J m-2 degC-1] and [R Z L2 T-2 S-1 ~> J m-2 ppt-1] dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. + dS_to_dColHt, & ! and salinity changes within a layer [Z C-1 ~> m degC-1] and [Z S-1 ~> m ppt-1]. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. + ! of mixing with layers higher in the water column [Z C-1 ~> m degC-1] and [Z S-1 ~> m ppt-1]. dT_to_dColHt_b, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_b, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers lower in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. + ! of mixing with layers lower in the water column [Z C-1 ~> m degC-1] and [Z S-1 ~> m ppt-1]. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in - ! units of [R Z L2 T-2 degC-1 ~> J m-2 degC-1] and [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. + ! units of [R Z L2 T-2 C-1 ~> J m-2 degC-1] and [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. dT_to_dPE_b, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_b, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers lower in the water column, in - ! units of [R Z L2 T-2 degC-1 ~> J m-2 degC-1] and [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. + ! units of [R Z L2 T-2 C-1 ~> J m-2 degC-1] and [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. 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. @@ -222,9 +222,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & 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 :: dTe_term ! A diffusivity-independent term related to the temperature - ! change in the layer below the interface [degC H ~> degC m or degC kg m-2]. + ! change in the layer below the interface [C H ~> degC m or degC kg m-2]. real :: dSe_term ! A diffusivity-independent term related to the salinity - ! change in the layer below the interface [ppt H ~> ppt m or ppt kg m-2]. + ! change in the layer below the interface [S H ~> ppt m or ppt kg m-2]. real :: Kddt_h_guess ! A guess of the final value of Kddt_h [H ~> m or kg m-2]. real :: dMass ! The mass per unit area within a layer [R Z ~> kg m-2]. real :: dPres ! The hydrostatic pressure change across a layer [R L2 T-2 ~> Pa]. @@ -234,8 +234,10 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real :: ColHt_cor ! The correction to PE_chg that is made due to a net ! change in the column height [R L2 Z T-2 ~> J m-2]. real :: htot ! A running sum of thicknesses [H ~> m or kg m-2]. - real :: dTe_t2, dT_km1_t2, dT_k_t2 ! Temporary arrays describing temperature changes [degC]. - real :: dSe_t2, dS_km1_t2, dS_k_t2 ! Temporary arrays describing salinity changes [ppt]. + real :: dTe_t2 ! Temporary arrays with integrated temperature changes [C H ~> degC m or degC kg m-2] + real :: dSe_t2 ! Temporary arrays with integrated salinity changes [S H ~> ppt m or ppt kg m-2] + real :: dT_km1_t2, dT_k_t2 ! Temporary arrays describing temperature changes [C ~> degC]. + real :: dS_km1_t2, dS_k_t2 ! Temporary arrays describing salinity changes [S ~> ppt]. logical :: do_print ! The following are a bunch of diagnostic arrays for debugging purposes. @@ -977,51 +979,51 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer !! above, including implicit mixing effects with other - !! yet higher layers [degC H ~> degC m or degC kg m-2]. + !! yet higher layers [C H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_a !< An effective salinity times a thickness in the layer !! above, including implicit mixing effects with other - !! yet higher layers [ppt H ~> ppt m or ppt kg m-2]. + !! yet higher layers [S H ~> ppt m or ppt kg m-2]. real, intent(in) :: Th_b !< An effective temperature times a thickness in the layer !! below, including implicit mixing effects with other - !! yet lower layers [degC H ~> degC m or degC kg m-2]. + !! yet lower layers [C H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_b !< An effective salinity times a thickness in the layer !! below, including implicit mixing effects with other - !! yet lower layers [ppt H ~> ppt m or ppt kg m-2]. + !! yet lower layers [S H ~> ppt m or ppt kg m-2]. real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above [R Z L2 T-2 degC-1 ~> J m-2 degC-1]. + !! in the temperatures of all the layers above [R Z L2 T-2 C-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. + !! in the salinities of all the layers above [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below [R Z L2 T-2 degC-1 ~> J m-2 degC-1]. + !! in the temperatures of all the layers below [R Z L2 T-2 C-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. + !! in the salinities of all the layers below [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [R L2 T-2 ~> J m-3]. real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above [Z degC-1 ~> m degC-1]. + !! in the temperatures of all the layers above [Z C-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. + !! in the salinities of all the layers above [Z S-1 ~> m ppt-1]. real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below [Z degC-1 ~> m degC-1]. + !! in the temperatures of all the layers below [Z C-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. + !! in the salinities of all the layers below [Z S-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface [R Z L2 T-2 ~> J m-2]. @@ -1037,8 +1039,8 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. - real :: dT_c ! The core term in the expressions for the temperature changes [degC H2 ~> degC m2 or degC kg2 m-4]. - real :: dS_c ! The core term in the expressions for the salinity changes [psu H2 ~> psu m2 or psu kg2 m-4]. + real :: dT_c ! The core term in the expressions for the temperature changes [C H2 ~> degC m2 or degC kg2 m-4]. + real :: dS_c ! The core term in the expressions for the salinity changes [S H2 ~> psu m2 or psu kg2 m-4]. real :: PEc_core ! The diffusivity-independent core term in the expressions ! for the potential energy changes [R L2 T-2 ~> J m-3]. real :: ColHt_core ! The diffusivity-independent core term in the expressions @@ -1120,48 +1122,48 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! is a fraction (determined from the tridiagonal solver) of !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: dTe_term !< A diffusivity-independent term related to the temperature change - !! in the layer below the interface [degC H ~> degC m or degC kg m-2]. + !! in the layer below the interface [C H ~> degC m or degC kg m-2]. real, intent(in) :: dSe_term !< A diffusivity-independent term related to the salinity change - !! in the layer below the interface [ppt H ~> ppt m or ppt kg m-2]. + !! in the layer below the interface [S H ~> ppt m or ppt kg m-2]. real, intent(in) :: dT_km1_t2 !< A diffusivity-independent term related to the - !! temperature change in the layer above the interface [degC]. + !! temperature change in the layer above the interface [C ~> degC]. real, intent(in) :: dS_km1_t2 !< A diffusivity-independent term related to the - !! salinity change in the layer above the interface [ppt]. + !! salinity change in the layer above the interface [S ~> ppt]. real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [R L2 T-2 ~> J m-3]. real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below [R Z L2 T-2 degC-1 ~> J m-2 degC-1]. + !! in the temperatures of all the layers below [R Z L2 T-2 C-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. + !! in the salinities of all the layers below [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above [R Z L2 T-2 degC-1 ~> J m-2 degC-1]. + !! in the temperatures of all the layers above [R Z L2 T-2 C-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. + !! in the salinities of all the layers above [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below [Z degC-1 ~> m degC-1]. + !! in the temperatures of all the layers below [Z C-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. + !! in the salinities of all the layers below [Z S-1 ~> m ppt-1]. real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above [Z degC-1 ~> m degC-1]. + !! in the temperatures of all the layers above [Z C-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. + !! in the salinities of all the layers above [Z S-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface [R Z L2 T-2 ~> J m-2]. @@ -1187,14 +1189,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real :: ColHt_chg ! The change in column thickness [Z ~> m]. real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> nondim or m3 kg-1] - real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [degC] - real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [ppt] + real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [C ~> degC] + real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [S ~> ppt] real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2] real :: dKr_dKd ! Temporary array [H-2 ~> m-2 or m4 kg-2] real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays indicating the temperature changes - ! per unit change in Kddt_h [degC H-1 ~> degC m-1 or degC m2 kg-1] + ! per unit change in Kddt_h [C H-1 ~> degC m-1 or degC m2 kg-1] real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays indicating the salinity changes - ! per unit change in Kddt_h [ppt H-1 ~> ppt m-1 or ppt m2 kg-1] + ! per unit change in Kddt_h [S H-1 ~> ppt m-1 or ppt m2 kg-1] b1 = 1.0 / (b_den_1 + Kddt_h) b1Kd = Kddt_h*b1 @@ -1327,13 +1329,13 @@ subroutine diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS) "Column Height Correction to Energy Requirements, halves", & "J m-2", conversion=US%RZ_to_kg_m2*US%L_T_to_m_s**2) CS%id_T0 = register_diag_field('ocean_model', 'EnReqTest_T0', diag%axesZL, Time, & - "Temperature before mixing", "deg C") + "Temperature before mixing", "deg C", conversion=US%C_to_degC) CS%id_Tf = register_diag_field('ocean_model', 'EnReqTest_Tf', diag%axesZL, Time, & - "Temperature after mixing", "deg C") + "Temperature after mixing", "deg C", conversion=US%C_to_degC) CS%id_S0 = register_diag_field('ocean_model', 'EnReqTest_S0', diag%axesZL, Time, & - "Salinity before mixing", "g kg-1") + "Salinity before mixing", "g kg-1", conversion=US%S_to_ppt) CS%id_Sf = register_diag_field('ocean_model', 'EnReqTest_Sf', diag%axesZL, Time, & - "Salinity after mixing", "g kg-1") + "Salinity after mixing", "g kg-1", conversion=US%S_to_ppt) CS%id_N2_0 = register_diag_field('ocean_model', 'EnReqTest_N2_0', diag%axesZi, Time, & "Squared buoyancy frequency before mixing", "second-2", conversion=US%s_to_T**2) CS%id_N2_f = register_diag_field('ocean_model', 'EnReqTest_N2_f', diag%axesZi, Time, & diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 45b21eb1ab..3791ad26aa 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -133,12 +133,12 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) e_filt, e_2d ! The interface depths [H ~> m or kg m-2], positive upward. real, dimension(SZI_(G),SZK_(GV)) :: & h_2d, & ! A 2-d version of h [H ~> m or kg m-2]. - T_2d, & ! A 2-d version of tv%T [degC]. - S_2d, & ! A 2-d version of tv%S [ppt]. + T_2d, & ! A 2-d version of tv%T [C ~> degC]. + S_2d, & ! A 2-d version of tv%S [S ~> ppt]. Rcv, & ! A 2-d version of the coordinate density [R ~> kg m-3]. h_2d_init, & ! The initial value of h_2d [H ~> m or kg m-2]. - T_2d_init, & ! THe initial value of T_2d [degC]. - S_2d_init, & ! The initial value of S_2d [ppt]. + T_2d_init, & ! THe initial value of T_2d [C ~> degC]. + S_2d_init, & ! The initial value of S_2d [S ~> ppt]. d_eb, & ! The downward increase across a layer in the entrainment from ! below [H ~> m or kg m-2]. The sign convention is that positive values of ! d_eb correspond to a gain in mass by a layer by upward motion. @@ -164,7 +164,9 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real, dimension(SZK_(GV)+1) :: & - int_flux, int_Tflux, int_Sflux, int_Rflux + int_flux, & ! Mass flux across the interfaces [H ~> m or kg m-2] + int_Tflux, & ! Temperature flux across the interfaces [C H ~> degC m or degC kg m-2] + int_Sflux ! Salinity flux across the interfaces [S H ~> ppt m or ppt kg m-2] real :: h_add real :: h_det_tot real :: max_def_rat @@ -466,7 +468,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) k1 = 1 ; k2 = 1 int_top = 0.0 do k=1,nkmb+1 - int_flux(k) = 0.0 ; int_Rflux(k) = 0.0 + int_flux(k) = 0.0 int_Tflux(k) = 0.0 ; int_Sflux(k) = 0.0 enddo do k=1,2*nkmb diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index fd7335fd0a..20f92af86b 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -243,7 +243,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i type(diffusivity_diags) :: dd ! structure with arrays of available diags real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - T_f, S_f ! Temperature and salinity [degC] and [ppt] with properties in massless layers + T_f, S_f ! Temperature and salinity [C ~> degC] and [S ~> ppt] with properties in massless layers ! filled vertically by diffusion or the properties after full convective adjustment. real, dimension(SZI_(G),SZK_(GV)) :: & @@ -375,14 +375,14 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i ! Smooth the properties through massless layers. if (use_EOS) then if (CS%debug) then - call hchksum(tv%T, "before vert_fill_TS tv%T",G%HI) - call hchksum(tv%S, "before vert_fill_TS tv%S",G%HI) + call hchksum(tv%T, "before vert_fill_TS tv%T", G%HI, scale=US%C_to_degC) + call hchksum(tv%S, "before vert_fill_TS tv%S", G%HI, scale=US%S_to_ppt) call hchksum(h, "before vert_fill_TS h",G%HI, scale=GV%H_to_m) endif call vert_fill_TS(h, tv%T, tv%S, kappa_dt_fill, T_f, S_f, G, GV, larger_h_denom=.true.) if (CS%debug) then - call hchksum(tv%T, "after vert_fill_TS tv%T",G%HI) - call hchksum(tv%S, "after vert_fill_TS tv%S",G%HI) + call hchksum(tv%T, "after vert_fill_TS tv%T", G%HI, scale=US%C_to_degC) + call hchksum(tv%S, "after vert_fill_TS tv%S", G%HI, scale=US%S_to_ppt) call hchksum(h, "after vert_fill_TS h",G%HI, scale=GV%H_to_m) endif endif @@ -877,10 +877,10 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & !! thermodynamic fields. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: T_f !< layer temperature with the values in massless layers - !! filled vertically by diffusion [degC]. + !! filled vertically by diffusion [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: S_f !< Layer salinities with values in massless - !! layers filled vertically by diffusion [ppt]. + !! layers filled vertically by diffusion [S ~> ppt]. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes integer, intent(in) :: j !< j-index of row to work on type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure @@ -895,13 +895,13 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & ! Local variables real, dimension(SZI_(G),SZK_(GV)+1) :: & dRho_int_unfilt, & ! unfiltered density differences across interfaces [R ~> kg m-3] - dRho_dT, & ! partial derivative of density wrt temp [R degC-1 ~> kg m-3 degC-1] - dRho_dS ! partial derivative of density wrt saln [R ppt-1 ~> kg m-3 ppt-1] + dRho_dT, & ! partial derivative of density wrt temp [R C-1 ~> kg m-3 degC-1] + dRho_dS ! partial derivative of density wrt saln [R S-1 ~> kg m-3 ppt-1] real, dimension(SZI_(G)) :: & pres, & ! pressure at each interface [R L2 T-2 ~> Pa] - Temp_int, & ! temperature at each interface [degC] - Salin_int, & ! salinity at each interface [ppt] + Temp_int, & ! temperature at each interface [C ~>degC] + Salin_int, & ! salinity at each interface [S ~> ppt] drho_bot, & ! A density difference [R ~> kg m-3] h_amp, & ! The topographic roughness amplitude [Z ~> m]. hb, & ! The thickness of the bottom layer [Z ~> m]. @@ -1047,10 +1047,10 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: T_f !< layer temperatures with the values in massless layers - !! filled vertically by diffusion [degC]. + !! filled vertically by diffusion [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: S_f !< Layer salinities with values in massless - !! layers filled vertically by diffusion [ppt]. + !! layers filled vertically by diffusion [S ~> ppt]. integer, intent(in) :: j !< Meridional index upon which to work. type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZK_(GV)+1), & @@ -1061,11 +1061,11 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) !! diffusivity for saln [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G)) :: & - dRho_dT, & ! partial derivatives of density wrt temp [R degC-1 ~> kg m-3 degC-1] - dRho_dS, & ! partial derivatives of density wrt saln [R ppt-1 ~> kg m-3 ppt-1] + dRho_dT, & ! partial derivatives of density wrt temp [R C-1 ~> kg m-3 degC-1] + dRho_dS, & ! partial derivatives of density wrt saln [R S-1 ~> kg m-3 ppt-1] pres, & ! pressure at each interface [R L2 T-2 ~> Pa] - Temp_int, & ! temperature at interfaces [degC] - Salin_int ! Salinity at interfaces [ppt] + Temp_int, & ! temperature at interfaces [C ~> degC] + Salin_int ! Salinity at interfaces [S ~> ppt] real :: alpha_dT ! density difference between layers due to temp diffs [R ~> kg m-3] real :: beta_dS ! density difference between layers due to saln diffs [R ~> kg m-3] diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 761a77b399..7934b6b019 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -139,13 +139,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real, dimension(SZIB_(G)) :: & ustar, & ! The bottom friction velocity [Z T-1 ~> m s-1]. T_EOS, & ! The temperature used to calculate the partial derivatives - ! of density with T and S [degC]. + ! of density with T and S [C ~> degC]. S_EOS, & ! The salinity used to calculate the partial derivatives - ! of density with T and S [ppt]. + ! of density with T and S [S ~> ppt]. dR_dT, & ! Partial derivative of the density in the bottom boundary - ! layer with temperature [R degC-1 ~> kg m-3 degC-1]. + ! layer with temperature [R C-1 ~> kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density in the bottom boundary - ! layer with salinity [R ppt-1 ~> kg m-3 ppt-1]. + ! layer with salinity [R S-1 ~> kg m-3 ppt-1]. press ! The pressure at which dR_dT and dR_dS are evaluated [R L2 T-2 ~> Pa]. real :: htot ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. @@ -167,9 +167,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) h_vel, & ! Arithmetic mean of the layer thicknesses adjacent to a ! velocity point [H ~> m or kg m-2]. T_vel, & ! Arithmetic mean of the layer temperatures adjacent to a - ! velocity point [degC]. + ! velocity point [C ~> degC]. S_vel, & ! Arithmetic mean of the layer salinities adjacent to a - ! velocity point [ppt]. + ! velocity point [S ~> ppt]. Rml_vel ! Arithmetic mean of the layer coordinate densities adjacent ! to a velocity point [R ~> kg m-3]. @@ -201,8 +201,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the ! velocity magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1]. - real :: Thtot ! Running sum of thickness times temperature [degC H ~> degC m or degC kg m-2]. - real :: Shtot ! Running sum of thickness times salinity [ppt H ~> ppt m or ppt kg m-2]. + real :: 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 :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. real :: v_at_u, u_at_v ! v at a u point or vice versa [L T-1 ~> m s-1]. @@ -294,8 +294,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) if (CS%debug) then call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) call hchksum(h,"Start set_viscous_BBL h", G%HI, haloshift=1, scale=GV%H_to_m) - if (associated(tv%T)) call hchksum(tv%T, "Start set_viscous_BBL T", G%HI, haloshift=1) - if (associated(tv%S)) call hchksum(tv%S, "Start set_viscous_BBL S", G%HI, haloshift=1) + if (associated(tv%T)) call hchksum(tv%T, "Start set_viscous_BBL T", G%HI, haloshift=1, scale=US%C_to_degC) + if (associated(tv%S)) call hchksum(tv%S, "Start set_viscous_BBL S", G%HI, haloshift=1, scale=US%S_to_ppt) endif use_BBL_EOS = associated(tv%eqn_of_state) .and. CS%BBL_use_EOS @@ -1157,9 +1157,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) htot, & ! The total depth of the layers being that are within the ! surface mixed layer [H ~> m or kg m-2]. Thtot, & ! The integrated temperature of layers that are within the - ! surface mixed layer [H degC ~> m degC or kg degC m-2]. + ! 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 ppt ~> m ppt or kg ppt m-2]. + ! surface mixed layer [H S ~> m ppt or kg ppt m-2]. 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. @@ -1167,13 +1167,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) vhtot, & ! the surface mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. dR_dT, & ! Partial derivative of the density at the base of layer nkml - ! (roughly the base of the mixed layer) with temperature [R degC-1 ~> kg m-3 degC-1]. + ! (roughly the base of the mixed layer) with temperature [R C-1 ~> kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density at the base of layer nkml - ! (roughly the base of the mixed layer) with salinity [R ppt-1 ~> kg m-3 ppt-1]. + ! (roughly the base of the mixed layer) with salinity [R S-1 ~> kg m-3 ppt-1]. ustar, & ! The surface friction velocity under ice shelves [Z T-1 ~> m s-1]. press, & ! The pressure at which dR_dT and dR_dS are evaluated [R L2 T-2 ~> Pa]. - T_EOS, & ! The potential temperature at which dR_dT and dR_dS are evaluated [degC] - S_EOS ! The salinity at which dR_dT and dR_dS are evaluated [ppt]. + T_EOS, & ! The potential temperature at which dR_dT and dR_dS are evaluated [C ~> degC] + S_EOS ! The salinity at which dR_dT and dR_dS are evaluated [S ~> ppt]. real, dimension(SZIB_(G),SZJ_(G)) :: & mask_u ! A mask that disables any contributions from u points that ! are land or past open boundary conditions [nondim], 0 or 1. @@ -1201,8 +1201,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) real :: hlay ! The layer thickness at velocity points [H ~> m or kg m-2]. real :: I_2hlay ! 1 / 2*hlay [H-1 ~> m-1 or m2 kg-1]. - real :: T_lay ! The layer temperature at velocity points [degC]. - real :: S_lay ! The layer salinity at velocity points [ppt]. + real :: T_lay ! The layer temperature at velocity points [C ~> degC]. + real :: S_lay ! The layer salinity at velocity points [S ~> ppt]. real :: Rlay ! The layer potential density at velocity points [R ~> kg m-3]. real :: Rlb ! The potential density of the layer below [R ~> kg m-3]. real :: v_at_u ! The meridonal velocity at a zonal velocity point [L T-1 ~> m s-1]. diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 5eb286ce7d..e454a9a4bb 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -495,25 +495,26 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, surface_field(i,j) = tv%S(i,j,1) dz_ml(i,j) = US%Z_to_m * Hml(i,j) enddo ; enddo - sosga = global_area_mean(surface_field, G) + sosga = global_area_mean(surface_field, G, scale=US%S_to_ppt) ! !Calculate tendencies (i.e., field changes at dt) from the sources / sinks ! if ((G%US%L_to_m == 1.0) .and. (G%US%s_to_T == 1.0) .and. (G%US%Z_to_m == 1.0) .and. & - (G%US%Q_to_J_kg == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0)) then + (G%US%Q_to_J_kg == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0) .and. & + (US%C_to_degC == 1.0) .and. (US%S_to_ppt == 1.0)) then ! Avoid unnecessary copies when no unit conversion is needed. call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & G%areaT, get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & internal_heat=tv%internal_heat, frunoff=fluxes%frunoff, sosga=sosga) else - call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & + call generic_tracer_source(US%C_to_degC*tv%T, US%S_to_ppt*tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & G%US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, & sw_pen_band=G%US%QRZ_T_to_W_m2*optics%sw_pen_band(:,:,:), & opacity_band=G%US%m_to_Z*optics%opacity_band(:,:,:,:), & - internal_heat=G%US%RZ_to_kg_m2*tv%internal_heat(:,:), & + internal_heat=G%US%RZ_to_kg_m2*US%C_to_degC*tv%internal_heat(:,:), & frunoff=G%US%RZ_T_to_kg_m2s*fluxes%frunoff(:,:), sosga=sosga) endif From 6d78d2b0a5a380801b424331e10878617142475d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 May 2022 19:54:16 -0400 Subject: [PATCH 15/68] +Add rescaling for temperature and salinity (2) This commit completes the dimensional rescaling for temperature and salinity, and it has been confirmed that the solutions for the existing test cases pass these tests. There are new unit_scale_type arguments to several publicly visible interfaces, mostly related to temperature initialization. There is also a new optional argument, conc_scale to the register_tracer calls to specify the conversion that should be done to tracer concentrations during output. Additionally, there are new entries in the incorrect units on some runtime parameters for user code were corrected in the MOM_parameter_doc files for some test cases. All answers are bitwise identical in the MOM6 regression suite, including when the temperature and salinity rescaling are enabled. --- src/core/MOM.F90 | 99 ++++----- src/core/MOM_forcing_type.F90 | 68 +++---- src/core/MOM_open_boundary.F90 | 115 +++++++---- src/core/MOM_variables.F90 | 33 ++- src/diagnostics/MOM_sum_output.F90 | 14 +- src/equation_of_state/MOM_EOS.F90 | 8 +- src/ice_shelf/MOM_ice_shelf.F90 | 14 +- .../MOM_coord_initialization.F90 | 42 ++-- .../MOM_state_initialization.F90 | 189 +++++++++--------- src/ocean_data_assim/MOM_oda_driver.F90 | 44 ++-- .../vertical/MOM_bulk_mixed_layer.F90 | 122 +++++------ .../vertical/MOM_geothermal.F90 | 42 ++-- .../vertical/MOM_opacity.F90 | 28 +-- src/tracer/MOM_offline_aux.F90 | 16 +- src/tracer/MOM_offline_main.F90 | 26 +-- src/tracer/MOM_tracer_Z_init.F90 | 92 +++++---- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/tracer/MOM_tracer_registry.F90 | 49 +++-- src/tracer/oil_tracer.F90 | 3 +- src/tracer/pseudo_salt_tracer.F90 | 11 +- src/user/DOME2d_initialization.F90 | 59 +++--- src/user/DOME_initialization.F90 | 18 +- src/user/ISOMIP_initialization.F90 | 127 +++++++----- src/user/RGC_initialization.F90 | 8 +- src/user/Rossby_front_2d_initialization.F90 | 15 +- src/user/SCM_CVMix_tests.F90 | 32 +-- src/user/adjustment_initialization.F90 | 64 +++--- src/user/baroclinic_zone_initialization.F90 | 46 +++-- src/user/benchmark_initialization.F90 | 32 +-- src/user/dense_water_initialization.F90 | 25 +-- src/user/dumbbell_initialization.F90 | 32 +-- src/user/seamount_initialization.F90 | 29 ++- src/user/sloshing_initialization.F90 | 23 ++- 33 files changed, 829 insertions(+), 698 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 56e661f678..92434c0039 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -181,7 +181,7 @@ module MOM type, public :: MOM_control_struct ; private real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: & h, & !< layer thickness [H ~> m or kg m-2] - T, & !< potential temperature [degC] + T, & !< potential temperature [C ~> degC] S !< salinity [ppt] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & u, & !< zonal velocity component [L T-1 ~> m s-1] @@ -1231,12 +1231,12 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) call hchksum(h,"Pre-advection h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-advection uhtr", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) - if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1) - if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1) + if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1, scale=US%C_to_degC) + if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1, scale=US%S_to_ppt) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, "Pre-advection frazil", G%HI, haloshift=0, & scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(CS%tv%salt_deficit)) call hchksum(CS%tv%salt_deficit, & - "Pre-advection salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) + "Pre-advection salt deficit", G%HI, haloshift=0, scale=US%S_to_ppt*US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G, US) call cpu_clock_end(id_clock_other) endif @@ -1415,8 +1415,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (CS%debug) then call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) - call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1) - call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1) + call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1, scale=US%C_to_degC) + call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1, scale=US%S_to_ppt) call check_redundant("Pre-ALE ", u, v, G) endif call cpu_clock_begin(id_clock_ALE) @@ -1442,8 +1442,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (CS%debug .and. CS%use_ALE_algorithm) then call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) - call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1) - call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1) + call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1, scale=US%C_to_degC) + call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1, scale=US%S_to_ppt) call check_redundant("Post-ALE ", u, v, G) endif @@ -1462,8 +1462,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Post-diabatic ", u, v, & ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) - if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) - if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1) + if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1, scale=US%C_to_degC) + if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1, scale=US%S_to_ppt) if (associated(tv%frazil)) call hchksum(tv%frazil, "Post-diabatic frazil", G%HI, haloshift=0, & scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, & @@ -1486,8 +1486,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call create_group_pass(pass_T_S, tv%S, G%Domain, To_All+Omit_Corners, halo=1) call do_group_pass(pass_T_S, G%Domain, clock=id_clock_pass) if (CS%debug) then - if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) - if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1) + if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1, scale=US%C_to_degC) + if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1, scale=US%S_to_ppt) endif endif @@ -1746,8 +1746,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! by an ice shelf [nondim] real, allocatable, target :: mass_shelf_in(:,:) ! Initial mass of ice shelf contained within a grid cell ! [R Z ~> kg m-2] - real, allocatable, target :: T_in(:,:,:) ! Initial temperatures [degC] - real, allocatable, target :: S_in(:,:,:) ! Initial salinities [ppt] + real, allocatable, target :: T_in(:,:,:) ! Initial temperatures [C ~> degC] + real, allocatable, target :: S_in(:,:,:) ! Initial salinities [S ~> ppt] type(ocean_OBC_type), pointer :: OBC_in => NULL() type(sponge_CS), pointer :: sponge_in_CSp => NULL() @@ -2025,13 +2025,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "drive the salinity negative otherwise.)", default=.false.) call get_param(param_file, "MOM", "MIN_SALINITY", CS%tv%min_salinity, & "The minimum value of salinity when BOUND_SALINITY=True.", & - units="PPT", default=0.0, do_not_log=.not.bound_salinity) + units="PPT", default=0.0, scale=US%ppt_to_S, do_not_log=.not.bound_salinity) call get_param(param_file, "MOM", "C_P", CS%tv%C_p, & "The heat capacity of sea water, approximated as a "//& "constant. This is only used if ENABLE_THERMODYNAMICS is "//& "true. The default value is from the TEOS-10 definition "//& "of conservative temperature.", units="J kg-1 K-1", & - default=3991.86795711963, scale=US%J_kg_to_Q) + default=3991.86795711963, scale=US%J_kg_to_Q*US%C_to_degC) call get_param(param_file, "MOM", "USE_PSURF_IN_EOS", CS%use_p_surf_in_EOS, & "If true, always include the surface pressure contributions "//& "in equation of state calculations.", default=.true.) @@ -2309,31 +2309,31 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%tv%S_is_absS) then vd_S = var_desc(name="abssalt", units="g kg-1", longname="Absolute Salinity", & cmor_field_name="so", cmor_longname="Sea Water Salinity", & - conversion=0.001) + conversion=0.001*US%S_to_ppt) else vd_S = var_desc(name="salt", units="psu", longname="Salinity", & cmor_field_name="so", cmor_longname="Sea Water Salinity", & - conversion=0.001) + conversion=0.001*US%S_to_ppt) endif if (advect_TS) then S_flux_units = get_tr_flux_units(GV, "psu") ! Could change to "kg m-2 s-1"? conv2watt = GV%H_to_kg_m2 * US%Q_to_J_kg*CS%tv%C_p if (GV%Boussinesq) then - conv2salt = GV%H_to_m ! Could change to GV%H_to_kg_m2 * 0.001? + conv2salt = US%S_to_ppt*GV%H_to_m ! Could change to US%S_to_ppt*GV%H_to_kg_m2 * 0.001? else - conv2salt = GV%H_to_kg_m2 + conv2salt = US%S_to_ppt*GV%H_to_kg_m2 endif call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, HI, GV, & - tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', & - flux_units='W', flux_longname='Heat', & + tr_desc=vd_T, registry_diags=.true., conc_scale=US%C_to_degC, & + flux_nameroot='T', flux_units='W', flux_longname='Heat', & flux_scale=conv2watt, convergence_units='W m-2', & convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2) call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, HI, GV, & - tr_desc=vd_S, registry_diags=.true., flux_nameroot='S', & - flux_units=S_flux_units, flux_longname='Salt', & + tr_desc=vd_S, registry_diags=.true., conc_scale=US%S_to_ppt, & + flux_nameroot='S', flux_units=S_flux_units, flux_longname='Salt', & flux_scale=conv2salt, convergence_units='kg m-2 s-1', & - convergence_scale=0.001*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2) + convergence_scale=0.001*US%S_to_ppt*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2) endif endif @@ -2443,7 +2443,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! ! While incorrect and potentially dangerous, it does not seem that this ! pointer is used during initialization, so we leave it for now. - call register_temp_salt_segments(GV, OBC_in, CS%tracer_Reg, param_file) + call register_temp_salt_segments(GV, US, OBC_in, CS%tracer_Reg, param_file) endif if (associated(CS%OBC)) then @@ -2454,7 +2454,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! This is the equivalent to 2 calls to register_segment_tracer (per segment), which ! could occur with the call to update_OBC_data or after the main initialization. if (use_temperature) & - call register_temp_salt_segments(GV, CS%OBC, CS%tracer_Reg, param_file) + call register_temp_salt_segments(GV, US, CS%OBC, CS%tracer_Reg, param_file) ! This needs the number of tracers and to have called any code that sets whether ! reservoirs are used. @@ -2923,7 +2923,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & (LEN_TRIM(dirs%input_filename) == 1)) if (CS%ensemble_ocean) then - call init_oda(Time, G, GV, CS%diag, CS%odaCS) + call init_oda(Time, G, GV, US, CS%diag, CS%odaCS) endif ! initialize stochastic physics @@ -3077,10 +3077,10 @@ subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp) if (associated(CS%tv%T)) & call register_restart_field(CS%tv%T, "Temp", .true., restart_CSp, & - "Potential Temperature", "degC") + "Potential Temperature", "degC", conversion=US%C_to_degC) if (associated(CS%tv%S)) & call register_restart_field(CS%tv%S, "Salt", .true., restart_CSp, & - "Salinity", "PPT") + "Salinity", "PPT", conversion=US%S_to_ppt) call register_restart_field(CS%h, "h", .true., restart_CSp, & "Layer Thickness", thickness_units, conversion=GV%H_to_MKS) @@ -3199,9 +3199,9 @@ subroutine extract_surface_state(CS, sfc_state_in) real :: H_rescale !< A conversion factor from thickness units to the units used in the !! calculation of properties of the uppermost ocean [nondim] or [Z H-1 ~> 1 or m3 kg-1] ! After the ANSWERS_2018 flag has been obsoleted, H_rescale will be 1. - real :: T_freeze(SZI_(CS%G)) !< freezing temperature [C] + real :: T_freeze(SZI_(CS%G)) !< freezing temperature [C ~> degC] real :: pres(SZI_(CS%G)) !< Pressure to use for the freezing temperature calculation [R L2 T-2 ~> Pa] - real :: delT(SZI_(CS%G)) !< Depth integral of T-T_freeze [Z degC ~> m degC] + real :: delT(SZI_(CS%G)) !< Depth integral of T-T_freeze [Z C ~> m degC] logical :: use_temperature !< If true, temperature and salinity are used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors, ig, jg integer :: isd, ied, jsd, jed @@ -3265,8 +3265,8 @@ subroutine extract_surface_state(CS, sfc_state_in) if (CS%Hmix < 0.0) then ! A bulk mixed layer is in use, so layer 1 has the properties if (use_temperature) then ; do j=js,je ; do i=is,ie - sfc_state%SST(i,j) = CS%tv%T(i,j,1) - sfc_state%SSS(i,j) = CS%tv%S(i,j,1) + sfc_state%SST(i,j) = US%C_to_degC*CS%tv%T(i,j,1) + sfc_state%SSS(i,j) = US%S_to_ppt*CS%tv%S(i,j,1) enddo ; enddo ; endif do j=js,je ; do I=is-1,ie sfc_state%u(I,j) = CS%u(I,j,1) @@ -3301,8 +3301,8 @@ subroutine extract_surface_state(CS, sfc_state_in) dh = 0.0 endif if (use_temperature) then - sfc_state%SST(i,j) = sfc_state%SST(i,j) + dh * CS%tv%T(i,j,k) - sfc_state%SSS(i,j) = sfc_state%SSS(i,j) + dh * CS%tv%S(i,j,k) + sfc_state%SST(i,j) = sfc_state%SST(i,j) + dh * US%C_to_degC*CS%tv%T(i,j,k) + sfc_state%SSS(i,j) = sfc_state%SSS(i,j) + dh * US%S_to_ppt*CS%tv%S(i,j,k) else sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) + dh * GV%Rlay(k) endif @@ -3324,8 +3324,8 @@ subroutine extract_surface_state(CS, sfc_state_in) I_depth = 1.0 / (GV%H_subroundoff*H_rescale) missing_depth = GV%H_subroundoff*H_rescale - depth(i) if (use_temperature) then - sfc_state%SST(i,j) = (sfc_state%SST(i,j) + missing_depth*CS%tv%T(i,j,1)) * I_depth - sfc_state%SSS(i,j) = (sfc_state%SSS(i,j) + missing_depth*CS%tv%S(i,j,1)) * I_depth + sfc_state%SST(i,j) = (sfc_state%SST(i,j) + missing_depth*US%C_to_degC*CS%tv%T(i,j,1)) * I_depth + sfc_state%SSS(i,j) = (sfc_state%SSS(i,j) + missing_depth*US%S_to_ppt*CS%tv%S(i,j,1)) * I_depth else sfc_state%sfc_density(i,j) = (sfc_state%sfc_density(i,j) + & missing_depth*GV%Rlay(1)) * I_depth @@ -3457,19 +3457,19 @@ subroutine extract_surface_state(CS, sfc_state_in) !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ! Convert from gSalt to kgSalt - sfc_state%salt_deficit(i,j) = 0.001 * CS%tv%salt_deficit(i,j) + sfc_state%salt_deficit(i,j) = 0.001 * US%S_to_ppt*CS%tv%salt_deficit(i,j) enddo ; enddo endif if (allocated(sfc_state%TempxPmE) .and. associated(CS%tv%TempxPmE)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - sfc_state%TempxPmE(i,j) = CS%tv%TempxPmE(i,j) + sfc_state%TempxPmE(i,j) = US%C_to_degC*CS%tv%TempxPmE(i,j) enddo ; enddo endif if (allocated(sfc_state%internal_heat) .and. associated(CS%tv%internal_heat)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - sfc_state%internal_heat(i,j) = CS%tv%internal_heat(i,j) + sfc_state%internal_heat(i,j) = US%C_to_degC*CS%tv%internal_heat(i,j) enddo ; enddo endif if (allocated(sfc_state%taux_shelf) .and. associated(CS%visc%taux_shelf)) then @@ -3496,8 +3496,8 @@ subroutine extract_surface_state(CS, sfc_state_in) do j=js,je ; do k=1,nz ; do i=is,ie mass = GV%H_to_RZ*h(i,j,k) sfc_state%ocean_mass(i,j) = sfc_state%ocean_mass(i,j) + mass - sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass * CS%tv%T(i,j,k) - sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + mass * (1.0e-3*CS%tv%S(i,j,k)) + sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass * US%C_to_degC*CS%tv%T(i,j,k) + sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + mass * (1.0e-3*US%S_to_ppt*CS%tv%S(i,j,k)) enddo ; enddo ; enddo else if (allocated(sfc_state%ocean_mass)) then @@ -3514,7 +3514,7 @@ subroutine extract_surface_state(CS, sfc_state_in) !$OMP parallel do default(shared) private(mass) do j=js,je ; do k=1,nz ; do i=is,ie mass = GV%H_to_RZ*h(i,j,k) - sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass*CS%tv%T(i,j,k) + sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass*US%C_to_degC*CS%tv%T(i,j,k) enddo ; enddo ; enddo endif if (allocated(sfc_state%ocean_salt)) then @@ -3523,7 +3523,7 @@ subroutine extract_surface_state(CS, sfc_state_in) !$OMP parallel do default(shared) private(mass) do j=js,je ; do k=1,nz ; do i=is,ie mass = GV%H_to_RZ*h(i,j,k) - sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + mass * (1.0e-3*CS%tv%S(i,j,k)) + sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + mass * (1.0e-3*US%S_to_ppt*CS%tv%S(i,j,k)) enddo ; enddo ; enddo endif endif @@ -3653,8 +3653,8 @@ subroutine get_MOM_state_elements(CS, G, GV, US, C_p, C_p_scaled, use_temp) if (present(G)) G => CS%G_in if (present(GV)) GV => CS%GV if (present(US)) US => CS%US - if (present(C_p)) C_p = CS%US%Q_to_J_kg * CS%tv%C_p - if (present(C_p_scaled)) C_p_scaled = CS%tv%C_p + if (present(C_p)) C_p = CS%US%Q_to_J_kg*US%degC_to_C * CS%tv%C_p + if (present(C_p_scaled)) C_p_scaled = US%degC_to_C*CS%tv%C_p if (present(use_temp)) use_temp = associated(CS%tv%T) end subroutine get_MOM_state_elements @@ -3669,9 +3669,10 @@ subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only) if (present(mass)) & mass = global_mass_integral(CS%h, CS%G, CS%GV, on_PE_only=on_PE_only) if (present(heat)) & - heat = CS%US%Q_to_J_kg*CS%tv%C_p * global_mass_integral(CS%h, CS%G, CS%GV, CS%tv%T, on_PE_only=on_PE_only) + heat = CS%US%Q_to_J_kg*CS%tv%C_p * & + global_mass_integral(CS%h, CS%G, CS%GV, CS%tv%T, on_PE_only=on_PE_only, tmp_scale=CS%US%C_to_degC) if (present(salt)) & - salt = 1.0e-3 * global_mass_integral(CS%h, CS%G, CS%GV, CS%tv%S, on_PE_only=on_PE_only) + salt = 1.0e-3 * global_mass_integral(CS%h, CS%G, CS%GV, CS%tv%S, on_PE_only=on_PE_only, scale=CS%US%S_to_ppt) end subroutine get_ocean_stocks diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9f0ec02ed6..b8e5fe6c49 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -415,7 +415,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: T !< layer temperatures [degC] + intent(in) :: T !< layer temperatures [C ~> degC] real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water in/out of ocean over !! a time step [H ~> m or kg m-2] @@ -429,12 +429,12 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & !! (1) downwelling (penetrative) SW, !! (2) evaporation heat content, !! (since do not yet know evap temperature). - !! [degC H ~> degC m or degC kg m-2]. + !! [C H ~> degC m or degC kg m-2]. real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean !! accumulated over a time step - !! [ppt H ~> ppt m or ppt kg m-2]. + !! [S H ~> ppt m or ppt kg m-2]. real, dimension(max(1,nsw),G%isd:G%ied), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. - !! [degC H ~> degC m or degC kg m-2] + !! [C H ~> degC m or degC kg m-2] !! and array size nsw x SZI_(G), where !! nsw=number of SW bands in pen_SW_bnd. !! This heat flux is not part of net_heat. @@ -445,32 +445,32 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & logical, intent(in) :: aggregate_FW !< For determining how to aggregate forcing. real, dimension(SZI_(G)), & optional, intent(out) :: nonpenSW !< Non-penetrating SW used in net_heat - !! [degC H ~> degC m or degC kg m-2]. + !! [C H ~> degC m or degC kg m-2]. !! Summed over SW bands when diagnosing nonpenSW. real, dimension(SZI_(G)), & optional, intent(out) :: net_Heat_rate !< Rate of net surface heating - !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. + !! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]. real, dimension(SZI_(G)), & optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean - !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]. + !! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]. real, dimension(SZI_(G)), & optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean !! [H T-1 ~> m s-1 or kg m-2 s-1]. real, dimension(max(1,nsw),G%isd:G%ied), & optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating - !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. + !! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]. ! local real :: htot(SZI_(G)) ! total ocean depth [H ~> m or kg m-2] - real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW [degC H ~> degC m or degC kg m-2]. + real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW [C H ~> degC m or degC kg m-2]. real :: pen_sw_tot_rate(SZI_(G)) ! Summed rate of shortwave heating across bands - ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real :: Ih_limit ! inverse depth at which surface fluxes start to be limited ! or 0 for no limiting [H-1 ~> m-1 or m2 kg-1] real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth [nondim] - real :: I_Cp ! 1.0 / C_p [degC Q-1 ~> kg degC J-1] + real :: I_Cp ! 1.0 / C_p [C Q-1 ~> kg degC J-1] real :: I_Cp_Hconvert ! Unit conversion factors divided by the heat capacity - ! [degC H R-1 Z-1 Q-1 ~> degC m3 J-1 or kg degC J-1] + ! [C H R-1 Z-1 Q-1 ~> degC m3 J-1 or kg degC J-1] logical :: calculate_diags ! Indicate to calculate/update diagnostic arrays character(len=200) :: mesg integer :: is, ie, nz, i, k, n @@ -539,7 +539,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & scale = 1.0 ; if ((Ih_limit > 0.0) .and. (htot(i)*Ih_limit < 1.0)) scale = htot(i)*Ih_limit - ! Convert the penetrating shortwave forcing to (K * H) and reduce fluxes for shallow depths. + ! Convert the penetrating shortwave forcing to (C * H) and reduce fluxes for shallow depths. ! (H=m for Bouss, H=kg/m2 for non-Bouss) Pen_sw_tot(i) = 0.0 if (nsw >= 1) then @@ -705,7 +705,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & write(mesg,'("Penetrating shortwave of ",1pe17.10, & &" exceeds total shortwave of ",1pe17.10,& &" at ",1pg11.4,",E,",1pg11.4,"N.")') & - Pen_SW_tot(i), I_Cp_Hconvert*scale*dt * fluxes%sw(i,j), & + US%C_to_degC*Pen_SW_tot(i), US%C_to_degC*I_Cp_Hconvert*scale*dt * fluxes%sw(i,j), & G%geoLonT(i,j), G%geoLatT(i,j) call MOM_error(WARNING,mesg) endif @@ -729,9 +729,9 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! Boussinesq: (ppt * m) ! non-Bouss: (g/m^2) if (associated(fluxes%salt_flux)) then - Net_salt(i) = (scale * dt * (1000.0 * fluxes%salt_flux(i,j))) * GV%RZ_to_H + Net_salt(i) = (scale * dt * (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j))) * GV%RZ_to_H !Repeat above code for 'rate' term - if (do_NSR) Net_salt_rate(i) = (scale * 1. * (1000.0 * fluxes%salt_flux(i,j))) * GV%RZ_to_H + if (do_NSR) Net_salt_rate(i) = (scale * 1. * (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j))) * GV%RZ_to_H endif ! Diagnostics follow... @@ -870,7 +870,7 @@ subroutine extractFluxes2d(G, GV, US, fluxes, optics, nsw, dt, FluxRescaleDepth, 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),SZK_(GV)), & - intent(in) :: T !< layer temperatures [degC] + intent(in) :: T !< layer temperatures [C ~> degC] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water in/out of ocean over !! a time step [H ~> m or kg m-2] @@ -883,11 +883,11 @@ subroutine extractFluxes2d(G, GV, US, fluxes, optics, nsw, dt, FluxRescaleDepth, !! (1) downwelling (penetrative) SW, !! (2) evaporation heat content, !! (since do not yet know temperature of evap). - !! [degC H ~> degC m or degC kg m-2] + !! [C H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step [ppt H ~> ppt m or ppt kg m-2] + !! over a time step [S H ~> ppt m or ppt kg m-2] real, dimension(max(1,nsw),G%isd:G%ied,G%jsd:G%jed), intent(out) :: pen_SW_bnd !< penetrating SW flux, by frequency - !! band [degC H ~> degC m or degC kg m-2] with array + !! band [C H ~> degC m or degC kg m-2] with array !! size nsw x SZI_(G), where nsw=number of SW bands !! in pen_SW_bnd. This heat flux is not in net_heat. type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available @@ -921,29 +921,29 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt type(optics_type), pointer :: optics !< penetrating SW optics integer, intent(in) :: nsw !< The number of frequency bands of !! penetrating shortwave radiation - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Temp !< prognostic temp [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< salinity [ppt] + 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),SZK_(GV)), intent(in) :: Temp !< prognostic temp [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< salinity [S ~> ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type integer, intent(in) :: j !< j-row to work on real, dimension(SZI_(G),SZK_(GV)+1), intent(out) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] real, dimension(SZI_(G)), intent(out) :: netHeatMinusSW !< Surface heat flux excluding shortwave - !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + !! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)), intent(out) :: netSalt !< surface salt flux - !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + !! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] ! local variables real, dimension(SZI_(G)) :: netH ! net FW flux [H T-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G)) :: netEvap ! net FW flux leaving ocean via evaporation ! [H T-1 ~> m s-1 or kg m-2 s-1] - real, dimension(SZI_(G)) :: netHeat ! net temp flux [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + real, dimension(SZI_(G)) :: netHeat ! net temp flux [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)) :: pressure ! pressure at the surface [R L2 T-2 ~> Pa] - real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R degC-1 ~> kg m-3 degC-1] - real, dimension(SZI_(G)) :: dRhodS ! density partial derivative wrt saln [R ppt-1 ~> kg m-3 ppt-1] + real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R C-1 ~> kg m-3 degC-1] + real, dimension(SZI_(G)) :: dRhodS ! density partial derivative wrt saln [R S-1 ~> kg m-3 ppt-1] real, dimension(SZI_(G),SZK_(GV)+1) :: netPen ! The net penetrating shortwave radiation at each level - ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] logical :: useRiverHeatContent logical :: useCalvingHeatContent @@ -966,7 +966,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! We aggregate the thermodynamic forcing for a time step into the following: ! netH = water added/removed via surface fluxes [H T-1 ~> m s-1 or kg m-2 s-1] ! netHeat = heat via surface fluxes [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] - ! netSalt = salt via surface fluxes [ppt H T-1 ~> ppt m s-1 or gSalt m-2 s-1] + ! netSalt = salt via surface fluxes [S H T-1 ~> ppt m s-1 or gSalt m-2 s-1] ! Note that unlike other calls to extractFLuxes1d() that return the time-integrated flux ! this call returns the rate because dt=1 (in arbitrary time units) call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, 1.0, & @@ -1014,14 +1014,14 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, type(forcing), intent(inout) :: fluxes !< surface fluxes type(optics_type), pointer :: optics !< SW ocean optics 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),SZK_(GV)), intent(in) :: Temp !< temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Temp !< temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< salinity [S ~> ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: netHeatMinusSW !< surface heat flux excluding shortwave - !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + !! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: netSalt !< Net surface salt flux - !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + !! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] ! local variables integer :: j diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index bd05a4da7a..b449e7c9a5 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -80,21 +80,28 @@ module MOM_open_boundary integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk character(len=8) :: name !< a name identifier for the segment data real, allocatable :: buffer_src(:,:,:) !< buffer for segment data located at cell faces - !! and on the original vertical grid + !! and on the original vertical grid. The values for tracers should + !! have the same units as the field they are being applied to? integer :: nk_src !< Number of vertical levels in the source data real, allocatable :: dz_src(:,:,:) !< vertical grid cell spacing of the incoming segment !! data, set in [Z ~> m] then scaled to [H ~> m or kg m-2] - real, allocatable :: buffer_dst(:,:,:) !< buffer src data remapped to the target vertical grid - real :: value !< constant value if fid is equal to -1 + real, allocatable :: buffer_dst(:,:,:) !< buffer src data remapped to the target vertical grid. + !! The values for tracers should have the same units as the field + !! they are being applied to? + real :: value !< constant value if fid is equal to -1 end type OBC_segment_data_type !> Tracer on OBC segment data structure, for putting into a segment tracer registry. type, public :: OBC_segment_tracer_type - real, allocatable :: t(:,:,:) !< tracer concentration array + real, allocatable :: t(:,:,:) !< tracer concentration array in rescaled units, + !! like [S ~> ppt] for salinity. real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows character(len=32) :: name !< tracer name used for error messages type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer - real, allocatable :: tres(:,:,:) !< tracer reservoir array + real, allocatable :: tres(:,:,:) !< tracer reservoir array in rescaled units, + !! like [S ~> ppt] for salinity. + real :: scale !< A scaling factor for converting the units of input + !! data, like [S ppt-1 ~> 1] for salinity. logical :: is_initialized !< reservoir values have been set when True end type OBC_segment_tracer_type @@ -298,8 +305,8 @@ module MOM_open_boundary real, allocatable :: rx_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] real, allocatable :: ry_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] real, allocatable :: cff_normal(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - real, allocatable :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] - real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] + real, allocatable :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc] + real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc] real :: silly_h !< A silly value of thickness outside of the domain that can be used to test !! the independence of the OBCs to this external data [H ~> m or kg m-2]. real :: silly_u !< A silly value of velocity outside of the domain that can be used to test @@ -1993,6 +2000,8 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure type(OBC_segment_type), pointer :: segment => NULL() + 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 do n=1,OBC%number_of_segments @@ -2004,7 +2013,7 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed - OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%t(i,j,k) + OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%t(i,j,k) enddo enddo endif @@ -2012,10 +2021,11 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) else J = segment%HI%JsdB do m=1,OBC%ntr + I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do i=segment%HI%isd,segment%HI%ied - OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%t(i,J,k) + OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%t(i,J,k) enddo enddo endif @@ -2125,7 +2135,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed - segment%tr_Reg%Tr(m)%tres(I,j,k) = OBC%tres_x(I,j,k,m) + segment%tr_Reg%Tr(m)%tres(I,j,k) = segment%tr_Reg%Tr(m)%scale * OBC%tres_x(I,j,k,m) enddo enddo endif @@ -2136,7 +2146,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do i=segment%HI%isd,segment%HI%ied - segment%tr_Reg%Tr(m)%tres(i,J,k) = OBC%tres_y(i,J,k,m) + segment%tr_Reg%Tr(m)%tres(i,J,k) = segment%tr_Reg%Tr(m)%scale * OBC%tres_y(i,J,k,m) enddo enddo endif @@ -3796,7 +3806,9 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) tmp_buffer_in => tmp_buffer endif - call time_interp_external(segment%field(m)%fid,Time, tmp_buffer_in) + ! This is where the data values are actually read in. + call time_interp_external(segment%field(m)%fid, Time, tmp_buffer_in) + ! NOTE: Rotation of face-points require that we skip the final value if (turns /= 0) then ! TODO: This is hardcoded for 90 degrees, and needs to be generalized. @@ -3863,6 +3875,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) ! no dz for tidal variables if (segment%field(m)%nk_src > 1 .and.& (index(segment%field(m)%name, 'phase') <= 0 .and. index(segment%field(m)%name, 'amp') <= 0)) then + ! This is where the 2-d tidal data values are actually read in. call time_interp_external(segment%field(m)%fid_dz, Time, tmp_buffer_in) tmp_buffer_in(:,:,:) = tmp_buffer_in(:,:,:) * US%m_to_Z if (turns /= 0) then @@ -4230,7 +4243,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (trim(segment%field(m)%name) == 'TEMP') then if (allocated(segment%field(m)%buffer_dst)) then do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc - segment%tr_Reg%Tr(1)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) + segment%tr_Reg%Tr(1)%t(i,j,k) = segment%tr_Reg%Tr(1)%scale * segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo if (.not. segment%tr_Reg%Tr(1)%is_initialized) then ! if the tracer reservoir has not yet been initialized, then set to external value. @@ -4245,7 +4258,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) elseif (trim(segment%field(m)%name) == 'SALT') then if (allocated(segment%field(m)%buffer_dst)) then do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc - segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) + segment%tr_Reg%Tr(2)%t(i,j,k) = segment%tr_Reg%Tr(2)%scale * segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo if (.not. segment%tr_Reg%Tr(2)%is_initialized) then !if the tracer reservoir has not yet been initialized, then set to external value. @@ -4428,7 +4441,7 @@ end subroutine segment_tracer_registry_init !> Register a tracer array that is active on an OBC segment, potentially also specifying how the !! tracer inflow values are specified. subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & - OBC_scalar, OBC_array) + OBC_scalar, OBC_array, scale) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(tracer_type), target :: tr_ptr !< A target that can be used to set a pointer to the !! stored value of tr. This target must be @@ -4440,10 +4453,13 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values type(OBC_segment_type), intent(inout) :: segment !< current segment data structure real, optional, intent(in) :: OBC_scalar !< If present, use scalar value for segment tracer - !! inflow concentration. + !! inflow concentration, including any rescaling to + !! put the tracer concentration into its internal units. logical, optional, intent(in) :: OBC_array !< If true, use array values for segment tracer !! inflow concentration. - + real, optional, intent(in) :: scale !< A scaling factor that should be used with any + !! data that is read in, to convert it to the internal + !! units of this tracer. ! Local variables integer :: ntseg @@ -4468,6 +4484,7 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & segment%tr_Reg%Tr(ntseg)%Tr => tr_ptr segment%tr_Reg%Tr(ntseg)%name = tr_ptr%name + segment%tr_Reg%Tr(ntseg)%scale = 1.0 ; if (present(scale)) segment%tr_Reg%Tr(ntseg)%scale = scale if (segment%tr_Reg%locked) call MOM_error(FATAL, & "MOM register_segment_tracer was called for variable "//trim(segment%tr_Reg%Tr(ntseg)%name)//& @@ -4503,8 +4520,9 @@ subroutine segment_tracer_registry_end(Reg) endif end subroutine segment_tracer_registry_end -subroutine register_temp_salt_segments(GV, OBC, tr_Reg, param_file) +subroutine register_temp_salt_segments(GV, US, OBC, tr_Reg, param_file) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< Unit scaling type type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values @@ -4527,18 +4545,19 @@ subroutine register_temp_salt_segments(GV, OBC, tr_Reg, param_file) name = 'temp' call tracer_name_lookup(tr_Reg, tr_ptr, name) call register_segment_tracer(tr_ptr, param_file, GV, segment, & - OBC_array=segment%temp_segment_data_exists) + OBC_array=segment%temp_segment_data_exists, scale=US%degC_to_C) name = 'salt' call tracer_name_lookup(tr_Reg, tr_ptr, name) call register_segment_tracer(tr_ptr, param_file, GV, segment, & - OBC_array=segment%salt_segment_data_exists) + OBC_array=segment%salt_segment_data_exists, scale=US%ppt_to_S) enddo end subroutine register_temp_salt_segments -subroutine fill_temp_salt_segments(G, GV, OBC, tv) +subroutine fill_temp_salt_segments(G, GV, US, OBC, tv) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< Unit scaling type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure @@ -4960,6 +4979,8 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) real :: u_L_in, u_L_out ! The zonal distance moved in or out of a cell [L ~> m] real :: v_L_in, v_L_out ! The meridional distance moved in or out of a cell [L ~> m] 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, ntr, nz integer :: ishift, idir, jshift, jdir @@ -4981,17 +5002,20 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! Can keep this or take it out, either way if (G%mask2dT(I+ishift,j) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep - do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz - u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / & - ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) - u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / & - ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) - fac1 = 1.0 + (u_L_out-u_L_in) - segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & - (u_L_out*Reg%Tr(m)%t(I+ishift,j,k) - & - u_L_in*segment%tr_Reg%Tr(m)%t(I,j,k))) - if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) - enddo ; endif ; enddo + do m=1,ntr + I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale + if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / & + ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) + u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / & + ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) + fac1 = 1.0 + (u_L_out-u_L_in) + segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & + (u_L_out*Reg%Tr(m)%t(I+ishift,j,k) - & + u_L_in*segment%tr_Reg%Tr(m)%t(I,j,k))) + if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) + enddo ; endif + enddo enddo elseif (segment%is_N_or_S) then J = segment%HI%JsdB @@ -5006,17 +5030,20 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! Can keep this or take it out, either way if (G%mask2dT(i,j+jshift) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep - do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz - v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / & - ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) - v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / & - ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) - fac1 = 1.0 + (v_L_out-v_L_in) - segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & - (v_L_out*Reg%Tr(m)%t(i,J+jshift,k) - & - v_L_in*segment%tr_Reg%Tr(m)%t(i,J,k))) - if (allocated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%tres(i,J,k) - enddo ; endif ; enddo + do m=1,ntr + I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale + if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / & + ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) + v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / & + ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) + fac1 = 1.0 + (v_L_out-v_L_in) + segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & + (v_L_out*Reg%Tr(m)%t(i,J+jshift,k) - & + v_L_in*segment%tr_Reg%Tr(m)%t(i,J,k))) + if (allocated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k) + enddo ; endif + enddo enddo endif enddo ; endif ; endif @@ -5363,7 +5390,7 @@ subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CS, OBC) enddo if (use_temperature) & - call fill_temp_salt_segments(G, GV, OBC, tv) + call fill_temp_salt_segments(G, GV, US, OBC, tv) call open_boundary_init(G, GV, US, param_file, OBC, restart_CS) end subroutine rotate_OBC_init diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 7cdf3e8e71..b0d12018f7 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -37,7 +37,7 @@ module MOM_variables end type p2d !> Pointers to various fields which may be used describe the surface state of MOM, and which -!! will be returned to a the calling program +!! will be returned to the calling program type, public :: surface real, allocatable, dimension(:,:) :: & SST, & !< The sea surface temperature [degC]. @@ -81,8 +81,8 @@ module MOM_variables !! potential temperature, salinity, heat capacity, and the equation of state control structure. type, public :: thermo_var_ptrs ! If allocated, the following variables have nz layers. - real, pointer :: T(:,:,:) => NULL() !< Potential temperature [degC]. - real, pointer :: S(:,:,:) => NULL() !< Salinity [PSU] or [gSalt/kg], generically [ppt]. + real, pointer :: T(:,:,:) => NULL() !< Potential temperature [C ~> degC]. + real, pointer :: S(:,:,:) => NULL() !< Salinity [PSU] or [gSalt/kg], generically [S ~> ppt]. real, pointer :: p_surf(:,:) => NULL() !< Ocean surface pressure used in equation of state !! calculations [R L2 T-2 ~> Pa] type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the @@ -90,15 +90,14 @@ module MOM_variables real :: P_Ref !< The coordinate-density reference pressure [R L2 T-2 ~> Pa]. !! This is the pressure used to calculate Rml from !! T and S when eqn_of_state is associated. - real :: C_p !< The heat capacity of seawater [Q degC-1 ~> J degC-1 kg-1]. + real :: C_p !< The heat capacity of seawater [Q C-1 ~> J degC-1 kg-1]. !! 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]. logical :: S_is_absS = .false. !< If true, the salinity variable tv%S is !! actually the absolute salinity in units of [gSalt kg-1]. - real :: min_salinity = 0.01 !< The minimum value of salinity when BOUND_SALINITY=True [ppt]. - !! The default is 0.01 for backward compatibility but should be 0. + real :: min_salinity !< The minimum value of salinity when BOUND_SALINITY=True [S ~> ppt]. ! These arrays are accumulated fluxes for communication with other components. real, dimension(:,:), pointer :: frazil => NULL() !< The energy needed to heat the ocean column to the @@ -111,19 +110,19 @@ module MOM_variables real, dimension(:,:), pointer :: TempxPmE => NULL() !< The net inflow of water into the ocean times the !! temperature at which this inflow occurs since the - !! last call to calculate_surface_state [degC R Z ~> degC kg m-2]. + !! last call to calculate_surface_state [C R Z ~> degC kg m-2]. !! This should be prescribed in the forcing fields, but !! as it often is not, this is a useful heat budget diagnostic. real, dimension(:,:), pointer :: internal_heat => NULL() !< Any internal or geothermal heat sources that !! have been applied to the ocean since the last call to - !! calculate_surface_state [degC R Z ~> degC kg m-2]. + !! calculate_surface_state [C R Z ~> degC kg m-2]. ! The following variables are most normally not used but when they are they ! will be either set by parameterizations or prognostic. - real, pointer :: varT(:,:,:) => NULL() !< SGS variance of potential temperature [degC2]. - real, pointer :: varS(:,:,:) => NULL() !< SGS variance of salinity [ppt2]. + real, pointer :: varT(:,:,:) => NULL() !< SGS variance of potential temperature [C2 ~> degC2]. + real, pointer :: varS(:,:,:) => NULL() !< SGS variance of salinity [S2 ~> ppt2]. real, pointer :: covarTS(:,:,:) => NULL() !< SGS covariance of salinity and potential - !! temperature [degC ppt]. + !! temperature [C S ~> degC ppt]. end type thermo_var_ptrs !> Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM.F90. @@ -133,8 +132,8 @@ module MOM_variables !! they refer to in MOM.F90. type, public :: ocean_internal_state real, pointer, dimension(:,:,:) :: & - T => NULL(), & !< Pointer to the temperature state variable [degC] - S => NULL(), & !< Pointer to the salinity state variable [ppt ~> PSU or g/kg] + T => NULL(), & !< Pointer to the temperature state variable [C ~> degC] + S => NULL(), & !< Pointer to the salinity state variable [S ~> ppt] (i.e., PSU or g/kg) u => NULL(), & !< Pointer to the zonal velocity [L T-1 ~> m s-1] v => NULL(), & !< Pointer to the meridional velocity [L T-1 ~> m s-1] h => NULL() !< Pointer to the layer thicknesses [H ~> m or kg m-2] @@ -580,15 +579,15 @@ subroutine MOM_thermovar_chksum(mesg, tv, G, US) ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. if (associated(tv%T)) & - call hchksum(tv%T, mesg//" tv%T", G%HI) + call hchksum(tv%T, mesg//" tv%T", G%HI, scale=US%C_to_degC) if (associated(tv%S)) & - call hchksum(tv%S, mesg//" tv%S", G%HI) + call hchksum(tv%S, mesg//" tv%S", G%HI, scale=US%S_to_ppt) if (associated(tv%frazil)) & call hchksum(tv%frazil, mesg//" tv%frazil", G%HI, scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(tv%salt_deficit)) & - call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI, scale=US%RZ_to_kg_m2) + call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI, scale=US%RZ_to_kg_m2*US%S_to_ppt) if (associated(tv%TempxPmE)) & - call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI, scale=US%RZ_to_kg_m2) + call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI, scale=US%RZ_to_kg_m2*US%C_to_degC) end subroutine MOM_thermovar_chksum end module MOM_variables diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 33f3edcfd4..c0f14d0c5d 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -683,7 +683,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci if (CS%use_temperature) then Temp_int(:,:) = 0.0 ; Salt_int(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - Salt_int(i,j) = Salt_int(i,j) + tv%S(i,j,k) * & + Salt_int(i,j) = Salt_int(i,j) + US%S_to_ppt*tv%S(i,j,k) * & (h(i,j,k)*(HL2_to_kg * areaTm(i,j))) Temp_int(i,j) = Temp_int(i,j) + (US%Q_to_J_kg*tv%C_p * tv%T(i,j,k)) * & (h(i,j,k)*(HL2_to_kg * areaTm(i,j))) @@ -756,9 +756,11 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci mass_chg = EFP_to_real(mass_chg_EFP) if (CS%use_temperature) then - salin = Salt / mass_tot ; salin_anom = Salt_anom / mass_tot + salin = Salt / mass_tot + salin_anom = Salt_anom / mass_tot ! salin_chg = Salt_chg / mass_tot - temp = heat / (mass_tot*US%Q_to_J_kg*tv%C_p) ; temp_anom = Heat_anom / (mass_tot*US%Q_to_J_kg*tv%C_p) + temp = heat / (mass_tot*US%Q_to_J_kg*US%degC_to_C*tv%C_p) + temp_anom = Heat_anom / (mass_tot*US%Q_to_J_kg*US%degC_to_C*tv%C_p) endif En_mass = toten / mass_tot @@ -995,18 +997,18 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) ! smg: old code if (associated(tv%TempxPmE)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (fluxes%C_p * QRZL2_to_J*G%areaT(i,j)) * tv%TempxPmE(i,j) + heat_in(i,j) = heat_in(i,j) + (tv%C_p * QRZL2_to_J*G%areaT(i,j)) * tv%TempxPmE(i,j) enddo ; enddo elseif (associated(fluxes%evap)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (US%Q_to_J_kg*fluxes%C_p * sfc_state%SST(i,j)) * FW_in(i,j) + heat_in(i,j) = heat_in(i,j) + (US%Q_to_J_kg*tv%C_p * US%degC_to_C*sfc_state%SST(i,j)) * FW_in(i,j) enddo ; enddo endif ! The following heat sources may or may not be used. if (associated(tv%internal_heat)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (fluxes%C_p * QRZL2_to_J*G%areaT(i,j)) * tv%internal_heat(i,j) + heat_in(i,j) = heat_in(i,j) + (tv%C_p * QRZL2_to_J*G%areaT(i,j)) * tv%internal_heat(i,j) enddo ; enddo endif if (associated(tv%frazil)) then ; do j=js,je ; do i=is,ie diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 1b016d044b..440bd8aa36 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1536,10 +1536,10 @@ subroutine EOS_init(param_file, EOS, US) EOS%R_to_kg_m3 = 1. ; if (present(US)) EOS%R_to_kg_m3 = US%R_to_kg_m3 EOS%RL2_T2_to_Pa = 1. ; if (present(US)) EOS%RL2_T2_to_Pa = US%RL2_T2_to_Pa EOS%L_T_to_m_s = 1. ; if (present(US)) EOS%L_T_to_m_s = US%L_T_to_m_s - EOS%degC_to_C = 1. !### ; if (present(US)) EOS%degC_to_C = US%degC_to_C - EOS%C_to_degC = 1. !### ; if (present(US)) EOS%C_to_degC = US%C_to_degC - EOS%ppt_to_S = 1. !### ; if (present(US)) EOS%ppt_to_S = US%ppt_to_S - EOS%S_to_ppt = 1. !### ; if (present(US)) EOS%S_to_ppt = US%S_to_ppt + EOS%degC_to_C = 1. ; if (present(US)) EOS%degC_to_C = US%degC_to_C + EOS%C_to_degC = 1. ; if (present(US)) EOS%C_to_degC = US%C_to_degC + EOS%ppt_to_S = 1. ; if (present(US)) EOS%ppt_to_S = US%ppt_to_S + EOS%S_to_ppt = 1. ; if (present(US)) EOS%S_to_ppt = US%S_to_ppt end subroutine EOS_init diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 10aef884dd..a1766e7805 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -244,9 +244,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) real, dimension(SZI_(CS%grid)) :: & Rhoml, & !< Ocean mixed layer density [R ~> kg m-3]. dR0_dT, & !< Partial derivative of the mixed layer density - !< with temperature [R degC-1 ~> kg m-3 degC-1]. + !< with temperature [R C-1 ~> kg m-3 degC-1]. dR0_dS, & !< Partial derivative of the mixed layer density - !< with salinity [R ppt-1 ~> kg m-3 ppt-1]. + !< with salinity [R S-1 ~> kg m-3 ppt-1]. p_int !< The pressure at the ice-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(CS%grid),SZJ_(CS%grid)) :: & @@ -426,10 +426,10 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) do i=is,ie ; p_int(i) = CS%g_Earth * ISS%mass_shelf(i,j) ; enddo ! Calculate insitu densities and expansion coefficients - call calculate_density(sfc_state%sst(:,j), sfc_state%sss(:,j), p_int, Rhoml(:), & - CS%eqn_of_state, EOSdom) - call calculate_density_derivs(sfc_state%sst(:,j), sfc_state%sss(:,j), p_int, dR0_dT, dR0_dS, & + call calculate_density(US%degC_to_C*sfc_state%sst(:,j), US%ppt_to_S*sfc_state%sss(:,j), p_int, Rhoml(:), & CS%eqn_of_state, EOSdom) + call calculate_density_derivs(US%degC_to_C*sfc_state%sst(:,j), US%ppt_to_S*sfc_state%sss(:,j), p_int, & + dR0_dT, dR0_dS, CS%eqn_of_state, EOSdom) do i=is,ie if ((sfc_state%ocean_mass(i,j) > CS%col_mass_melt_threshold) .and. & @@ -451,8 +451,8 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) hBL_neut_h_molec = ZETA_N * ((hBL_neut * ustar_h) / (5.0 * CS%kv_molec)) ! 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) + dB_dS = (US%L_to_Z**2*CS%g_Earth / Rhoml(i)) * US%ppt_to_S*dR0_dS(i) + dB_dT = (US%L_to_Z**2*CS%g_Earth / Rhoml(i)) * US%degC_to_C*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 diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 310a7f9392..cb5d0ca81b 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -204,8 +204,8 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state !! [R L2 T-2 ~> Pa]. ! Local variables - real :: T_ref ! Reference temperature - real :: S_ref ! Reference salinity + real :: T_ref ! Reference temperature [C ~> degC] + real :: S_ref ! Reference salinity [S ~> ppt] real :: g_int ! Reduced gravities across the internal interfaces [L2 Z-1 T-2 ~> m s-2]. real :: g_fs ! Reduced gravity across the free surface [L2 Z-1 T-2 ~> m s-2]. character(len=40) :: mdl = "set_coord_from_TS_ref" ! This subroutine's name. @@ -214,11 +214,11 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") - call get_param(param_file, mdl, "T_REF", T_Ref, & - "The initial temperature of the lightest layer.", units="degC", & - fail_if_missing=.true.) - call get_param(param_file, mdl, "S_REF", S_Ref, & - "The initial salinities.", units="PSU", default=35.0) + call get_param(param_file, mdl, "T_REF", T_ref, & + "The initial temperature of the lightest layer.", & + units="degC", scale=US%degC_to_C, fail_if_missing=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, & + "The initial salinities.", units="PSU", default=35.0, scale=US%ppt_to_S) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth*US%L_T_to_m_s**2*US%m_to_Z, scale=US%m_s_to_L_T**2*US%Z_to_m) @@ -254,7 +254,9 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s !! [R L2 T-2 ~> Pa]. ! Local variables - real, dimension(GV%ke) :: T0, S0, Pref + real, dimension(GV%ke) :: T0 ! A profile of temperatures [C ~> degC] + real, dimension(GV%ke) :: S0 ! A profile of salinities [S ~> ppt] + real, dimension(GV%ke) :: Pref ! A array of reference pressures [R L2 T-2 ~> Pa] real :: g_fs ! Reduced gravity across the free surface [L2 Z-1 T-2 ~> m s-2]. integer :: k, nz character(len=40) :: mdl = "set_coord_from_TS_profile" ! This subroutine's name. @@ -274,8 +276,8 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s filename = trim(slasher(inputdir))//trim(coord_file) call log_param(param_file, mdl, "INPUTDIR/COORD_FILE", filename) - call MOM_read_data(filename, "PTEMP", T0(:)) - call MOM_read_data(filename, "SALT", S0(:)) + call MOM_read_data(filename, "PTEMP", T0(:), scale=US%degC_to_C) + call MOM_read_data(filename, "SALT", S0(:), scale=US%ppt_to_S) if (.not.file_exists(filename)) call MOM_error(FATAL, & " set_coord_from_TS_profile: Unable to open " //trim(filename)) @@ -301,9 +303,13 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta !! [R L2 T-2 ~> Pa]. ! Local variables - real, dimension(GV%ke) :: T0, S0, Pref - real :: S_Ref, S_Light, S_Dense ! Salinity range parameters [ppt]. - real :: T_Ref, T_Light, T_Dense ! Temperature range parameters [degC]. + real, dimension(GV%ke) :: T0 ! A profile of temperatures [C ~> degC] + real, dimension(GV%ke) :: S0 ! A profile of salinities [S ~> ppt] + real, dimension(GV%ke) :: Pref ! A array of reference pressures [R L2 T-2 ~> Pa] + real :: S_Ref ! Default salinity range parameters [ppt]. + real :: T_Ref ! Default temperature range parameters [degC]. + real :: S_Light, S_Dense ! Salinity range parameters [S ~> ppt]. + real :: T_Light, T_Dense ! Temperature range parameters [C ~> degC]. real :: res_rat ! The ratio of density space resolution in the denser part ! of the range to that in the lighter part of the range. ! Setting this greater than 1 increases the resolution for @@ -321,19 +327,19 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta "The default initial temperatures.", units="degC", default=10.0) call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_Light, & "The initial temperature of the lightest layer when "//& - "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref) + "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref, scale=US%degC_to_C) call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_Dense, & "The initial temperature of the densest layer when "//& - "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref) + "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref, scale=US%degC_to_C) call get_param(param_file, mdl, "S_REF", S_Ref, & "The default initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_Light, & "The initial lightest salinities when COORD_CONFIG "//& - "is set to ts_range.", default = S_Ref, units="PSU") + "is set to ts_range.", default = S_Ref, units="PSU", scale=US%ppt_to_S) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_Dense, & "The initial densest salinities when COORD_CONFIG "//& - "is set to ts_range.", default = S_Ref, units="PSU") + "is set to ts_range.", default = S_Ref, units="PSU", scale=US%ppt_to_S) call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, & "The ratio of density space resolution in the densest "//& @@ -352,7 +358,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta k_light = GV%nk_rho_varies + 1 ! Set T0(k) to range from T_LIGHT to T_DENSE, and simliarly for S0(k). - T0(k_light) = T_light ; S0(k_light) = S_light + T0(k_light) = T_Light ; S0(k_light) = S_Light a1 = 2.0 * res_rat / (1.0 + res_rat) do k=k_light+1,nz k_frac = real(k-k_light)/real(nz-k_light) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index ae7a23c3c9..b6a3e9ee9d 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -366,33 +366,33 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & select case (trim(config)) case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, US, PF, & eos, tv%P_Ref, just_read=just_read) - case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, GV, & + case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, GV, US, & PF, just_read=just_read) case ("benchmark"); call benchmark_init_temperature_salinity(tv%T, tv%S, & G, GV, US, PF, eos, tv%P_Ref, just_read=just_read) case ("TS_profile") ; call initialize_temp_salt_from_profile(tv%T, tv%S, & - G, GV, PF, just_read=just_read) - case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, GV, PF, & + G, GV, US, PF, just_read=just_read) + case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, GV, US, PF, & just_read=just_read) - case ("DOME2D"); call DOME2d_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, just_read=just_read) - case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity ( tv%T, & - tv%S, h, depth_tot, G, GV, US, PF, eos, just_read=just_read) + case ("DOME2D"); call DOME2d_initialize_temperature_salinity (tv%T, tv%S, h, & + G, GV, US, PF, just_read=just_read) + case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity (tv%T, tv%S, h, & + depth_tot, G, GV, US, PF, eos, just_read=just_read) case ("adjustment2d"); call adjustment_initialize_temperature_salinity ( tv%T, & - tv%S, h, depth_tot, G, GV, PF, just_read=just_read) + tv%S, h, depth_tot, G, GV, US, PF, just_read=just_read) case ("baroclinic_zone"); call baroclinic_zone_init_temperature_salinity( tv%T, & tv%S, h, depth_tot, G, GV, US, PF, just_read=just_read) case ("sloshing"); call sloshing_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, just_read=just_read) + tv%S, h, G, GV, US, PF, just_read=just_read) case ("seamount"); call seamount_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, just_read=just_read) + tv%S, h, G, GV, US, PF, just_read=just_read) case ("dumbbell"); call dumbbell_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, just_read=just_read) + tv%S, h, G, GV, US, PF, just_read=just_read) case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, just_read=just_read) + tv%S, h, G, GV, US, PF, just_read=just_read) case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init(tv%T, tv%S, h, & G, GV, US, PF, just_read=just_read) - case ("dense"); call dense_water_initialize_TS(G, GV, PF, tv%T, tv%S, & + case ("dense"); call dense_water_initialize_TS(G, GV, US, PF, tv%T, tv%S, & h, just_read=just_read) case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, GV, PF, & just_read=just_read) @@ -402,7 +402,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & endif endif ! not from_Z_file. if (use_temperature .and. use_OBC) & - call fill_temp_salt_segments(G, GV, OBC, tv) + call fill_temp_salt_segments(G, GV, US, OBC, tv) ! Calculate the initial surface displacement under ice shelf @@ -548,13 +548,13 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & if (debug) then call hchksum(h, "MOM_initialize_state: h ", G%HI, haloshift=1, scale=GV%H_to_m) - if ( use_temperature ) call hchksum(tv%T, "MOM_initialize_state: T ", G%HI, haloshift=1) - if ( use_temperature ) call hchksum(tv%S, "MOM_initialize_state: S ", G%HI, haloshift=1) + if ( use_temperature ) call hchksum(tv%T, "MOM_initialize_state: T ", G%HI, haloshift=1, scale=US%C_to_degC) + if ( use_temperature ) call hchksum(tv%S, "MOM_initialize_state: S ", G%HI, haloshift=1, scale=US%S_to_ppt) if ( use_temperature .and. debug_layers) then ; do k=1,nz write(mesg,'("MOM_IS: T[",I2,"]")') k - call hchksum(tv%T(:,:,k), mesg, G%HI, haloshift=1) + call hchksum(tv%T(:,:,k), mesg, G%HI, haloshift=1, scale=US%C_to_degC) write(mesg,'("MOM_IS: S[",I2,"]")') k - call hchksum(tv%S(:,:,k), mesg, G%HI, haloshift=1) + call hchksum(tv%S(:,:,k), mesg, G%HI, haloshift=1, scale=US%S_to_ppt) enddo ; endif endif @@ -1160,7 +1160,9 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) character(len=200) :: mdl = "trim_for_ice" real, dimension(SZI_(G),SZJ_(G)) :: p_surf ! Imposed pressure on ocean at surface [R L2 T-2 ~> Pa] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S_t, S_b ! Top and bottom edge values for reconstructions - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T_t, T_b ! of salinity [ppt] and temperature [degC] within each layer. + ! of salinity within each layer [S ~> ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T_t, T_b ! Top and bottom edge values for reconstructions + ! of temperature within each layer [T ~> degC] character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path real :: scale_factor ! A file-dependent scaling factor for the input pressure. real :: min_thickness ! The minimum layer thickness, recast into Z units [Z ~> m]. @@ -1323,12 +1325,12 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, real, intent(in) :: G_earth !< Gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real, intent(in) :: depth !< Depth of ocean column [Z ~> m]. real, intent(in) :: min_thickness !< Smallest thickness allowed [Z ~> m]. - real, dimension(nk), intent(inout) :: T !< Layer mean temperature [degC] - real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer [degC] - real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer [degC] - real, dimension(nk), intent(inout) :: S !< Layer mean salinity [ppt] - real, dimension(nk), intent(in) :: S_t !< Salinity at top of layer [ppt] - real, dimension(nk), intent(in) :: S_b !< Salinity at bottom of layer [ppt] + real, dimension(nk), intent(inout) :: T !< Layer mean temperature [C ~> degC] + real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer [C ~> degC] + real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer [C ~> degC] + real, dimension(nk), intent(inout) :: S !< Layer mean salinity [S ~> ppt] + real, dimension(nk), intent(in) :: S_t !< Salinity at top of layer [S ~> ppt] + real, dimension(nk), intent(in) :: S_b !< Salinity at bottom of layer [S ~> ppt] real, intent(in) :: p_surf !< Imposed pressure on ocean at surface [R L2 T-2 ~> Pa] real, dimension(nk), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, @@ -1587,13 +1589,14 @@ end function my_psi end subroutine initialize_velocity_circular !> Initializes temperature and salinity from file -subroutine initialize_temp_salt_from_file(T, S, G, GV, param_file, just_read) +subroutine initialize_temp_salt_from_file(T, S, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is - !! being initialized [degC] + !! being initialized [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is - !! being initialized [ppt] + !! being initialized [S ~> ppt] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, intent(in) :: just_read !< If true, this call will only !! read parameters without changing T or S. @@ -1629,27 +1632,28 @@ subroutine initialize_temp_salt_from_file(T, S, G, GV, param_file, just_read) " initialize_temp_salt_from_file: Unable to open "//trim(filename)) ! Read the temperatures and salinities from netcdf files. - call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) + call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain, scale=US%degC_to_C) salt_filename = trim(inputdir)//trim(salt_file) if (.not.file_exists(salt_filename, G%Domain)) call MOM_error(FATAL, & " initialize_temp_salt_from_file: Unable to open "//trim(salt_filename)) - call MOM_read_data(salt_filename, salt_var, S(:,:,:), G%Domain) + call MOM_read_data(salt_filename, salt_var, S(:,:,:), G%Domain, scale=US%ppt_to_S) call callTree_leave(trim(mdl)//'()') end subroutine initialize_temp_salt_from_file !> Initializes temperature and salinity from a 1D profile -subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read) +subroutine initialize_temp_salt_from_profile(T, S, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is - !! being initialized [degC] + !! being initialized [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is - !! being initialized [ppt] - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - logical, intent(in) :: just_read !< If true, this call will only read + !! being initialized [S ~> ppt] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing T or S. ! Local variables real, dimension(SZK_(GV)) :: T0, S0 @@ -1673,8 +1677,8 @@ subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read) " initialize_temp_salt_from_profile: Unable to open "//trim(filename)) ! Read the temperatures and salinities from a netcdf file. - call MOM_read_data(filename, "PTEMP", T0(:)) - call MOM_read_data(filename, "SALT", S0(:)) + call MOM_read_data(filename, "PTEMP", T0(:), scale=US%degC_to_C) + call MOM_read_data(filename, "SALT", S0(:), scale=US%ppt_to_S) do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) @@ -1688,9 +1692,9 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is - !! being initialized [degC]. + !! being initialized [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being - !! initialized [ppt]. + !! initialized [S ~> ppt]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. @@ -1700,13 +1704,13 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing T or S. ! Local variables - real :: T0(SZK_(GV)) ! Layer potential temperatures [degC] - real :: S0(SZK_(GV)) ! Layer salinities [degC] - real :: T_Ref ! Reference Temperature [degC] - real :: S_Ref ! Reference Salinity [ppt] + real :: T0(SZK_(GV)) ! Layer potential temperatures [C ~> degC] + real :: S0(SZK_(GV)) ! Layer salinities [S ~> ppt] + real :: T_Ref ! Reference Temperature [C ~> degC] + real :: S_Ref ! Reference Salinity [S ~> ppt] real :: pres(SZK_(GV)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. - real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3]. logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. character(len=40) :: mdl = "initialize_temp_salt_fit" ! This subroutine's name. @@ -1717,10 +1721,10 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P call get_param(param_file, mdl, "T_REF", T_Ref, & "A reference temperature used in initialization.", & - units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + units="degC", scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_Ref, & "A reference salinity used in initialization.", units="PSU", & - default=35.0, do_not_log=just_read) + default=35.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & "If true, accept the prescribed temperature and fit the "//& "salinity; otherwise take salinity and fit temperature.", & @@ -1775,13 +1779,14 @@ end subroutine initialize_temp_salt_fit !! !! \remark Note that the linear distribution is set up with respect to the layer !! number, not the physical position). -subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read) +subroutine initialize_temp_salt_linear(T, S, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is !! being initialized [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is !! being initialized [ppt] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters logical, intent(in) :: just_read !< If present and true, @@ -1789,8 +1794,8 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read) !! without changing T or S. integer :: k - real :: S_top, T_top ! Reference salinity and temperature within surface layer - real :: S_range, T_range ! Range of salinities and temperatures over the vertical + real :: S_top, T_top ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer + real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical !real :: delta_S, delta_T !real :: delta character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's name. @@ -1798,16 +1803,16 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read) if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "T_TOP", T_top, & "Initial temperature of the top surface.", & - units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + units="degC", scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, & "Initial temperature difference (top-bottom).", & - units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + units="degC", scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_TOP", S_top, & "Initial salinity of the top surface.", & - units="PSU", fail_if_missing=.not.just_read, do_not_log=just_read) + units="PSU", scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_RANGE", S_range, & "Initial salinity difference (top-bottom).", & - units="PSU", fail_if_missing=.not.just_read, do_not_log=just_read) + units="PSU", scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -2046,8 +2051,8 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo EOSdom(:) = EOS_domain(G%HI) - call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain) - call MOM_read_data(filename, salin_var, tmp2(:,:,:), G%Domain) + call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain, scale=US%degC_to_C) + call MOM_read_data(filename, salin_var, tmp2(:,:,:), G%Domain, scale=US%ppt_to_S) do j=js,je call calculate_density(tmp(:,j,1), tmp2(:,j,1), pres, tmp_2d(:,j), tv%eqn_of_state, EOSdom) @@ -2063,9 +2068,9 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t ! The remaining calls to set_up_sponge_field can be in any order. if ( use_temperature) then - call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain) + call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain, scale=US%degC_to_C) call set_up_sponge_field(tmp, tv%T, G, GV, nz, Layer_CSp) - call MOM_read_data(filename, salin_var, tmp(:,:,:), G%Domain) + call MOM_read_data(filename, salin_var, tmp(:,:,:), G%Domain, scale=US%ppt_to_S) call set_up_sponge_field(tmp, tv%S, G, GV, nz, Layer_CSp) endif @@ -2107,9 +2112,9 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t deallocate(h) if (use_temperature) then allocate(tmp_tr(isd:ied,jsd:jed,nz_data)) - call MOM_read_data(filename, potemp_var, tmp_tr(:,:,:), G%Domain) + call MOM_read_data(filename, potemp_var, tmp_tr(:,:,:), G%Domain, scale=US%degC_to_C) call set_up_ALE_sponge_field(tmp_tr, G, GV, tv%T, ALE_CSp) - call MOM_read_data(filename, salin_var, tmp_tr(:,:,:), G%Domain) + call MOM_read_data(filename, salin_var, tmp_tr(:,:,:), G%Domain, scale=US%ppt_to_S) call set_up_ALE_sponge_field(tmp_tr, G, GV, tv%S, ALE_CSp) deallocate(tmp_tr) endif @@ -2120,7 +2125,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t call MOM_error(FATAL, " initialize_sponges: Unable to open "//trim(filename)) allocate(tmp_u(G%IsdB:G%IedB,jsd:jed,nz_data)) allocate(tmp_v(isd:ied,G%JsdB:G%JedB,nz_data)) - call MOM_read_vector(filename, u_var, v_var, tmp_u(:,:,:), tmp_v(:,:,:), G%Domain,scale=US%m_s_to_L_T) + call MOM_read_vector(filename, u_var, v_var, tmp_u(:,:,:), tmp_v(:,:,:), G%Domain, scale=US%m_s_to_L_T) call set_up_ALE_sponge_vel_field(tmp_u, tmp_v, G, GV, u, v, ALE_CSp) deallocate(tmp_u,tmp_v) endif @@ -2133,8 +2138,8 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t endif ! The remaining calls to set_up_sponge_field can be in any order. if ( use_temperature) then - call set_up_ALE_sponge_field(filename, potemp_var, Time, G, GV, US, tv%T, ALE_CSp) - call set_up_ALE_sponge_field(filename, salin_var, Time, G, GV, US, tv%S, ALE_CSp) + call set_up_ALE_sponge_field(filename, potemp_var, Time, G, GV, US, tv%T, ALE_CSp, scale=US%C_to_degC) + call set_up_ALE_sponge_field(filename, salin_var, Time, G, GV, US, tv%S, ALE_CSp, scale=US%S_to_ppt) endif if (sponge_uv) then filename = trim(inputdir)//trim(state_uv_file) @@ -2274,10 +2279,10 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p if (use_temperature) then allocate(tmp_tr(isd:ied,jsd:jed,nz_data)) ! temperature inc. in array Inc(1) - call MOM_read_data(filename, tempinc_var, tmp_tr(:,:,:), G%Domain) + call MOM_read_data(filename, tempinc_var, tmp_tr(:,:,:), G%Domain, scale=US%degC_to_C) call set_up_oda_incupd_field(tmp_tr, G, GV, oda_incupd_CSp) ! salinity inc. in array Inc(2) - call MOM_read_data(filename, salinc_var, tmp_tr(:,:,:), G%Domain) + call MOM_read_data(filename, salinc_var, tmp_tr(:,:,:), G%Domain, scale=US%ppt_to_S) call set_up_oda_incupd_field(tmp_tr, G, GV, oda_incupd_CSp) deallocate(tmp_tr) endif @@ -2441,8 +2446,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just ! Local variables for ALE remapping real, dimension(:), allocatable :: hTarget ! Target thicknesses [Z ~> m]. - real, dimension(:,:,:), allocatable, target :: tmpT1dIn ! Input temperatures on a model-sized grid [degC] - real, dimension(:,:,:), allocatable, target :: tmpS1dIn ! Input salinities on a model-sized grid [ppt] + real, dimension(:,:,:), allocatable, target :: tmpT1dIn ! Input temperatures on a model-sized grid [C ~> degC] + real, dimension(:,:,:), allocatable, target :: tmpS1dIn ! Input salinities on a model-sized grid [S ~> ppt] real, dimension(:,:,:), allocatable :: tmp_mask_in ! The valid data mask on a model-sized grid [nondim] real, dimension(:,:,:), allocatable :: h1 ! Thicknesses [H ~> m or kg m-2]. real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding @@ -2626,7 +2631,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just press(:) = tv%P_Ref EOSdom(:) = EOS_domain(G%HI) do k=1,kd ; do j=js,je - call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), eos, EOSdom) + call calculate_density(US%degC_to_C*temp_z(:,j,k), US%ppt_to_S*salt_z(:,j,k), press, rho_z(:,j,k), eos, EOSdom) enddo ; enddo call pass_var(temp_z,G%Domain) @@ -2656,15 +2661,15 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just do k = 1, nkd if (tmp_mask_in(i,j,k)>0. .and. k<=kd) then zBottomOfCell = max( z_edges_in(k+1), Z_bottom(i,j)) - tmpT1dIn(i,j,k) = temp_z(i,j,k) - tmpS1dIn(i,j,k) = salt_z(i,j,k) + tmpT1dIn(i,j,k) = US%degC_to_C*temp_z(i,j,k) + tmpS1dIn(i,j,k) = US%ppt_to_S*salt_z(i,j,k) elseif (k>1) then zBottomOfCell = Z_bottom(i,j) tmpT1dIn(i,j,k) = tmpT1dIn(i,j,k-1) tmpS1dIn(i,j,k) = tmpS1dIn(i,j,k-1) else ! This next block should only ever be reached over land - tmpT1dIn(i,j,k) = -99.9 - tmpS1dIn(i,j,k) = -99.9 + tmpT1dIn(i,j,k) = -99.9*US%degC_to_C + tmpS1dIn(i,j,k) = -99.9*US%ppt_to_S endif h1(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k @@ -2779,15 +2784,17 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just endif endif - call tracer_z_init_array(temp_z, z_edges_in, kd, zi, missing_value, G, nz, nlevs, eps_z, tv%T) - call tracer_z_init_array(salt_z, z_edges_in, kd, zi, missing_value, G, nz, nlevs, eps_z, tv%S) + call tracer_z_init_array(temp_z, z_edges_in, kd, zi, missing_value, G, nz, nlevs, eps_z, & + tv%T, scale=US%degC_to_C) + call tracer_z_init_array(salt_z, z_edges_in, kd, zi, missing_value, G, nz, nlevs, eps_z, & + tv%S, scale=US%ppt_to_S) do k=1,nz nPoints = 0 ; tempAvg = 0. ; saltAvg = 0. do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then nPoints = nPoints + 1 - tempAvg = tempAvg + tv%T(i,j,k) - saltAvg = saltAvg + tv%S(i,j,k) + tempAvg = tempAvg + US%C_to_degC*tv%T(i,j,k) + saltAvg = saltAvg + US%S_to_ppt*tv%S(i,j,k) endif ; enddo ; enddo ! Horizontally homogenize data to produce perfectly "flat" initial conditions @@ -2800,8 +2807,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just tempAvg = tempAvg / real(nPoints) saltAvg = saltAvg / real(nPoints) endif - tv%T(:,:,k) = tempAvg - tv%S(:,:,k) = saltAvg + tv%T(:,:,k) = US%degC_to_C*tempAvg + tv%S(:,:,k) = US%ppt_to_S*saltAvg endif enddo @@ -2809,9 +2816,9 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just ! Fill land values do k=1,nz ; do j=js,je ; do i=is,ie - if (tv%T(i,j,k) == missing_value) then - tv%T(i,j,k) = temp_land_fill - tv%S(i,j,k) = salt_land_fill + if (tv%T(i,j,k) == US%degC_to_C*missing_value) then + tv%T(i,j,k) = US%degC_to_C*temp_land_fill + tv%S(i,j,k) = US%ppt_to_S*salt_land_fill endif enddo ; enddo ; enddo @@ -2976,16 +2983,18 @@ subroutine MOM_state_init_tests(G, GV, US, tv) ! Local variables integer, parameter :: nk=5 - real, dimension(nk) :: T, T_t, T_b ! Temperatures [degC] + real, dimension(nk) :: T, T_t, T_b ! Temperatures [C ~> degC] real, dimension(nk) :: S, S_t, S_b ! Salinities [ppt] real, dimension(nk) :: rho ! Layer density [R ~> kg m-3] real, dimension(nk) :: h ! Layer thicknesses [H ~> m or kg m-2] real, dimension(nk) :: z ! Height of layer center [Z ~> m] real, dimension(nk+1) :: e ! Interface heights [Z ~> m] - integer :: k + real :: T_ref ! A reference temperature [C ~> degC] + real :: S_ref ! A reference salinity [S ~> ppt] real :: P_tot, P_t, P_b ! Pressures [R L2 T-2 ~> Pa] real :: z_out ! Output height [Z ~> m] real :: I_z_scale ! The inverse of the height scale for prescribed gradients [Z-1 ~> m-1] + integer :: k type(remapping_CS), pointer :: remap_CS => NULL() I_z_scale = 1.0 / (500.0*US%m_to_Z) @@ -2997,14 +3006,16 @@ subroutine MOM_state_init_tests(G, GV, US, tv) e(K+1) = e(K) - GV%H_to_Z * h(k) enddo P_tot = 0. + T_ref = 20.0*US%degC_to_C + S_ref = 35.0*US%ppt_to_S do k = 1, nk z(k) = 0.5 * ( e(K) + e(K+1) ) - T_t(k) = 20. + (0. * I_z_scale) * e(k) - T(k) = 20. + (0. * I_z_scale)*z(k) - T_b(k) = 20. + (0. * I_z_scale)*e(k+1) - S_t(k) = 35. - (0. * I_z_scale)*e(k) - S(k) = 35. + (0. * I_z_scale)*z(k) - S_b(k) = 35. - (0. * I_z_scale)*e(k+1) + T_t(k) = T_ref + (0. * I_z_scale) * e(k) + T(k) = T_ref + (0. * I_z_scale)*z(k) + T_b(k) = T_ref + (0. * I_z_scale)*e(k+1) + S_t(k) = S_ref - (0. * I_z_scale)*e(k) + S(k) = S_ref + (0. * I_z_scale)*z(k) + S_b(k) = S_ref - (0. * I_z_scale)*e(k+1) call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*z(k), & rho(k), tv%eqn_of_state) P_tot = P_tot + GV%g_Earth * rho(k) * GV%H_to_Z*h(k) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index a1894eb13f..43a8416a10 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -149,11 +149,12 @@ module MOM_oda_driver_mod !> initialize First_guess (prior) and Analysis grid !! information for all ensemble members -subroutine init_oda(Time, G, GV, diag_CS, CS) +subroutine init_oda(Time, G, GV, US, diag_CS, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(inout) :: diag_CS !< A pointer to a diagnostic control structure type(ODA_CS), pointer, intent(inout) :: CS !< The DA control structure @@ -341,9 +342,9 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) ! set up diag variables for analysis increments CS%diag_CS => diag_CS CS%id_inc_t=register_diag_field('ocean_model','temp_increment',diag_CS%axesTL,& - Time,'ocean potential temperature increments','degC') + Time, 'ocean potential temperature increments', 'degC', conversion=US%C_to_degC) CS%id_inc_s=register_diag_field('ocean_model','salt_increment',diag_CS%axesTL,& - Time,'ocean salinity increments','psu') + Time, 'ocean salinity increments', 'psu', conversion=US%S_to_ppt) !! get global grid information from ocean model needed for ODA initialization T_grid=>NULL() @@ -391,7 +392,8 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(ODA_CS), pointer :: CS !< ocean DA control structure - real, dimension(SZI_(G),SZJ_(G),CS%nk) :: T, S + real, dimension(SZI_(G),SZJ_(G),CS%nk) :: T ! Temperature on the analysis grid [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),CS%nk) :: S ! Salinity on the analysis grid [S ~> ppt] integer :: i, j, m integer :: isc, iec, jsc, jec real :: h_neglect, h_neglect_edge ! small thicknesses [H ~> m or kg m-2] @@ -478,6 +480,8 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) Ocean_increment%T = CS%Ocean_posterior%T - CS%Ocean_prior%T Ocean_increment%S = CS%Ocean_posterior%S - CS%Ocean_prior%S endif + ! It may be necessary to check whether the increment and ocean state have the + ! same dimensionally rescaled units. do m=1,CS%ensemble_size if (get_inc) then call redistribute_array(CS%mpp_domain, Ocean_increment%T(:,:,:,m),& @@ -525,29 +529,31 @@ subroutine oda(Time, CS) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) call get_posterior_tracer(Time, CS, increment=.true.) - if (CS%do_bias_adjustment) call get_bias_correction_tracer(Time, CS) + if (CS%do_bias_adjustment) call get_bias_correction_tracer(Time, CS%US, CS) endif return end subroutine oda -subroutine get_bias_correction_tracer(Time, CS) +subroutine get_bias_correction_tracer(Time, US, CS) type(time_type), intent(in) :: Time !< the current model time + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ODA_CS), pointer :: CS !< ocean DA control structure integer :: i,j,k - real, allocatable, dimension(:,:,:) :: T_bias, S_bias + real, allocatable, dimension(:,:,:) :: T_bias ! Temperature biases [C ~> degC] + real, allocatable, dimension(:,:,:) :: S_bias ! Salinity biases [C ~> degC] real, allocatable, dimension(:,:,:) :: mask_z real, allocatable, dimension(:), target :: z_in, z_edges_in real :: missing_value integer,dimension(3) :: fld_sz call cpu_clock_begin(id_clock_bias_adjustment) - call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& - mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) - call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& - mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id, Time, US%degC_to_C, CS%G, T_bias, & + mask_z, z_in, z_edges_in, missing_value, .true., .false., .false., .true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id, Time, US%ppt_to_S, CS%G, S_bias, & + mask_z, z_in, z_edges_in, missing_value, .true., .false., .false., .true.) ! This should be replaced to use mask_z instead of the following lines ! which are intended to zero land values using an arbitrary limit. @@ -555,8 +561,8 @@ subroutine get_bias_correction_tracer(Time, CS) do i=1,fld_sz(1) do j=1,fld_sz(2) do k=1,fld_sz(3) - if (T_bias(i,j,k) > 1.0E-3) T_bias(i,j,k) = 0.0 - if (S_bias(i,j,k) > 1.0E-3) S_bias(i,j,k) = 0.0 + if (T_bias(i,j,k) > 1.0E-3*US%degC_to_C) T_bias(i,j,k) = 0.0 + if (S_bias(i,j,k) > 1.0E-3*US%ppt_to_S) S_bias(i,j,k) = 0.0 enddo enddo enddo @@ -648,11 +654,11 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) integer :: i, j integer :: isc, iec, jsc, jec real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_inc !< an adjustment to the temperature - !! tendency [degC T-1 -> degC s-1] + !! tendency [C T-1 -> degC s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_inc !< an adjustment to the salinity - !! tendency [g kg-1 T-1 -> g kg-1 s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: T !< The updated temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: S !< The updated salinity [g kg-1] + !! tendency [S T-1 -> ppt s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: T !< The updated temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: S !< The updated salinity [S ~> ppt] real :: h_neglect, h_neglect_edge ! small thicknesses [H ~> m or kg m-2] if (.not. associated(CS)) return @@ -690,8 +696,8 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) call pass_var(T_inc, G%Domain) call pass_var(S_inc, G%Domain) - tv%T(isc:iec,jsc:jec,:)=tv%T(isc:iec,jsc:jec,:)+T_inc(isc:iec,jsc:jec,:)*dt - tv%S(isc:iec,jsc:jec,:)=tv%S(isc:iec,jsc:jec,:)+S_inc(isc:iec,jsc:jec,:)*dt + tv%T(isc:iec,jsc:jec,:) = tv%T(isc:iec,jsc:jec,:) + T_inc(isc:iec,jsc:jec,:)*dt + tv%S(isc:iec,jsc:jec,:) = tv%S(isc:iec,jsc:jec,:) + S_inc(isc:iec,jsc:jec,:)*dt call pass_var(tv%T, G%Domain) call pass_var(tv%S, G%Domain) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 3477938746..a627314336 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -57,7 +57,7 @@ module MOM_bulk_mixed_layer !! If the value is small enough, this should not affect the solution. real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: dT_dS_wt !< When forced to extrapolate T & S to match the - !! layer densities, this factor (in degC / ppt) is + !! layer densities, this factor [C S-1 ~> degC ppt-1] is !! combined with the derivatives of density with T & S !! to determines what direction is orthogonal to !! density contours. It should be a typical value of @@ -119,7 +119,7 @@ module MOM_bulk_mixed_layer real :: Allowed_T_chg !< The amount by which temperature is allowed !! to exceed previous values during detrainment, K. real :: Allowed_S_chg !< The amount by which salinity is allowed - !! to exceed previous values during detrainment, ppt. + !! to exceed previous values during detrainment [S ~> ppt] ! These are terms in the mixed layer TKE budget, all in [Z L2 T-3 ~> m3 s-3] except as noted. real, allocatable, dimension(:,:) :: & @@ -212,8 +212,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! will be used to hold the new mixed layer properties. real, dimension(SZI_(G),SZK0_(GV)) :: & h, & ! The layer thickness [H ~> m or kg m-2]. - T, & ! The layer temperatures [degC]. - S, & ! The layer salinities [ppt]. + T, & ! The layer temperatures [C ~> degC]. + S, & ! The layer salinities [S ~> ppt]. R0, & ! The potential density referenced to the surface [R ~> kg m-3]. Rcv ! The coordinate variable potential density [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)) :: & @@ -243,9 +243,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Rcv_tot, & ! The integrated coordinate value potential density of the ! layers that are fully entrained [H R ~> kg m-2 or kg2 m-5]. Ttot, & ! The integrated temperature of layers which are fully - ! entrained [degC H ~> degC m or degC kg m-2]. + ! entrained [C H ~> degC m or degC kg m-2]. Stot, & ! The integrated salt of layers which are fully entrained - ! [H ppt ~> m ppt or ppt kg m-2]. + ! [H S ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in the vhtot, & ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. @@ -254,28 +254,28 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! ocean over a time step [H ~> m or kg m-2]. NetMassOut, & ! The mass flux (if non-Boussinesq) or volume flux (if Boussinesq) ! 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 [degC H ~> degC m or degC 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, ppt H. + 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]. p_ref_cv, & ! Reference pressure for the potential density which defines ! the coordinate variable, set to P_Ref [R L2 T-2 ~> Pa]. dR0_dT, & ! Partial derivative of the mixed layer potential density with - ! temperature [R degC-1 ~> kg m-3 degC-1]. + ! temperature [R C-1 ~> kg m-3 degC-1]. dRcv_dT, & ! Partial derivative of the coordinate variable potential - ! density in the mixed layer with temperature [R degC-1 ~> kg m-3 degC-1]. + ! density in the mixed layer with temperature [R C-1 ~> kg m-3 degC-1]. dR0_dS, & ! Partial derivative of the mixed layer potential density with - ! salinity [R ppt-1 ~> kg m-3 ppt-1]. + ! salinity [R S-1 ~> kg m-3 ppt-1]. dRcv_dS, & ! Partial derivative of the coordinate variable potential - ! density in the mixed layer with salinity [R ppt-1 ~> kg m-3 ppt-1]. + ! density in the mixed layer with salinity [R S-1 ~> kg m-3 ppt-1]. TKE_river ! The source of turbulent kinetic energy available for mixing ! at rivermouths [Z L2 T-3 ~> m3 s-3]. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated - ! over a time step in each band [degC H ~> degC m or degC kg m-2]. + ! over a time step in each band [C H ~> degC m or degC kg m-2]. real, dimension(max(CS%nsw,1),SZI_(G),SZK_(GV)) :: & opacity_band ! The opacity in each band [H-1 ~> m-1 or m2 kg-1]. The indicies are band, i, k. @@ -488,8 +488,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! We aggregate the thermodynamic forcing for a time step into the following: ! netMassInOut = water [H ~> m or kg m-2] added/removed via surface fluxes ! netMassOut = water [H ~> m or kg m-2] removed via evaporating surface fluxes - ! net_heat = heat via surface fluxes [degC H ~> degC m or degC kg m-2] - ! net_salt = salt via surface fluxes [ppt H ~> ppt m or gSalt m-2] + ! net_heat = heat via surface fluxes [C H ~> degC m or degC kg m-2] + ! net_salt = salt via surface fluxes [S H ~> ppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & @@ -505,7 +505,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! Now the mixed layer undergoes mechanically forced entrainment. ! The mixed layer may entrain down to the Monin-Obukhov depth if the - ! surface is becoming lighter, and is effecti1336vely detraining. + ! surface is becoming lighter, and is effectively detraining. ! First the TKE at the depth of free convection that is available ! to drive mixing is calculated. @@ -760,7 +760,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! surface pressure [R ~> kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential !! density [R ~> kg m-3]. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures [degC]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures [C ~> degC]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The negligibly small amount of water !! that will be left in each layer [H ~> m or kg m-2]. @@ -788,9 +788,9 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Rcv_tot, & ! The integrated coordinate value potential density of the ! layers that are fully entrained [H R ~> kg m-2 or kg2 m-5]. Ttot, & ! The integrated temperature of layers which are fully - ! entrained [degC H ~> degC m or degC kg m-2]. + ! entrained [C H ~> degC m or degC kg m-2]. Stot, & ! The integrated salt of layers which are fully entrained - ! [H ppt ~> m ppt or ppt kg m-2]. + ! [H S ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in vhtot, & ! the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. KE_orig, & ! The total mean kinetic energy per unit area in the mixed layer before @@ -890,9 +890,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! Positive values go with mass gain by a layer. real, dimension(SZI_(G)), intent(out) :: htot !< The accumulated mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(out) :: Ttot !< The depth integrated mixed layer temperature - !! [degC H ~> degC m or degC kg m-2]. + !! [C H ~> degC m or degC kg m-2]. real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer salinity - !! [ppt H ~> ppt m or ppt kg m-2]. + !! [S H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(out) :: uhtot !< The depth integrated mixed layer zonal !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer meridional @@ -906,7 +906,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: v !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK0_(GV)), & - intent(in) :: T !< Layer temperatures [degC]. + intent(in) :: T !< Layer temperatures [C ~> degC]. real, dimension(SZI_(G),SZK0_(GV)), & intent(in) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK0_(GV)), & @@ -919,28 +919,28 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & intent(in) :: eps !< The negligibly small amount of water !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to - !! temperature [R degC-1 ~> kg m-3 degC-1]. + !! temperature [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to - !! temperature [R degC-1 ~> kg m-3 degC-1]. + !! temperature [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of R0 with respect to - !! salinity [R ppt-1 ~> kg m-3 ppt-1]. + !! salinity [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of Rcv with respect to - !! salinity [R ppt-1 ~> kg m-3 ppt-1]. + !! salinity [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: netMassInOut !< The net mass flux (if non-Boussinesq) !! or volume flux (if Boussinesq) into the ocean !! within a time step [H ~> m or kg m-2]. (I.e. P+R-E.) real, dimension(SZI_(G)), intent(in) :: netMassOut !< The mass or volume flux out of the ocean !! within a time step [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: Net_heat !< The net heating at the surface over a time - !! step [degC H ~> degC m or degC kg m-2]. Any penetrating + !! step [C H ~> degC m or degC kg m-2]. Any penetrating !! shortwave radiation is not included in Net_heat. real, dimension(SZI_(G)), intent(in) :: Net_salt !< The net surface salt flux into the ocean - !! over a time step [ppt H ~> ppt m or ppt kg m-2]. + !! over a time step [S H ~> ppt m or ppt kg m-2]. integer, intent(in) :: nsw !< The number of bands of penetrating !! shortwave radiation. real, dimension(max(nsw,1),SZI_(G)), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave !! heating at the sea surface in each penetrating - !! band [degC H ~> degC m or degC kg m-2]. + !! band [degC H ~> C m or degC kg m-2]. real, dimension(max(nsw,1),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< The opacity in each band of !! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(out) :: Conv_En !< The buoyant turbulent kinetic energy source @@ -975,11 +975,11 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: SW_trans ! The fraction of shortwave radiation ! that is not absorbed in a layer [nondim]. real :: Pen_absorbed ! The amount of penetrative shortwave radiation - ! that is absorbed in a layer [degC H ~> degC m or degC kg m-2]. + ! that is absorbed in a layer [C H ~> degC m or degC kg m-2]. real :: h_avail ! The thickness in a layer available for ! entrainment [H ~> m or kg m-2]. real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. - real :: T_precip ! The temperature of the precipitation [degC]. + real :: T_precip ! The temperature of the precipitation [C ~> degC]. real :: C1_3, C1_6 ! 1/3 and 1/6. real :: En_fn, Frac, x1 ! Nondimensional temporary variables. real :: dr, dr0 ! Temporary variables [R H ~> kg m-2 or kg2 m-5]. @@ -1449,9 +1449,9 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! Positive values go with mass gain by a layer. real, dimension(SZI_(G)), intent(inout) :: htot !< The accumlated mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(inout) :: Ttot !< The depth integrated mixed layer temperature - !! [degC H ~> degC m or degC kg m-2]. + !! [C H ~> degC m or degC kg m-2]. real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity - !! [ppt H ~> ppt m or ppt kg m-2]. + !! [S H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(inout) :: uhtot !< The depth integrated mixed layer zonal !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer meridional @@ -1480,7 +1480,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to !! temperature [R degC-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to - !! temperature [R degC-1 ~> kg m-3 degC-1]. + !! temperature [R C-1 ~> kg m-3 degC-1]. real, dimension(2,SZI_(G)), intent(in) :: cMKE !< Coefficients of HpE and HpE^2 used in calculating the !! denominator of MKE_rate; the two elements have differing !! units of [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. @@ -1490,7 +1490,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! shortwave radiation. real, dimension(max(nsw,1),SZI_(G)), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave !! heating at the sea surface in each penetrating - !! band [degC H ~> degC m or degC kg m-2]. + !! band [C H ~> degC m or degC kg m-2]. real, dimension(max(nsw,1),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< The opacity in each band of !! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy @@ -1508,7 +1508,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: SW_trans ! The fraction of shortwave radiation that is not ! absorbed in a layer, nondimensional. real :: Pen_absorbed ! The amount of penetrative shortwave radiation - ! that is absorbed in a layer [degC H ~> degC m or degC kg m-2]. + ! that is absorbed in a layer [C H ~> degC m or degC kg m-2]. real :: h_avail ! The thickness in a layer available for entrainment [H ~> m or kg m-2]. real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. real :: h_min, h_max ! Limits on the solution for h_ent [H ~> m or kg m-2]. @@ -1856,19 +1856,19 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced !! to the surface with potential - !! temperature [R degC-1 ~> kg m-3 degC-1]. + !! temperature [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of !! cpotential density referenced !! to the surface with salinity, - !! [R ppt-1 ~> kg m-3 ppt-1]. + !! [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential !! density with potential - !! temperature [R degC-1 ~> kg m-3 degC-1]. + !! temperature [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of !! coordinate defining potential !! density with salinity, - !! [R ppt-1 ~> kg m-3 ppt-1]. + !! [R S-1 ~> kg m-3 ppt-1]. ! If there are no massive light layers above the deepest of the mixed- and ! buffer layers, do nothing (except perhaps to reshuffle these layers). @@ -2171,18 +2171,18 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced to the !! surface with potential temperature, - !! [R degC-1 ~> kg m-3 degC-1]. + !! [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of !! cpotential density referenced to the !! surface with salinity - !! [R ppt-1 ~> kg m-3 ppt-1]. + !! [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density !! with potential temperature, - !! [R degC-1 ~> kg m-3 degC-1]. + !! [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of !! coordinate defining potential density - !! with salinity [R ppt-1 ~> kg m-3 ppt-1]. + !! with salinity [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum !! detrainment permitted from the buffer !! layers [H ~> m or kg m-2]. @@ -2199,9 +2199,9 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: Rcv_to_bl ! The depth integrated amount of Rcv that is detrained to the ! buffer layer [H R ~> kg m-2 or kg2 m-5] real :: T_to_bl ! The depth integrated amount of T that is detrained to the - ! buffer layer [degC H ~> degC m or degC kg m-2] + ! buffer layer [C H ~> degC m or degC kg m-2] real :: S_to_bl ! The depth integrated amount of S that is detrained to the - ! buffer layer [ppt H ~> ppt m or ppt kg m-2] + ! buffer layer [S H ~> ppt m or ppt kg m-2] real :: h_min_bl ! The minimum buffer layer thickness [H ~> m or kg m-2]. real :: h1, h2 ! Scalar variables holding the values of @@ -2248,9 +2248,9 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! interior layers that are just lighter and ! just denser than the lower buffer layer. - real :: R0_det, T_det, S_det ! Detrained values of R0 [R ~> kg m-3], T [degC], and S [ppt]. - real :: Rcv_stays, R0_stays ! Values of Rcv and R0 that stay in a layer. - real :: T_stays, S_stays ! Values of T and S that stay in a layer. + real :: R0_det, T_det, S_det ! Detrained values of R0 [R ~> kg m-3], T [C ~> degC] and S [S ~> ppt] + real :: Rcv_stays, R0_stays ! Values of Rcv and R0 that stay in a layer [R ~> kg m-3] + real :: T_stays, S_stays ! Values of T and S that stay in a layer, [C ~> degC] and S [S ~> ppt] real :: dSpice_det, dSpice_stays! The spiciness difference between an original ! buffer layer and the water that moves into ! an interior layer or that stays in that @@ -2269,8 +2269,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: dPE_time_ratio ! Larger of 1 and the detrainment timescale over dt [nondim]. real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and ! salinity changes in defining spiciness, in - ! [degC ppt-1] and [ppt degC-1]. - real :: I_denom ! A work variable with units of [ppt2 R-2 ~> ppt2 m6 kg-2]. + ! [C S-1 ~> degC ppt-1] and [S C-1 ~> ppt degC-1]. + real :: I_denom ! A work variable with units of [S2 R-2 ~> ppt2 m6 kg-2]. real :: g_2 ! 1/2 g_Earth [L2 Z-1 T-2 ~> m s-2]. real :: Rho0xG ! Rho0 times G_Earth [R L2 Z-1 T-2 ~> kg m-2 s-2]. @@ -3065,10 +3065,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density !! with potential temperature - !! [R degC-1 ~> kg m-3 degC-1]. + !! [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of !! coordinate defining potential density - !! with salinity [R ppt-1 ~> kg m-3 ppt-1]. + !! with salinity [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum !! detrainment permitted from the buffer !! layers [H ~> m or kg m-2]. @@ -3081,8 +3081,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: detrain(SZI_(G)) ! The thickness of fluid to detrain ! from the mixed layer [H ~> m or kg m-2]. real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 - real :: I_denom ! A work variable [ppt2 R-2 ~> ppt2 m6 kg-2]. - real :: Sdown, Tdown + real :: I_denom ! A work variable [S2 R-2 ~> ppt2 m6 kg-2]. + real :: Sdown, Tdown ! A salinity [S ~> ppt] and a temperature [C ~> degC] real :: dt_Time ! The timestep divided by the detrainment timescale [nondim]. real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the mean density times the time @@ -3396,18 +3396,18 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "If true, limit the detrainment from the buffer layers "//& "to not be too different from the neighbors.", default=.false.) call get_param(param_file, mdl, "ALLOWED_DETRAIN_TEMP_CHG", CS%Allowed_T_chg, & - "The amount by which temperature is allowed to exceed "//& - "previous values during detrainment.", units="K", default=0.5) + "The amount by which temperature is allowed to exceed previous values "//& + "during detrainment.", units="K", default=0.5, scale=US%degC_to_C) call get_param(param_file, mdl, "ALLOWED_DETRAIN_SALT_CHG", CS%Allowed_S_chg, & - "The amount by which salinity is allowed to exceed "//& - "previous values during detrainment.", units="PSU", default=0.1) + "The amount by which salinity is allowed to exceed previous values "//& + "during detrainment.", units="PSU", default=0.1, scale=US%ppt_to_S) call get_param(param_file, mdl, "ML_DT_DS_WEIGHT", CS%dT_dS_wt, & "When forced to extrapolate T & S to match the layer "//& "densities, this factor (in deg C / PSU) is combined "//& "with the derivatives of density with T & S to determine "//& "what direction is orthogonal to density contours. It "//& - "should be a typical value of (dR/dS) / (dR/dT) in "//& - "oceanic profiles.", units="degC PSU-1", default=6.0) + "should be a typical value of (dR/dS) / (dR/dT) in oceanic profiles.", & + units="degC PSU-1", default=6.0, scale=US%degC_to_C*US%S_to_ppt) call get_param(param_file, mdl, "BUFFER_LAYER_EXTRAP_LIMIT", CS%BL_extrap_lim, & "A limit on the density range over which extrapolation "//& "can occur when detraining from the buffer layers, "//& diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 3fca484349..ce19609210 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -26,7 +26,7 @@ module MOM_geothermal logical :: initialized = .false. !< True if this control structure has been initialized. real :: dRcv_dT_inplace !< The value of dRcv_dT above which (dRcv_dT is negative) the !! water is heated in place instead of moving upward between - !! layers in non-ALE layered mode [R degC-1 ~> kg m-3 degC-1] + !! layers in non-ALE layered mode [R C-1 ~> kg m-3 degC-1] real, allocatable, dimension(:,:) :: geo_heat !< The geothermal heat flux [Q R Z T-1 ~> W m-2] real :: geothermal_thick !< The thickness over which geothermal heating is !! applied [H ~> m or kg m-2] @@ -72,40 +72,40 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) integer, optional, intent(in) :: halo !< Halo width over which to work ! Local variables real, dimension(SZI_(G)) :: & - heat_rem, & ! remaining heat [H degC ~> m degC or kg degC m-2] + heat_rem, & ! remaining heat [H C ~> m degC or kg degC m-2] h_geo_rem, & ! remaining thickness to apply geothermal heating [H ~> m or kg m-2] Rcv_BL, & ! coordinate density in the deepest variable density layer [R ~> kg m-3] p_ref ! coordinate densities reference pressure [R L2 T-2 ~> Pa] real, dimension(2) :: & - T2, S2, & ! temp and saln in the present and target layers [degC] and [ppt] - dRcv_dT_, & ! partial derivative of coordinate density wrt temp [R degC-1 ~> kg m-3 degC-1] - dRcv_dS_ ! partial derivative of coordinate density wrt saln [R ppt-1 ~> kg m-3 ppt-1] + T2, S2, & ! temp and saln in the present and target layers [C ~> degC] and [S ~> ppt] + dRcv_dT_, & ! partial derivative of coordinate density wrt temp [R C-1 ~> kg m-3 degC-1] + dRcv_dS_ ! partial derivative of coordinate density wrt saln [R S-1 ~> kg m-3 ppt-1] real :: Angstrom, H_neglect ! small thicknesses [H ~> m or kg m-2] real :: Rcv ! coordinate density of present layer [R ~> kg m-3] real :: Rcv_tgt ! coordinate density of target layer [R ~> kg m-3] real :: dRcv ! difference between Rcv and Rcv_tgt [R ~> kg m-3] real :: dRcv_dT ! partial derivative of coordinate density wrt temp - ! in the present layer [R degC-1 ~> kg m-3 degC-1]; usually negative + ! in the present layer [R C-1 ~> kg m-3 degC-1]; usually negative real :: h_heated ! thickness that is being heated [H ~> m or kg m-2] - real :: heat_avail ! heating available for the present layer [degC H ~> degC m or degC kg m-2] + real :: heat_avail ! heating available for the present layer [C H ~> degC m or degC kg m-2] real :: heat_in_place ! heating to warm present layer w/o movement between layers - ! [degC H ~> degC m or degC kg m-2] + ! [C H ~> degC m or degC kg m-2] real :: heat_trans ! heating available to move water from present layer to target - ! layer [degC H ~> degC m or degC kg m-2] + ! layer [C H ~> degC m or degC kg m-2] real :: heating ! heating used to move water from present layer to target layer - ! [degC H ~> degC m or degC kg m-2] + ! [C H ~> degC m or degC kg m-2] ! 0 <= heating <= heat_trans real :: h_transfer ! thickness moved between layers [H ~> m or kg m-2] real :: wt_in_place ! relative weighting that goes from 0 to 1 [nondim] real :: I_h ! inverse thickness [H-1 ~> m-1 or m2 kg-1] - real :: dTemp ! temperature increase in a layer [degC] + real :: dTemp ! temperature increase in a layer [C ~> degC] real :: Irho_cp ! inverse of heat capacity per unit layer volume - ! [degC H Q-1 R-1 Z-1 ~> degC m3 J-1 or degC kg J-1] + ! [C H Q-1 R-1 Z-1 ~> degC m3 J-1 or degC kg J-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - T_old, & ! Temperature of each layer before any heat is added, for diagnostics [degC] + T_old, & ! Temperature of each layer before any heat is added, for diagnostics [C ~> degC] h_old, & ! Thickness of each layer before any heat is added, for diagnostics [H ~> m or kg m-2] work_3d ! Scratch variable used to calculate changes due to geothermal real :: Idt ! inverse of the timestep [T-1 ~> s-1] @@ -373,17 +373,17 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) ! Local variables real, dimension(SZI_(G)) :: & - heat_rem, & ! remaining heat [H degC ~> m degC or kg degC m-2] + heat_rem, & ! remaining heat [H C ~> m degC or kg degC m-2] h_geo_rem ! remaining thickness to apply geothermal heating [H ~> m or kg m-2] real :: Angstrom, H_neglect ! small thicknesses [H ~> m or kg m-2] - real :: heat_here ! heating applied to the present layer [degC H ~> degC m or degC kg m-2] - real :: dTemp ! temperature increase in a layer [degC] + real :: heat_here ! heating applied to the present layer [C H ~> degC m or degC kg m-2] + real :: dTemp ! temperature increase in a layer [C ~> degC] real :: Irho_cp ! inverse of heat capacity per unit layer volume - ! [degC H Q-1 R-1 Z-1 ~> degC m3 J-1 or degC kg J-1] + ! [C H Q-1 R-1 Z-1 ~> degC m3 J-1 or degC kg J-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - dTdt_diag ! Diagnostic of temperature tendency [degC T-1 ~> degC s-1] which might be + dTdt_diag ! Diagnostic of temperature tendency [C T-1 ~> degC s-1] which might be ! converted into a layer-integrated heat tendency [Q R Z T-1 ~> W m-2] real :: Idt ! inverse of the timestep [T-1 ~> s-1] logical :: do_any ! True if there is more to be done on the current j-row. @@ -475,7 +475,7 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) if (CS%id_internal_heat_heat_tendency > 0) then do k=1,nz ; do j=js,je ; do i=is,ie ! Dangerously reuse dTdt_diag for a related variable with different units, going from - ! units of [degC T-1 ~> degC s-1] to units of [Q R Z T-1 ~> W m-2] + ! units of [C T-1 ~> degC s-1] to units of [Q R Z T-1 ~> W m-2] dTdt_diag(i,j,k) = (GV%H_to_RZ*tv%C_p) * (h(i,j,k) * dTdt_diag(i,j,k)) enddo ; enddo ; enddo call post_data(CS%id_internal_heat_heat_tendency, dTdt_diag, CS%diag, alt_h=h) @@ -537,7 +537,7 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith "The value of drho_dT above which geothermal heating "//& "simply heats water in place instead of moving it between "//& "isopycnal layers. This must be negative.", & - units="kg m-3 K-1", scale=US%kg_m3_to_R, default=-0.01, & + units="kg m-3 K-1", scale=US%kg_m3_to_R*US%C_to_degC, default=-0.01, & do_not_log=((GV%nk_rho_varies<=0).or.(GV%nk_rho_varies>=GV%ke)) ) if (CS%dRcv_dT_inplace >= 0.0) call MOM_error(FATAL, "geothermal_init: "//& "GEOTHERMAL_DRHO_DT_INPLACE must be negative.") @@ -580,7 +580,7 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith CS%id_internal_heat_temp_tendency=register_diag_field('ocean_model', & 'internal_heat_temp_tendency', diag%axesTL, Time, & 'Temperature tendency (in 3D) due to internal (geothermal) sources', & - 'degC s-1', conversion=US%s_to_T, v_extensive=.true.) + 'degC s-1', conversion=US%C_to_degC*US%s_to_T, v_extensive=.true.) if (.not.useALEalgorithm) then ! Do not offer this diagnostic if heating will be in place. CS%id_internal_heat_h_tendency=register_diag_field('ocean_model', & diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index d6d2e10393..31adc9d446 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -554,11 +554,11 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l !! shortwave that should be absorbed by !! each layer. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer potential/conservative - !! temperatures [degC] + !! temperatures [C ~> degC] real, dimension(max(1,nsw),SZI_(G)), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in !! each band that hits the bottom and will !! will be redistributed through the water - !! column [degC H ~> degC m or degC kg m-2], + !! column [C H ~> degC m or degC kg m-2], !! size nsw x SZI_(G). real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: eps !< Small thickness that must remain in !! each layer, and which will not be @@ -566,7 +566,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l integer, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: ksort !< Density-sorted k-indices. real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer - !! temperature [degC H ~> degC m or degC kg m-2] + !! temperature [C H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: dSV_dT !< The partial derivative of specific volume !! with temperature [R-1 degC-1 ~> m3 kg-1 degC-1] real, dimension(SZI_(G),SZK_(GV)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating @@ -575,7 +575,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & T_chg_above ! A temperature change that will be applied to all the thick - ! layers above a given layer [degC]. This is only nonzero if + ! layers above a given layer [C ~> degC]. This is only nonzero if ! adjustAbsorptionProfile is true, in which case the net ! change in the temperature of a layer is the sum of the ! direct heating of that layer plus T_chg_above from all of @@ -585,10 +585,10 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l h_heat, & ! The thickness of the water column that will be heated by ! any remaining shortwave radiation [H ~> m or kg m-2]. T_chg, & ! The temperature change of thick layers due to the remaining - ! shortwave radiation and contributions from T_chg_above [degC]. + ! shortwave radiation and contributions from T_chg_above [C ~> degC]. Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave ! heating that hits the bottom and will be redistributed through - ! the water column [degC H ~> degC m or degC kg m-2] + ! the water column [C H ~> degC m or degC kg m-2] real :: SW_trans ! fraction of shortwave radiation that is not ! absorbed in a layer [nondim] real :: unabsorbed ! fraction of the shortwave radiation that @@ -600,13 +600,13 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real :: exp_OD ! exp(-opt_depth) [nondim] real :: heat_bnd ! heating due to absorption in the current ! layer by the current band, including any piece that - ! is moved upward [degC H ~> degC m or degC kg m-2] + ! is moved upward [C H ~> degC m or degC kg m-2] real :: SWa ! fraction of the absorbed shortwave that is ! moved to layers above with adjustAbsorptionProfile [nondim] real :: coSWa_frac ! The fraction of SWa that is actually moved upward. real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply ! absorbed in the next layer for computational efficiency, instead of - ! continuing to penetrate [degC H ~> degC m or degC kg m-2]. + ! continuing to penetrate [C H ~> degC m or degC kg m-2]. real :: I_Habs ! The inverse of the absorption length for a minimal flux [H-1 ~> m-1 or m2 kg-1] real :: epsilon ! A small thickness that must remain in each ! layer, and which will not be subject to heating [H ~> m or kg m-2] @@ -811,21 +811,21 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & !! radiation is absorbed in the ocean water column. real, dimension(max(nsw,1),SZI_(G)), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave !! in each band at the sea surface; size nsw x SZI_(G) - !! [degC H ~> degC m or degC kg m-2]. + !! [C H ~> degC m or degC kg m-2]. real, dimension(SZI_(G),SZK_(GV)+1), & intent(inout) :: netPen !< Net penetrating shortwave heat flux at each !! interface, summed across all bands - !! [degC H ~> degC m or degC kg m-2]. + !! [C H ~> degC m or degC kg m-2]. ! Local variables real :: h_heat(SZI_(G)) ! thickness of the water column that receives ! remaining shortwave radiation [H ~> m or kg m-2]. real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the ! penetrating shortwave heating that hits the bottom ! and will be redistributed through the water column - ! [degC H ~> degC m or degC kg m-2] + ! [C H ~> degC m or degC kg m-2] real, dimension(max(nsw,1),SZI_(G)) :: Pen_SW_bnd ! The remaining penetrating shortwave radiation - ! in each band, initially iPen_SW_bnd [degC H ~> degC m or degC kg m-2] + ! in each band, initially iPen_SW_bnd [C H ~> degC m or degC kg m-2] real :: SW_trans ! fraction of shortwave radiation not ! absorbed in a layer [nondim] real :: unabsorbed ! fraction of the shortwave radiation @@ -834,7 +834,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply ! absorbed in the next layer for computational efficiency, instead of - ! continuing to penetrate [degC H ~> degC m or degC kg m-2]. + ! continuing to penetrate [C H ~> degC m or degC kg m-2]. real :: I_Habs ! The inverse of the absorption length for a minimal flux [H-1 ~> m-1 or m2 kg-1] real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] real :: opt_depth ! optical depth of a layer [nondim] @@ -1070,7 +1070,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) "the next sufficiently thick layers for computational efficiency, instead of "//& "continuing to penetrate. The default, 2.5e-11 degC m s-1, is about 1e-4 W m-2 "//& "or 0.08 degC m century-1, but 0 is also a valid value.", & - default=2.5e-11, units="degC m s-1", scale=GV%m_to_H*US%T_to_s) + default=2.5e-11, units="degC m s-1", scale=US%degC_to_C*GV%m_to_H*US%T_to_s) if (optics%answers_2018) then ; PenSW_minthick_dflt = 0.001 ; else ; PenSW_minthick_dflt = 1.0 ; endif call get_param(param_file, mdl, "PEN_SW_ABSORB_MINTHICK", PenSW_absorb_minthick, & diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index c0e10c2413..0a56925516 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -637,9 +637,9 @@ subroutine update_offline_from_files(G, GV, US, nk_input, mean_file, sum_file, s real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: temp_mean !< Averaged temperature [degC] + intent(inout) :: temp_mean !< Averaged temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: salt_mean !< Averaged salinity [ppt] + intent(inout) :: salt_mean !< Averaged salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G)), & intent(inout) :: mld !< Averaged mixed layer depth [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & @@ -682,9 +682,9 @@ subroutine update_offline_from_files(G, GV, US, nk_input, mean_file, sum_file, s call MOM_read_data(snap_file, 'h_end', h_end(:,:,1:nk_input), G%Domain, & timelevel=ridx_snap, position=CENTER, scale=convert_to_H) call MOM_read_data(mean_file, 'temp', temp_mean(:,:,1:nk_input), G%Domain, & - timelevel=ridx_sum,position=CENTER) + timelevel=ridx_sum, position=CENTER, scale=US%degC_to_C) call MOM_read_data(mean_file, 'salt', salt_mean(:,:,1:nk_input), G%Domain, & - timelevel=ridx_sum,position=CENTER) + timelevel=ridx_sum, position=CENTER, scale=US%ppt_to_S) ! Fill temperature and salinity downward from the deepest input data. do k=nk_input+1,nz ; do j=js,je ; do i=is,ie @@ -777,10 +777,10 @@ subroutine update_offline_from_arrays(G, GV, nk_input, ridx_sum, mean_file, sum_ real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes [H L2 ~> m3 or kg] real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness !! [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: temp !< Temperature array - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: salt !< Salinity array - real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array - real, dimension(:,:,:,:), allocatable, intent(inout) :: salt_all !< Salinity array + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: temp !< Temperature array [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: salt !< Salinity array [ppt ~> S] + real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array [C ~> degC] + real, dimension(:,:,:,:), allocatable, intent(inout) :: salt_all !< Salinity array [ppt ~> S] integer :: i, j, k, is, ie, js, je, nz real, parameter :: fill_value = 0. diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 60267aa597..cd1572a05f 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -177,8 +177,8 @@ module MOM_offline_main real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport [H L2 ~> m3 or kg] real, allocatable, dimension(:,:,:,:) :: vhtr_all !< Entire field of meridional transport [H L2 ~> m3 or kg] real, allocatable, dimension(:,:,:,:) :: hend_all !< Entire field of layer thicknesses [H ~> m or kg m-2] - real, allocatable, dimension(:,:,:,:) :: temp_all !< Entire field of temperatures [degC] - real, allocatable, dimension(:,:,:,:) :: salt_all !< Entire field of salinities [ppt] + real, allocatable, dimension(:,:,:,:) :: temp_all !< Entire field of temperatures [C ~> degC] + real, allocatable, dimension(:,:,:,:) :: salt_all !< Entire field of salinities [S ~> ppt] end type offline_transport_CS @@ -1015,8 +1015,8 @@ subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) call uvchksum("[uv]htr before update_offline_fields", CS%uhtr, CS%vhtr, G%HI, & scale=US%L_to_m**2*GV%H_to_kg_m2) call hchksum(CS%h_end, "h_end before update_offline_fields", G%HI, scale=GV%H_to_m) - call hchksum(CS%tv%T, "Temp before update_offline_fields", G%HI) - call hchksum(CS%tv%S, "Salt before update_offline_fields", G%HI) + call hchksum(CS%tv%T, "Temp before update_offline_fields", G%HI, scale=US%C_to_degC) + call hchksum(CS%tv%S, "Salt before update_offline_fields", G%HI, scale=US%S_to_ppt) endif ! Store a copy of the layer thicknesses before ALE regrid/remap @@ -1036,8 +1036,8 @@ subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) if (CS%debug) then call uvchksum("[uv]h after update offline from files and arrays", CS%uhtr, CS%vhtr, G%HI, & scale=US%L_to_m**2*GV%H_to_kg_m2) - call hchksum(CS%tv%T, "Temp after update offline from files and arrays", G%HI) - call hchksum(CS%tv%S, "Salt after update offline from files and arrays", G%HI) + call hchksum(CS%tv%T, "Temp after update offline from files and arrays", G%HI, scale=US%C_to_degC) + call hchksum(CS%tv%S, "Salt after update offline from files and arrays", G%HI, scale=US%S_to_ppt) endif ! If using an ALE-dependent vertical coordinate, fields will need to be remapped @@ -1099,8 +1099,8 @@ subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) call uvchksum("[uv]htr after update_offline_fields", CS%uhtr, CS%vhtr, G%HI, & scale=US%L_to_m**2*GV%H_to_kg_m2) call hchksum(CS%h_end, "h_end after update_offline_fields", G%HI, scale=GV%H_to_m) - call hchksum(CS%tv%T, "Temp after update_offline_fields", G%HI) - call hchksum(CS%tv%S, "Salt after update_offline_fields", G%HI) + call hchksum(CS%tv%T, "Temp after update_offline_fields", G%HI, scale=US%C_to_degC) + call hchksum(CS%tv%S, "Salt after update_offline_fields", G%HI, scale=US%S_to_ppt) endif call callTree_leave("update_offline_fields") @@ -1170,9 +1170,11 @@ subroutine register_diags_offline_transport(Time, diag, CS, GV, US) 'Meridional mass transport regridded/remapped onto offline grid', & 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_temp_regrid = register_diag_field('ocean_model', 'temp_regrid', diag%axesTL, Time, & - 'Temperature regridded/remapped onto offline grid','C') + 'Temperature regridded/remapped onto offline grid',& + 'C', conversion=US%C_to_degC) CS%id_salt_regrid = register_diag_field('ocean_model', 'salt_regrid', diag%axesTL, Time, & - 'Salinity regridded/remapped onto offline grid','g kg-1') + 'Salinity regridded/remapped onto offline grid', & + 'g kg-1', conversion=US%S_to_ppt) CS%id_h_regrid = register_diag_field('ocean_model', 'h_regrid', diag%axesTL, Time, & 'Layer thicknesses regridded/remapped onto offline grid', & 'm', conversion=GV%H_to_m) @@ -1498,9 +1500,9 @@ subroutine read_all_input(CS, G, GV, US) call MOM_read_data(CS%snap_file,'h_end', CS%hend_all(:,:,1:CS%nk_input,t), G%Domain, & timelevel=t, position=CENTER, scale=GV%kg_m2_to_H) call MOM_read_data(CS%mean_file,'temp', CS%temp_all(:,:,1:CS%nk_input,t), G%Domain, & - timelevel=t, position=CENTER) + timelevel=t, position=CENTER, scale=US%degC_to_C) call MOM_read_data(CS%mean_file,'salt', CS%salt_all(:,:,1:CS%nk_input,t), G%Domain, & - timelevel=t, position=CENTER) + timelevel=t, position=CENTER, scale=US%ppt_to_S) enddo endif diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 7a2c64855f..d5c3851b60 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -272,33 +272,36 @@ end function tracer_Z_init !> Layer model routine for remapping tracers from pseudo-z coordinates into layers defined !! by target interface positions. subroutine tracer_z_init_array(tr_in, z_edges, nk_data, e, land_fill, G, nlay, nlevs, & - eps_z, tr) + eps_z, tr, scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure integer, intent(in) :: nk_data !< The number of levels in the input data real, dimension(SZI_(G),SZJ_(G),nk_data), & - intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in. + intent(in) :: tr_in !< The z-space array of tracer concentrations + !! that is read in [A] real, dimension(nk_data+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data - !! [Z ~> m or m] - integer, intent(in) :: nlay !< The number of vertical layers in the target grid + !! [Z ~> m or m] + integer, intent(in) :: nlay !< The number of vertical layers in the target grid real, dimension(SZI_(G),SZJ_(G),nlay+1), & - intent(in) :: e !< The depths of the target layer interfaces [Z ~> m or m] - real, intent(in) :: land_fill !< fill in data over land (1) + intent(in) :: e !< The depths of the target layer interfaces [Z ~> m] or [m] + real, intent(in) :: land_fill !< fill in data over land [A] integer, dimension(SZI_(G),SZJ_(G)), & intent(in) :: nlevs !< The number of input levels with valid data real, intent(in) :: eps_z !< A negligibly thin layer thickness [Z ~> m]. real, dimension(SZI_(G),SZJ_(G),nlay), & - intent(out) :: tr !< tracers in layer space + intent(out) :: tr !< tracers in model space [B] + real, optional, intent(in) :: scale !< A factor by which to scale the output tracers from the + !! input tracers [B A-1 ~> 1] ! Local variables - real, dimension(nk_data) :: tr_1d !< a copy of the input tracer concentrations in a column. - real, dimension(nlay+1) :: e_1d ! A 1-d column of intreface heights, in the same units as e. + real :: tr_1d(nk_data) ! A copy of the input tracer concentrations in a column [A] + real :: e_1d(nlay+1) ! A 1-d column of interface heights, in the same units as e [Z ~> m] or [m] + real :: sl_tr ! The tracer concentration slope times the layer thickness, in tracer units [A] + real :: wt(nk_data) ! The fractional weight for each layer in the range between z1 and z2 [nondim] + real :: z1(nk_data) ! z1 and z2 are the fractional depths of the top and bottom + real :: z2(nk_data) ! limits of the part of a z-cell that contributes to a layer, relative + ! to the cell center and normalized by the cell thickness [nondim]. + ! Note that -1/2 <= z1 <= z2 <= 1/2. integer :: k_top, k_bot, k_bot_prev, kstart - real :: sl_tr ! The tracer concentration slope times the layer thickness, in tracer units. - real, dimension(nk_data) :: wt !< The fractional weight for each layer in the range between z1 and z2 - real, dimension(nk_data) :: z1, z2 ! z1 and z2 are the fractional depths of the top and bottom - ! limits of the part of a z-cell that contributes to a layer, relative - ! to the cell center and normalized by the cell thickness [nondim]. - ! Note that -1/2 <= z1 <= z2 <= 1/2. integer :: i, j, k, kz, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -369,6 +372,12 @@ subroutine tracer_z_init_array(tr_in, z_edges, nk_data, e, land_fill, G, nlay, n enddo i_loop enddo + if (present(scale)) then ; if (scale /= 1.0) then + do k=1,nlay ; do j=js,je ; do i=is,ie + tr(i,j,k) = scale*tr(i,j,k) + enddo ; enddo ; enddo + endif ; endif + end subroutine tracer_z_init_array !> This subroutine reads the vertical coordinate data for a field from a NetCDF file. @@ -555,9 +564,9 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: temp !< potential temperature [degC] + intent(inout) :: temp !< potential temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: salt !< salinity [ppt] + intent(inout) :: salt !< salinity [S ~> ppt] real, dimension(SZK_(GV)), intent(in) :: R_tgt !< desired potential density [R ~> kg m-3]. real, intent(in) :: p_ref !< reference pressure [R L2 T-2 ~> Pa]. integer, intent(in) :: niter !< maximum number of iterations @@ -571,36 +580,48 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, real, optional, intent(in) :: h_massless !< A threshold below which a layer is !! determined to be massless [H ~> m or kg m-2] - real, parameter :: T_max = 31.0, T_min = -2.0 ! Local variables (All of which need documentation!) real, dimension(SZI_(G),SZK_(GV)) :: & - T, S, dT, dS, & - rho, & ! Layer densities [R ~> kg m-3] - hin, & ! Input layer thicknesses [H ~> m or kg m-2] - drho_dT, & ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - drho_dS ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + T, & ! A 2-d working copy of the layer temperatures [C ~> degC] + S, & ! A 2-d working copy of the layer salinities [S ~> ppt] + dT, & ! An estimated change in temperature before bounding [C ~> degC] + dS, & ! An estimated change in salinity before bounding [S ~> ppt] + rho, & ! Layer densities with the current estimate of temperature and salinity [R ~> kg m-3] + hin, & ! A 2D copy of the layer thicknesses [H ~> m or kg m-2] + drho_dT, & ! Partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + drho_dS ! Partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] real, dimension(SZI_(G)) :: press ! Reference pressures [R L2 T-2 ~> Pa] - real :: dT_dS_gauge ! The relative penalizing of temperature to salinity changes when - ! minimizing property changes while correcting density [degC ppt-1]. - real :: I_denom ! The inverse of the magnitude squared of the density gradient in - ! T-S space streched with dT_dS_gauge [ppt2 R-2 ~> ppt2 m6 kg-2] + real :: dT_dS_gauge ! The relative penalizing of temperature to salinity changes when + ! minimizing property changes while correcting density [C S-1 ~> degC ppt-1]. + real :: I_denom ! The inverse of the magnitude squared of the density gradient in + ! T-S space when stretched with dT_dS_gauge [S2 R-2 ~> ppt2 m6 kg-2] + real :: T_min, T_max ! The minimum and maximum temperatures [C ~> degC] + real :: S_min, S_max ! Minimum and maximum salinities [S ~> ppt] + real :: tol_T ! The tolerance for temperature matches [C ~> degC] + real :: tol_S ! The tolerance for salinity matches [S ~> ppt] + real :: tol_rho ! The tolerance for density matches [R ~> kg m-3] + real :: max_t_adj ! The largest permitted temperature changes with each iteration + ! when old_fit is true [C ~> degC] + real :: max_s_adj ! The largest permitted salinity changes with each iteration + ! when old_fit is true [S ~> ppt] logical :: adjust_salt, old_fit - real :: S_min, S_max - real :: tol_T ! The tolerance for temperature matches [degC] - real :: tol_S ! The tolerance for salinity matches [ppt] - real :: tol_rho ! The tolerance for density matches [R ~> kg m-3] - real :: max_t_adj, max_s_adj integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! These hard coded parameters need to be set properly. - S_min = 0.5 ; S_max = 65.0 - max_t_adj = 1.0 ; max_s_adj = 0.5 - tol_T=1.e-4 ; tol_S=1.e-4 ; tol_rho = 1.e-4*US%kg_m3_to_R + S_min = 0.5*US%ppt_to_S ; S_max = 65.0*US%ppt_to_S + T_max = 31.0*US%degC_to_C ; T_min = -2.0*US%degC_to_C + max_t_adj = 1.0*US%degC_to_C + max_s_adj = 0.5*US%ppt_to_S + tol_T = 1.0e-4*US%degC_to_C + tol_S = 1.0e-4*US%ppt_to_S + tol_rho = 1.0e-4*US%kg_m3_to_R old_fit = .true. ! reproduces siena behavior + dT_dS_gauge = 10.0*US%degC_to_C*US%S_to_ppt ! 10 degC is weighted equivalently to 1 ppt. + ! ### The whole determine_temperature subroutine needs to be reexamined, both the algorithms ! and the extensive use of hard-coded dimensional parameters. @@ -630,7 +651,6 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, dT(i,k) = max(min((R_tgt(k)-rho(i,k)) / drho_dT(i,k), max_t_adj), -max_t_adj) T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min) else - dT_dS_gauge = 10.0 ! 10 degC is weighted equivalently to 1 ppt. I_denom = 1.0 / (drho_dS(i,k)**2 + dT_dS_gauge**2*drho_dT(i,k)**2) dS(i,k) = (R_tgt(k)-rho(i,k)) * drho_dS(i,k) * I_denom dT(i,k) = (R_tgt(k)-rho(i,k)) * dT_dS_gauge**2*drho_dT(i,k) * I_denom diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 94e4b669ea..57a912f1db 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -344,7 +344,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag call initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, diag, OBC, & CS%MOM_generic_tracer_CSp, sponge_CSp, ALE_sponge_CSp) if (CS%use_pseudo_salt_tracer) & - call initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS%pseudo_salt_tracer_CSp, & + call initialize_pseudo_salt_tracer(restart, day, G, GV, US, h, diag, OBC, CS%pseudo_salt_tracer_CSp, & sponge_CSp, tv) if (CS%use_boundary_impulse_tracer) & call initialize_boundary_impulse_tracer(restart, day, G, GV, US, h, diag, OBC, CS%boundary_impulse_tracer_CSp, & diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 821ac6a3cd..62126801a9 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -37,8 +37,8 @@ module MOM_tracer_registry !> The tracer type type, public :: tracer_type - real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array [conc] -! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows [conc] + real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array [CU ~> conc] +! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows [CU ~> conc] ! real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain ! !! specified in OBCs through u-face of cell ! real, dimension(:,:,:), pointer :: OBC_in_v => NULL() !< structured values for flow into the domain @@ -87,10 +87,10 @@ module MOM_tracer_registry ! !! expressed as a change in concentration ! !! [conc T-1 ~> conc s-1] real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous - !! timestep used for diagnostics [conc] + !! timestep used for diagnostics [CU ~> conc] real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array !! at a previous timestep used for diagnostics - !! [conc H ~> conc m or conc kg m-2] + !! [CU ~> H ~> conc m or conc kg m-2] character(len=32) :: name !< tracer name used for diagnostics and error messages character(len=64) :: units !< Physical dimensions of the tracer concentration @@ -98,6 +98,8 @@ module MOM_tracer_registry ! type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer logical :: registry_diags = .false. !< If true, use the registry to set up the !! diagnostics associated with this tracer. + real :: conc_scale = 1.0 !< A scaling factor used to convert the concentrations + !! of this tracer to its desired units. character(len=64) :: cmor_name !< CMOR name of this tracer character(len=64) :: cmor_units !< CMOR physical dimensions of the tracer character(len=240) :: cmor_longname !< CMOR long name of the tracer @@ -157,7 +159,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit cmor_name, cmor_units, cmor_longname, tr_desc, & OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, df_x, df_y, & ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, & - flux_nameroot, flux_longname, flux_units, flux_scale, & + conc_scale, flux_nameroot, flux_longname, flux_units, flux_scale, & convergence_units, convergence_scale, cmor_tendprefix, diag_form, & restart_CS, mandatory) type(hor_index_type), intent(in) :: HI !< horizontal index type @@ -202,6 +204,8 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit real, dimension(:,:,:), optional, pointer :: advection_xy !< convergence of lateral advective tracer fluxes logical, optional, intent(in) :: registry_diags !< If present and true, use the registry for !! the diagnostics of this tracer. + real, optional, intent(in) :: conc_scale !< A scaling factor used to convert the concentration + !! of this tracer to its desired units. character(len=*), optional, intent(in) :: flux_nameroot !< Short tracer name snippet used construct the !! names of flux diagnostics. character(len=*), optional, intent(in) :: flux_longname !< A word or phrase used construct the long @@ -267,6 +271,9 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit "MOM register_tracer was called for variable "//trim(Tr%name)//& " with a locked tracer registry.") + Tr%conc_scale = 1.0 + if (present(conc_scale)) Tr%conc_scale = conc_scale + Tr%flux_nameroot = Tr%name if (present(flux_nameroot)) then if (len_trim(flux_nameroot) > 0) Tr%flux_nameroot = flux_nameroot @@ -280,7 +287,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit Tr%flux_units = "" if (present(flux_units)) Tr%flux_units = flux_units - Tr%flux_scale = GV%H_to_MKS + Tr%flux_scale = GV%H_to_MKS*Tr%conc_scale if (present(flux_scale)) Tr%flux_scale = flux_scale Tr%conv_units = "" @@ -289,7 +296,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit Tr%cmor_tendprefix = "" if (present(cmor_tendprefix)) Tr%cmor_tendprefix = cmor_tendprefix - Tr%conv_scale = GV%H_to_MKS + Tr%conv_scale = GV%H_to_MKS*Tr%conc_scale if (present(convergence_scale)) then Tr%conv_scale = convergence_scale elseif (present(flux_scale)) then @@ -321,7 +328,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit mand = .true. ; if (present(mandatory)) mand = mandatory call register_restart_field(tr_ptr, Tr%name, mand, restart_CS, & - longname=Tr%longname, units=Tr%units) + longname=Tr%longname, units=Tr%units, conversion=conc_scale) endif end subroutine register_tracer @@ -400,17 +407,17 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) if (len_trim(cmorname) == 0) then Tr%id_tr = register_diag_field("ocean_model", trim(name), diag%axesTL, & - Time, trim(longname), trim(units)) + Time, trim(longname), trim(units), conversion=Tr%conc_scale) else Tr%id_tr = register_diag_field("ocean_model", trim(name), diag%axesTL, & - Time, trim(longname), trim(units), cmor_field_name=cmorname, & - cmor_long_name=cmor_longname, cmor_units=Tr%cmor_units, & - cmor_standard_name=cmor_long_std(cmor_longname)) + Time, trim(longname), trim(units), conversion=Tr%conc_scale, & + cmor_field_name=cmorname, cmor_long_name=cmor_longname, & + cmor_units=Tr%cmor_units, cmor_standard_name=cmor_long_std(cmor_longname)) endif Tr%id_tr_post_horzn = register_diag_field("ocean_model", & trim(name)//"_post_horzn", diag%axesTL, Time, & trim(longname)//" after horizontal transport (advection/diffusion) has occurred", & - trim(units)) + trim(units), conversion=Tr%conc_scale) if (Tr%diag_form == 1) then Tr%id_adx = register_diag_field("ocean_model", trim(shortnm)//"_adx", & diag%axesCuL, Time, trim(flux_longname)//" advective zonal flux" , & @@ -526,7 +533,8 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) Tr%id_tendency = register_diag_field('ocean_model', trim(shortnm)//'_tendency', & diag%axesTL, Time, & - 'Net time tendency for '//trim(lowercase(longname)), trim(units)//' s-1', conversion=US%s_to_T) + 'Net time tendency for '//trim(lowercase(longname)), & + trim(units)//' s-1', conversion=Tr%conc_scale*US%s_to_T) if (Tr%id_tendency > 0) then call safe_alloc_ptr(Tr%t_prev,isd,ied,jsd,jed,nz) @@ -584,11 +592,11 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) endif Tr%id_dfxy_conc = register_diag_field("ocean_model", trim(shortnm)//'_dfxy_conc_tendency', & diag%axesTL, Time, "Neutral diffusion tracer concentration tendency for "//trim(shortnm), & - trim(units)//' s-1', conversion=US%s_to_T) + trim(units)//' s-1', conversion=Tr%conc_scale*US%s_to_T) Tr%id_lbdxy_conc = register_diag_field("ocean_model", trim(shortnm)//'_lbdxy_conc_tendency', & diag%axesTL, Time, "Lateral diffusion tracer concentration tendency for "//trim(shortnm), & - trim(units)//' s-1', conversion=US%s_to_T) + trim(units)//' s-1', conversion=Tr%conc_scale*US%s_to_T) var_lname = "Net time tendency for "//lowercase(flux_longname) if (len_trim(Tr%cmor_tendprefix) == 0) then @@ -625,7 +633,7 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) var_lname = "Vertical remapping tracer concentration tendency for "//trim(Reg%Tr(m)%name) Tr%id_remap_conc= register_diag_field('ocean_model', & trim(Tr%flux_nameroot)//'_tendency_vert_remap', diag%axesTL, Time, var_lname, & - trim(units)//' s-1', conversion=US%s_to_T) + trim(units)//' s-1', conversion=Tr%conc_scale*US%s_to_T) var_lname = "Vertical remapping tracer content tendency for "//trim(Reg%Tr(m)%flux_longname) Tr%id_remap_cont = register_diag_field('ocean_model', & @@ -644,7 +652,8 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) unit2 = trim(units)//"2" if (index(units(1:len_trim(units))," ") > 0) unit2 = "("//trim(units)//")2" Tr%id_tr_vardec = register_diag_field('ocean_model', trim(shortnm)//"_vardec", diag%axesTL, & - Time, "ALE variance decay for "//lowercase(longname), trim(unit2)//" s-1", conversion=US%s_to_T) + Time, "ALE variance decay for "//lowercase(longname), & + trim(unit2)//" s-1", conversion=Tr%conc_scale**2*US%s_to_T) if (Tr%id_tr_vardec > 0) then ! Set up a new tracer for this tracer squared m2 = Reg%ntr+1 @@ -811,7 +820,7 @@ subroutine MOM_tracer_chksum(mesg, Tr, ntr, G) integer :: m do m=1,ntr - call hchksum(Tr(m)%t, mesg//trim(Tr(m)%name), G%HI) + call hchksum(Tr(m)%t, mesg//trim(Tr(m)%name), G%HI, scale=Tr(m)%conc_scale) enddo end subroutine MOM_tracer_chksum @@ -836,7 +845,7 @@ subroutine MOM_tracer_chkinv(mesg, G, GV, h, Tr, ntr) vol_scale = GV%H_to_m*G%US%L_to_m**2 do m=1,ntr do k=1,nz ; do j=js,je ; do i=is,ie - tr_inv(i,j,k) = Tr(m)%t(i,j,k) * (vol_scale * h(i,j,k) * G%areaT(i,j)*G%mask2dT(i,j)) + tr_inv(i,j,k) = Tr(m)%conc_scale*Tr(m)%t(i,j,k) * (vol_scale * h(i,j,k) * G%areaT(i,j)*G%mask2dT(i,j)) enddo ; enddo ; enddo total_inv = reproducing_sum(tr_inv, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) if (is_root_pe()) write(0,'(A,1X,A5,1X,ES25.16,1X,A)') "h-point: inventory", Tr(m)%name, total_inv, mesg diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 900377fe83..5592b7627a 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -362,7 +362,8 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US if (CS%oil_decay_rate(m)>0.) then CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*CS%oil_decay_rate(m),0.)*CS%tr(i,j,k,m) ! Safest elseif (CS%oil_decay_rate(m)<0.) then - decay_timescale = (12.*(3.0**(-(tv%T(i,j,k)-20.)/10.))) * (86400.*US%s_to_T) ! Timescale [s ~> T] + decay_timescale = (12.0 * (3.0**(-(tv%T(i,j,k)-20.0*US%degC_to_C)/10.0*US%degC_to_C))) * & + (86400.0*US%s_to_T) ! Timescale [s ~> T] ldecay = 1. / decay_timescale ! Rate [T-1 ~> s-1] CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*ldecay,0.)*CS%tr(i,j,k,m) endif diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 6c22daa150..ece4e09b65 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -107,13 +107,14 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) end function register_pseudo_salt_tracer !> Initialize the pseudo-salt tracer -subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, & +subroutine initialize_pseudo_salt_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 !< A structure that is used to regulate @@ -143,7 +144,7 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, call query_vardesc(CS%tr_desc, name=name, caller="initialize_pseudo_salt_tracer") if ((.not.restart) .or. (.not.query_initialized(CS%ps, name, CS%restart_CSp))) then do k=1,nz ; do j=jsd,jed ; do i=isd,ied - CS%ps(i,j,k) = tv%S(i,j,k) + CS%ps(i,j,k) = US%S_to_ppt*tv%S(i,j,k) enddo ; enddo ; enddo endif @@ -208,7 +209,7 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G if (.not.associated(CS%ps)) return if (debug) then - call hchksum(tv%S,"salt pre pseudo-salt vertdiff", G%HI) + call hchksum(tv%S,"salt pre pseudo-salt vertdiff", G%HI, scale=US%S_to_ppt) call hchksum(CS%ps,"pseudo_salt pre pseudo-salt vertdiff", G%HI) endif @@ -239,13 +240,13 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G endif if (debug) then - call hchksum(tv%S, "salt post pseudo-salt vertdiff", G%HI) + call hchksum(tv%S, "salt post pseudo-salt vertdiff", G%HI, scale=US%S_to_ppt) call hchksum(CS%ps, "pseudo_salt post pseudo-salt vertdiff", G%HI) endif if (allocated(CS%diff)) then do k=1,nz ; do j=js,je ; do i=is,ie - CS%diff(i,j,k) = CS%ps(i,j,k) - tv%S(i,j,k) + CS%diff(i,j,k) = CS%ps(i,j,k) - US%S_to_ppt*tv%S(i,j,k) enddo ; enddo ; enddo if (CS%id_psd>0) call post_data(CS%id_psd, CS%diff, CS%diag) endif diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 807dbc0e2a..5669359c55 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -218,12 +218,13 @@ end subroutine DOME2d_initialize_thickness !> Initialize temperature and salinity in the 2d DOME configuration -subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) +subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. @@ -232,8 +233,8 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, real :: x integer :: index_bay_z real :: delta_S - real :: S_ref, T_ref ! Reference salinity and temperature within surface layer - real :: S_range, T_range ! Range of salinities and temperatures over the vertical + real :: S_ref, T_ref ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer + real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical real :: xi0, xi1 character(len=40) :: verticalCoordinate real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay @@ -249,13 +250,13 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & default=0.2, do_not_log=.true.) call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & - default=35.0, units='1e-3', do_not_log=just_read) - call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', units='degC', & - fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"S_RANGE",S_range,'Initial salinity range', & - units='1e-3', default=2.0, do_not_log=just_read) - call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', & - units='1e-3', default=0.0, do_not_log=just_read) + default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', & + units='degC', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "S_RANGE", S_range,' Initial salinity range', & + units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & + units='degC', default=0.0, scale=US%degC_to_C, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -272,7 +273,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, xi0 = 0.0 do k = 1,nz xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth - S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) + S(i,j,k) = 34.0*US%ppt_to_S + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo enddo ; enddo @@ -283,12 +284,12 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, xi0 = 0.0 do k = 1,nz xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth - S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) + S(i,j,k) = 34.0*US%ppt_to_S + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - S(i,j,nz) = 34.0 + S_range + S(i,j,nz) = 34.0*US%ppt_to_S + S_range endif enddo ; enddo @@ -312,8 +313,8 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do j = G%jsc,G%jec ; do i = G%isc,G%iec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - S(i,j,1:index_bay_z) = S_ref + S_range; ! Use for z coordinates - T(i,j,1:index_bay_z) = 1.0; ! Use for z coordinates + S(i,j,1:index_bay_z) = S_ref + S_range ! Use for z coordinates + T(i,j,1:index_bay_z) = 1.0*US%degC_to_C ! Use for z coordinates endif enddo ; enddo ! i and j loops endif ! Z initial conditions @@ -323,8 +324,8 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do i = G%isc,G%iec ; do j = G%jsc,G%jec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - S(i,j,1:GV%ke) = S_ref + S_range; ! Use for sigma coordinates - T(i,j,1:GV%ke) = 1.0; ! Use for sigma coordinates + S(i,j,1:GV%ke) = S_ref + S_range ! Use for sigma coordinates + T(i,j,1:GV%ke) = 1.0*US%degC_to_C ! Use for sigma coordinates endif enddo ; enddo endif @@ -336,7 +337,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do i = G%isc,G%iec ; do j = G%jsc,G%jec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - T(i,j,GV%ke) = 1.0 + T(i,j,GV%ke) = 1.0*US%degC_to_C endif enddo ; enddo endif @@ -361,10 +362,10 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness [H ~> m or kg m-2]. real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m] real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] - real :: S_ref ! Reference salinity within the surface layer [ppt] - real :: T_ref ! Reference temerature within the surface layer [degC] - real :: S_range ! Range of salinities in the vertical [ppt] - real :: T_range ! Range of temperatures in the vertical [degC] + real :: S_ref ! Reference salinity within the surface layer [S ~> ppt] + real :: T_ref ! Reference temperature within the surface layer [C ~> degC] + real :: S_range ! Range of salinities in the vertical [S ~> ppt] + real :: T_range ! Range of temperatures in the vertical [C ~> degC] real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], ! usually negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface @@ -410,10 +411,10 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A default=0.3, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & default=0.2, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0) - call get_param(param_file, mdl, "T_REF", T_ref) - call get_param(param_file, mdl, "S_RANGE", S_range, default=2.0) - call get_param(param_file, mdl, "T_RANGE", T_range, default=0.0) + call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, scale=US%ppt_to_S) + call get_param(param_file, mdl, "T_REF", T_ref, scale=US%degC_to_C) + call get_param(param_file, mdl, "S_RANGE", S_range, default=2.0, scale=US%ppt_to_S) + call get_param(param_file, mdl, "T_RANGE", T_range, default=0.0, scale=US%degC_to_C) ! Set the sponge damping rate as a function of position @@ -466,7 +467,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A z = -depth_tot(i,j) do k = nz,1,-1 z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the center of layer k - S(i,j,k) = 34.0 - 1.0 * (z / (G%max_depth)) + S(i,j,k) = 34.0*US%ppt_to_S - 1.0*US%ppt_to_S * (z / (G%max_depth)) if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 859b736380..a78ed3acc4 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -275,11 +275,11 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. ! Local variables - real :: T0(SZK_(GV)) ! A profile of target temperatures [degC] - real :: S0(SZK_(GV)) ! A profile of target salinities [ppt] + real :: T0(SZK_(GV)) ! A profile of target temperatures [C ~> degC] + real :: S0(SZK_(GV)) ! A profile of target salinities [S ~> ppt] real :: pres(SZK_(GV)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. - real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3]. ! The following variables are used to set up the transport in the DOME example. real :: tr_0 ! The total integrated inflow transport [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -370,13 +370,13 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! In this example, all S inflows have values of 35 psu. name = 'salt' call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_scalar=35.0) + call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_scalar=35.0*US%ppt_to_S, scale=US%ppt_to_S) endif if (associated(tv%T)) then ! In this example, the T values are set to be consistent with the layer ! target density and a salinity of 35 psu. This code is taken from ! USER_initialize_temp_sal. - pres(:) = tv%P_Ref ; S0(:) = 35.0 ; T0(1) = 25.0 + pres(:) = tv%P_Ref ; S0(:) = 35.0*US%ppt_to_S ; T0(1) = 25.0*US%degC_to_C call calculate_density(T0(1), S0(1), pres(1), rho_guess(1), tv%eqn_of_state) call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, tv%eqn_of_state, (/1,1/) ) @@ -390,11 +390,13 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! Temperature is tracer 1 for the OBCs. allocate(segment%field(1)%buffer_src(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied - segment%field(1)%buffer_src(i,j,k) = T0(k) + ! Because of the challenges in rescaling the data as it is being read in when using certain + ! modes, buffer_src keeps the data in unscaled (mks) units. They will be rescaled later. + segment%field(1)%buffer_src(i,j,k) = US%C_to_degC*T0(k) enddo ; enddo ; enddo name = 'temp' call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_array=.true.) + call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_array=.true., scale=US%degC_to_C) endif ! Set up dye tracers diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index a67f3b09ed..5e91eaa86a 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -61,7 +61,7 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) real :: xtil ! dummy vatiable logical :: is_2D ! If true, use 2D setup ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" character(len=40) :: mdl = "ISOMIP_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -146,7 +146,9 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz - real :: min_thickness, s_sur, s_bot, t_sur, t_bot + real :: min_thickness ! Minimum layer thicknesses [Z ~> m] + real :: S_sur, S_bot ! Surface and bottom salinities [S ~> ppt] + real :: T_sur, T_bot ! Surface and bottom temperatures [C ~> degC] real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] real :: rho_range ! The range of densities [R ~> kg m-3] !character(len=256) :: mesg ! The text of an error message @@ -166,21 +168,25 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv case ( REGRIDDING_LAYER, REGRIDDING_RHO ) ! Initial thicknesses for isopycnal coordinates call get_param(param_file, mdl, "ISOMIP_T_SUR", t_sur, & - "Temperature at the surface (interface)", units="degC", default=-1.9, do_not_log=just_read) + "Temperature at the surface (interface)", & + units="degC", default=-1.9, scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "ISOMIP_S_SUR", s_sur, & - "Salinity at the surface (interface)", units="ppt", default=33.8, do_not_log=just_read) + "Salinity at the surface (interface)", & + units="ppt", default=33.8, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "ISOMIP_T_BOT", t_bot, & - "Temperature at the bottom (interface)", units="degC", default=-1.9, do_not_log=just_read) - call get_param(param_file, mdl, "ISOMIP_S_BOT", s_bot,& - "Salinity at the bottom (interface)", units="ppt", default=34.55, do_not_log=just_read) + "Temperature at the bottom (interface)", & + units="degC", default=-1.9, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "ISOMIP_S_BOT", s_bot, & + "Salinity at the bottom (interface)", & + units="ppt", default=34.55, scale=US%ppt_to_S, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT - call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state) + call calculate_density(T_sur, S_sur, 0.0, rho_sur, tv%eqn_of_state) ! write(mesg,*) 'Surface density is:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state) + call calculate_density(T_bot, S_bot, 0.0, rho_bot, tv%eqn_of_state) ! write(mesg,*) 'Bottom density is:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur @@ -248,8 +254,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] 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(in) :: depth_tot !< The nominal total bottom-to-top !! depth of the ocean [Z ~> m] @@ -261,22 +267,22 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U integer :: i, j, k, is, ie, js, je, nz, itt real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] real :: xi0, xi1 ! Heights in depth units [Z ~> m]. - real :: S_sur, S_bot ! Salinity at the surface and bottom [ppt] - real :: T_sur, T_bot ! Temperature at the bottom [degC] - real :: dT_dz ! Vertical gradient of temperature [degC Z-1 ~> degC m-1]. - real :: dS_dz ! Vertical gradient of salinity [ppt Z-1 ~> ppt m-1]. + real :: S_sur, S_bot ! Salinity at the surface and bottom [S ~> ppt] + real :: T_sur, T_bot ! Temperature at the surface and bottom [C ~> degC] + real :: dT_dz ! Vertical gradient of temperature [C Z-1 ~> degC m-1]. + real :: dS_dz ! Vertical gradient of salinity [S Z-1 ~> ppt m-1]. !character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate !real :: rho_tmp logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. - real :: T0(SZK_(GV)) ! A profile of temperatures [degC] - real :: S0(SZK_(GV)) ! A profile of salinities [ppt] - real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: T0(SZK_(GV)) ! A profile of temperatures [C ~> degC] + real :: S0(SZK_(GV)) ! A profile of salinities [S ~> ppt] + real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3]. real :: pres(SZK_(GV)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. (zero here) - real :: drho_dT1 ! A prescribed derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - real :: drho_dS1 ! A prescribed derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: drho_dT1 ! A prescribed derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: drho_dS1 ! A prescribed derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: T_Ref, S_Ref is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke pres(:) = 0.0 @@ -284,18 +290,22 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "ISOMIP_T_SUR",t_sur, & - "Temperature at the surface (interface)", units="degC", default=-1.9, do_not_log=just_read) + "Temperature at the surface (interface)", & + units="degC", default=-1.9, scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "ISOMIP_S_SUR", s_sur, & - "Salinity at the surface (interface)", units="ppt", default=33.8, do_not_log=just_read) + "Salinity at the surface (interface)", & + units="ppt", default=33.8, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "ISOMIP_T_BOT", t_bot, & - "Temperature at the bottom (interface)", units="degC", default=-1.9, do_not_log=just_read) + "Temperature at the bottom (interface)", & + units="degC", default=-1.9, scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "ISOMIP_S_BOT", s_bot, & - "Salinity at the bottom (interface)", units="ppt", default=34.55, do_not_log=just_read) + "Salinity at the bottom (interface)", & + units="ppt", default=34.55, scale=US%ppt_to_S, do_not_log=just_read) - call calculate_density(t_sur, s_sur, 0.0, rho_sur, eqn_of_state) + call calculate_density(T_sur, S_sur, 0.0, rho_sur, eqn_of_state) ! write(mesg,*) 'Density in the surface layer:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot, s_bot, 0.0, rho_bot, eqn_of_state) + call calculate_density(T_bot, S_bot, 0.0, rho_bot, eqn_of_state) ! write(mesg,*) 'Density in the bottom layer::', rho_bot ! call MOM_mesg(mesg,5) @@ -304,8 +314,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U case ( REGRIDDING_RHO, REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_SIGMA ) if (just_read) return ! All run-time parameters have been read, so return. - dS_dz = (s_sur - s_bot) / G%max_depth - dT_dz = (t_sur - t_bot) / G%max_depth + dS_dz = (S_sur - S_bot) / G%max_depth + dT_dz = (T_sur - T_bot) / G%max_depth do j=js,je ; do i=is,ie xi0 = -depth_tot(i,j) do k = nz,1,-1 @@ -323,23 +333,25 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U default=.false., do_not_log=just_read) call get_param(param_file, mdl, "DRHO_DS", drho_dS1, & "Partial derivative of density with salinity.", & - units="kg m-3 PSU-1", scale=US%kg_m3_to_R, fail_if_missing=.not.just_read, do_not_log=just_read) + units="kg m-3 PSU-1", scale=US%kg_m3_to_R*US%S_to_ppt, & + fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "DRHO_DT", drho_dT1, & "Partial derivative of density with temperature.", & - units="kg m-3 K-1", scale=US%kg_m3_to_R, fail_if_missing=.not.just_read, do_not_log=just_read) + units="kg m-3 K-1", scale=US%kg_m3_to_R*US%C_to_degC, & + fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "T_REF", T_Ref, & "A reference temperature used in initialization.", & - units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + units="degC", scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_Ref, & "A reference salinity used in initialization.", units="PSU", & - default=35.0, do_not_log=just_read) + default=35.0, scale=US%ppt_to_S, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. ! write(mesg,*) 'read drho_dS, drho_dT', drho_dS1, drho_dT1 ! call MOM_mesg(mesg,5) - dS_dz = (s_sur - s_bot) / G%max_depth - dT_dz = (t_sur - t_bot) / G%max_depth + dS_dz = (S_sur - S_bot) / G%max_depth + dT_dz = (T_sur - T_bot) / G%max_depth do j=js,je ; do i=is,ie xi0 = 0.0 @@ -402,8 +414,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U ! for debugging !i=G%iec; j=G%jec !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,eqn_of_state, scale=US%kg_m3_to_R) - ! write(mesg,*) 'k,h,T,S,rho,Rlay',k,h(i,j,k),T(i,j,k),S(i,j,k),rho_tmp,GV%Rlay(k) + ! call calculate_density(T(i,j,k), S(i,j,k),0.0,rho_tmp,eqn_of_state, scale=US%kg_m3_to_R) + ! write(mesg,*) 'k,h,T,S,rho,Rlay',k,h(i,j,k),US%C_to_degC*T(i,j,k),US%S_to_ppt*S(i,j,k),rho_tmp,GV%Rlay(k) ! call MOM_mesg(mesg,5) !enddo @@ -430,18 +442,19 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure ! Local variables - real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temp [degC] - real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt [ppt] + real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temp [C ~> degC] + real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt [S ~> ppt] ! real :: RHO(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for RHO [R ~> kg m-3] real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness [H ~> m or kg m-2] real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: TNUDG ! Nudging time scale [T ~> s] - real :: S_sur, T_sur ! Surface salinity and temerature in sponge - real :: S_bot, T_bot ! Bottom salinity and temerature in sponge - real :: t_ref, s_ref ! reference T and S + real :: S_sur, S_bot ! Surface and bottom salinities in the sponge region [S ~> ppt] + real :: T_sur, T_bot ! Surface and bottom temperatures in the sponge region [C ~> degC] + real :: t_ref, s_ref ! reference (default) T [degC] and S [ppt] real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] real :: rho_range ! The range of densities [R ~> kg m-3] - real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. + real :: dT_dz ! Vertical gradient of temperature [C Z-1 ~> degC m-1] + real :: dS_dz ! Vertical gradient of salinity [S Z-1 ~> ppt m-1] real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. @@ -475,16 +488,20 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, do_not_log=.true.) call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, & - "Surface salinity in sponge layer.", units="ppt", default=s_ref) ! units="ppt") + "Surface salinity in sponge layer.", & + units="ppt", default=s_ref, scale=US%ppt_to_S) ! units="ppt") call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, & - "Bottom salinity in sponge layer.", units="ppt", default=s_ref) ! units="ppt") + "Bottom salinity in sponge layer.", & + units="ppt", default=s_ref, scale=US%ppt_to_S) ! units="ppt") call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, & - "Surface temperature in sponge layer.", units="degC", default=t_ref) ! units="degC") + "Surface temperature in sponge layer.", & + units="degC", default=t_ref, scale=US%degC_to_C) call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, & - "Bottom temperature in sponge layer.", units="degC", default=t_ref) ! units="degC") + "Bottom temperature in sponge layer.", & + units="degC", default=t_ref, scale=US%degC_to_C) T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 !; RHO(:,:,:) = 0.0 @@ -515,10 +532,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, enddo ; enddo ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT - call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state) + call calculate_density(T_sur, S_sur, 0.0, rho_sur, tv%eqn_of_state) !write (mesg,*) 'Surface density in sponge:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state) + call calculate_density(T_bot, S_bot, 0.0, rho_bot, tv%eqn_of_state) !write (mesg,*) 'Bottom density in sponge:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur @@ -585,8 +602,8 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, ! This sets the inverse damping timescale fields in the sponges. call initialize_ALE_sponge(Idamp, G, GV, PF, ACSp, h, nz) - dS_dz = (s_sur - s_bot) / G%max_depth - dT_dz = (t_sur - t_bot) / G%max_depth + dS_dz = (S_sur - S_bot) / G%max_depth + dT_dz = (T_sur - T_bot) / G%max_depth do j=js,je ; do i=is,ie xi0 = -depth_tot(i,j) do k = nz,1,-1 @@ -599,7 +616,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, ! for debugging !i=G%iec; j=G%jec !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state, scale=US%kg_m3_to_R) + ! call calculate_density(T(i,j,k), S(i,j,k), 0.0, rho_tmp, tv%eqn_of_state, scale=US%kg_m3_to_R) ! write(mesg,*) 'Sponge - k,h,T,S,rho,Rlay',k,h(i,j,k),T(i,j,k),S(i,j,k),rho_tmp,GV%Rlay(k) ! call MOM_mesg(mesg,5) !enddo @@ -643,13 +660,13 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & "ISOMIP_initialize_sponges: Unable to open "//trim(filename)) call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=US%m_to_Z) - call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) - call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) + call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain, scale=US%degC_to_C) + call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain, scale=US%ppt_to_S) ! for debugging !i=G%iec; j=G%jec !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state, scale=US%kg_m3_to_R) + ! call calculate_density(T(i,j,k), S(i,j,k), 0.0, rho_tmp, tv%eqn_of_state, scale=US%kg_m3_to_R) ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& ! S(i,j,k),rho_tmp,GV%Rlay(k) ! call MOM_mesg(mesg,5) diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index 8e4026a444..d9c1846a0e 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -58,8 +58,8 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure ! Local variables - real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temperature [degC] - real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salinity [ppt] + real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temperature [C ~> degC] + real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salinity [S ~> ppt] real :: U1(SZIB_(G),SZJ_(G),SZK_(GV)) ! A temporary array for u [L T-1 ~> m s-1] real :: V1(SZI_(G),SZJB_(G),SZK_(GV)) ! A temporary array for v [L T-1 ~> m s-1] real :: tmp(SZI_(G),SZJ_(G)) ! A temporary array for tracers. @@ -158,8 +158,8 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C filename = trim(inputdir)//trim(state_file) if (.not.file_exists(filename, G%Domain)) & call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) - call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) - call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) + call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain, scale=US%degC_to_C) + call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain, scale=US%ppt_to_S) if (use_ALE) then call MOM_read_data(filename, h_var, h(:,:,:), G%Domain, scale=GV%m_to_H) diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index b491c027f3..2d0dcb85e5 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -105,13 +105,14 @@ end subroutine Rossby_front_initialize_thickness !> Initialization of temperature and salinity in the Rossby front test -subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & +subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, & param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [H ~> m or kg m-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. @@ -127,11 +128,11 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & - default=35.0, units='1e-3', do_not_log=just_read) - call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature',units='C',& - fail_if_missing=.not.just_read, do_not_log=just_read) + default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', & + units='C', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range',& - units='C', default=0.0, do_not_log=just_read) + units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 74cf31a22b..64a834e062 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -55,8 +55,8 @@ module SCM_CVMix_tests subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Input parameter structure @@ -65,13 +65,13 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read) ! Local variables real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness [Z ~> m]. real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness [Z ~> m]. - real :: UpperLayerTemp !< Upper layer temperature (SST if thickness 0) [degC] - real :: UpperLayerSalt !< Upper layer salinity (SSS if thickness 0) [ppt] - real :: LowerLayerTemp !< Temp at top of lower layer [degC] - real :: LowerLayerSalt !< Salt at top of lower layer [ppt] - real :: LowerLayerdTdz !< Temp gradient in lower layer [degC Z-1 ~> degC m-1]. - real :: LowerLayerdSdz !< Salt gradient in lower layer [ppt Z-1 ~> ppt m-1]. - real :: LowerLayerMinTemp !< Minimum temperature in lower layer [degC] + real :: UpperLayerTemp !< Upper layer temperature (SST if thickness 0) [C ~> degC] + real :: UpperLayerSalt !< Upper layer salinity (SSS if thickness 0) [S ~> ppt] + real :: LowerLayerTemp !< Temp at top of lower layer [C ~> degC] + real :: LowerLayerSalt !< Salt at top of lower layer [S ~> ppt] + real :: LowerLayerdTdz !< Temp gradient in lower layer [C Z-1 ~> degC m-1]. + real :: LowerLayerdSdz !< Salt gradient in lower layer [S Z-1 ~> ppt m-1]. + real :: LowerLayerMinTemp !< Minimum temperature in lower layer [C ~> degC] real :: zC, DZ, top, bottom ! Depths and thicknesses [Z ~> m]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -86,21 +86,21 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read) 'Initial salt mixed layer depth', & units='m', default=0.0, scale=US%m_to_Z, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L1_SALT", UpperLayerSalt, & - 'Layer 2 surface salinity', units='1e-3', default=35.0, do_not_log=just_read) + 'Layer 2 surface salinity', units='1e-3', default=35.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L1_TEMP", UpperLayerTemp, & - 'Layer 1 surface temperature', units='C', default=20.0, do_not_log=just_read) + 'Layer 1 surface temperature', units='C', default=20.0, scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L2_SALT", LowerLayerSalt, & - 'Layer 2 surface salinity', units='1e-3', default=35.0, do_not_log=just_read) + 'Layer 2 surface salinity', units='1e-3', default=35.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L2_TEMP", LowerLayerTemp, & - 'Layer 2 surface temperature', units='C', default=20.0, do_not_log=just_read) + 'Layer 2 surface temperature', units='C', default=20.0, scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L2_DTDZ", LowerLayerdTdZ, & 'Initial temperature stratification in layer 2', & - units='C/m', default=0.0, scale=US%Z_to_m, do_not_log=just_read) + units='C/m', default=0.0, scale=US%degC_to_C*US%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L2_DSDZ", LowerLayerdSdZ, & 'Initial salinity stratification in layer 2', & - units='PPT/m', default=0.0, scale=US%Z_to_m, do_not_log=just_read) + units='PPT/m', default=0.0, scale=US%ppt_to_S*US%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L2_MINTEMP",LowerLayerMinTemp, & - 'Layer 2 minimum temperature', units='C', default=4.0, do_not_log=just_read) + 'Layer 2 minimum temperature', units='C', default=4.0, scale=US%degC_to_C, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 6c05def460..3509ef69d3 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -46,10 +46,14 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. - real :: dRho_dS ! The partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. ! In this subroutine it is hard coded at 1.0 kg m-3 ppt-1. real :: x, y, yy - real :: delta_S_strat, dSdz, delta_S, S_ref + real :: S_ref ! Reference salinity within surface layer [S ~> ppt] + real :: S_range ! Range of salinities in the vertical [S ~> ppt] + real :: dSdz ! Vertical salinity gradient [S Z-1 ~> ppt m-1] + real :: delta_S ! The local salinity perturbation [S ~> ppt] + real :: delta_S_strat ! Top-to-bottom salinity difference of stratification [S ~> ppt] real :: min_thickness, adjustment_width, adjustment_delta real :: adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym @@ -67,7 +71,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read ! Parameters used by main model initialization if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & - default=35.0, units='1e-3', do_not_log=just_read) + default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & default=1.0e-3, units='m', scale=US%m_to_Z, do_not_log=just_read) @@ -79,10 +83,10 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read units="same as x,y", fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_S_STRAT",delta_S_strat, & "Top-to-bottom salinity difference of stratification", & - units="1e-3", fail_if_missing=.not.just_read, do_not_log=just_read) + units="1e-3", scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl,"ADJUSTMENT_DELTAS",adjustment_deltaS, & "Salinity difference across front", & - units="1e-3", fail_if_missing=.not.just_read, do_not_log=just_read) + units="1e-3", scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl,"FRONT_WAVE_AMP",front_wave_amp, & "Amplitude of trans-frontal wave perturbation", & units="same as x,y", default=0., do_not_log=just_read) @@ -108,7 +112,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) - dRho_dS = 1.0 * US%kg_m3_to_R + dRho_dS = 1.0*US%kg_m3_to_R*US%S_to_ppt if (delta_S_strat /= 0.) then ! This was previously coded ambiguously. adjustment_delta = (adjustment_deltaS / delta_S_strat) * G%max_depth @@ -131,7 +135,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read do k = 2,nz target_values(k) = target_values(k-1) + ( GV%Rlay(nz) - GV%Rlay(1) ) / (nz-1) enddo - target_values(:) = target_values(:) - 1000.*US%kg_m3_to_R + target_values(:) = target_values(:) - 1000.0*US%kg_m3_to_R do j=js,je ; do i=is,ie if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) @@ -189,11 +193,12 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read end subroutine adjustment_initialize_thickness !> Initialization of temperature and salinity in the adjustment test case -subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, param_file, just_read) +subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The temperature that is being initialized. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being initialized. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The temperature that is being initialized [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being initialized [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] @@ -204,36 +209,39 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, integer :: i, j, k, is, ie, js, je, nz real :: x, y, yy - real :: S_ref, T_ref ! Reference salinity and temerature within - ! surface layer - real :: S_range, T_range ! Range of salinities and temperatures over the - ! vertical - real :: dSdz, delta_S, delta_S_strat - real :: adjustment_width, adjustment_deltaS - real :: front_wave_amp, front_wave_length, front_wave_asym - real :: eta1d(SZK_(GV)+1) + real :: S_ref ! Reference salinity within surface layer [S ~> ppt] + real :: T_ref ! Reference temperature within surface layer [C ~> degC] + real :: S_range ! Range of salinities in the vertical [S ~> ppt] + real :: T_range ! Range of temperatures in the vertical [C ~> degC] + real :: dSdz ! Vertical salinity gradient [S Z-1 ~> ppt m-1] + real :: delta_S ! The local salinity perturbation [S ~> ppt] + real :: delta_S_strat ! Top-to-bottom salinity difference of stratification [S ~> ppt] + real :: adjustment_width + real :: adjustment_deltaS ! Salinity difference across front [S ~> ppt] + real :: front_wave_amp, front_wave_length, front_wave_asym + real :: eta1d(SZK_(GV)+1) ! Interface heights [Z ~> m] character(len=20) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Parameters used by main model initialization call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & - default=35.0, units='1e-3', do_not_log=just_read) - call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', units='C', & - fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"S_RANGE",S_range,'Initial salinity range', units='1e-3', & - default=2.0, do_not_log=just_read) - call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', units='C', & - default=0.0, do_not_log=just_read) + default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', & + units='C', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"S_RANGE", S_range, 'Initial salinity range', & + default=2.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', & + default=0.0, units='C', scale=US%degC_to_C, do_not_log=just_read) ! Parameters specific to this experiment configuration BUT logged in previous s/r call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl,"ADJUSTMENT_WIDTH", adjustment_width, & fail_if_missing=.not.just_read, do_not_log=.true.) call get_param(param_file, mdl,"ADJUSTMENT_DELTAS", adjustment_deltaS, & - fail_if_missing=.not.just_read, do_not_log=.true.) + units='1e-3', scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=.true.) call get_param(param_file, mdl,"DELTA_S_STRAT", delta_S_strat, & - fail_if_missing=.not.just_read, do_not_log=.true.) + units='1e-3', scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=.true.) call get_param(param_file, mdl,"FRONT_WAVE_AMP", front_wave_amp, default=0., & do_not_log=.true.) call get_param(param_file, mdl,"FRONT_WAVE_LENGTH",front_wave_length, & @@ -273,7 +281,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, S(i,j,k) = S_ref + delta_S + 0.5 * ( eta1D(k)+eta1D(k+1) ) * dSdz x = abs(S(i,j,k) - 0.5*real(nz-1)/real(nz)*S_range)/S_range*real(2*nz) x = 1. - min(1., x) - T(i,j,k) = x + T(i,j,k) = US%degC_to_C * x enddo ! x = GV%H_to_Z*sum(T(i,j,:)*h(i,j,:)) ! T(i,j,:) = (T(i,j,:) / x) * (G%max_depth*1.5/real(nz)) diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index a214012541..eb1f943b87 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -33,14 +33,16 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle - real, intent(out) :: S_ref !< Reference salinity [ppt] - real, intent(out) :: dSdz !< Salinity stratification [ppt Z-1 ~> ppt m-1] - real, intent(out) :: delta_S !< Salinity difference across baroclinic zone [ppt] - real, intent(out) :: dSdx !< Linear salinity gradient [ppt G%xaxis_units-1] - real, intent(out) :: T_ref !< Reference temperature [degC] - real, intent(out) :: dTdz !< Temperature stratification [degC Z-1 ~> degC m-1] - real, intent(out) :: delta_T !< Temperature difference across baroclinic zone [degC] - real, intent(out) :: dTdx !< Linear temperature gradient in [degC G%x_axis_units-1] + real, intent(out) :: S_ref !< Reference salinity [S ~> ppt] + real, intent(out) :: dSdz !< Salinity stratification [S Z-1 ~> ppt m-1] + real, intent(out) :: delta_S !< Salinity difference across baroclinic zone [S ~> ppt] + real, intent(out) :: dSdx !< Linear salinity gradient + !! in [S G%xaxis_units-1 ~> ppt G%xaxis_units-1] + real, intent(out) :: T_ref !< Reference temperature [C ~> degC] + real, intent(out) :: dTdz !< Temperature stratification [C Z-1 ~> degC m-1] + real, intent(out) :: delta_T !< Temperature difference across baroclinic zone [C ~> degC] + real, intent(out) :: dTdx !< Linear temperature gradient + !! in [C G%x_axis_units-1 ~> degC G%x_axis_units-1] real, intent(out) :: L_zone !< Width of baroclinic zone in [G%x_axis_units] logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. @@ -48,22 +50,22 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, if (.not.just_read) & call log_version(param_file, mdl, version, 'Initialization of an analytic baroclinic zone') call openParameterBlock(param_file,'BCZIC') - call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', units='ppt', & - default=35., do_not_log=just_read) + call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & + units='ppt', default=35., scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "DSDZ", dSdz, 'Salinity stratification', & - units='ppt/m', default=0.0, scale=US%Z_to_m, do_not_log=just_read) + units='ppt/m', default=0.0, scale=US%ppt_to_S*US%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_S",delta_S,'Salinity difference across baroclinic zone', & - units='ppt', default=0.0, do_not_log=just_read) + units='ppt', default=0.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl,"DSDX",dSdx,'Meridional salinity difference', & - units='ppt/'//trim(G%x_axis_units), default=0.0, do_not_log=just_read) - call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature',units='C', & - default=10., do_not_log=just_read) + units='ppt/'//trim(G%x_axis_units), default=0.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', & + units='C', default=10., scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "DTDZ", dTdz, 'Temperature stratification', & - units='C/m', default=0.0, scale=US%Z_to_m, do_not_log=just_read) + units='C/m', default=0.0, scale=US%degC_to_C*US%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_T",delta_T,'Temperature difference across baroclinic zone', & - units='C', default=0.0, do_not_log=just_read) + units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl,"DTDX",dTdx,'Meridional temperature difference', & - units='C/'//trim(G%x_axis_units), default=0.0, do_not_log=just_read) + units='C/'//trim(G%x_axis_units), default=0.0, scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl,"L_ZONE",L_zone,'Width of baroclinic zone', & units=G%x_axis_units, default=0.5*G%len_lat, do_not_log=just_read) call closeParameterBlock(param_file) @@ -77,9 +79,9 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, 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(out) :: T !< Potential temperature [degC] + intent(out) :: T !< Potential temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: S !< Salinity [ppt] + intent(out) :: S !< Salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< The model thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & @@ -90,8 +92,8 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, !! parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz - real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution - real :: S_ref, dSdz, dSdx, delta_S ! Parameters describing salinity distribution + real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution [C ~> degC] + real :: S_ref, dSdz, dSdx, delta_S ! Parameters describing salinity distribution [S ~> ppt] real :: L_zone ! Width of baroclinic zone in [G%axis_units] real :: zc, zi ! Depths in depth units [Z ~> m] real :: x, xd, xs, y, yd, fn diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index e042e245b7..9ed2881563 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -101,15 +101,15 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e ! in depth units [Z ~> m]. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. - real :: SST ! The initial sea surface temperature [degC]. - real :: T_int ! The initial temperature of an interface [degC]. + real :: SST ! The initial sea surface temperature [C ~> degC]. + real :: T_int ! The initial temperature of an interface [C ~> degC]. real :: ML_depth ! The specified initial mixed layer depth, in depth units [Z ~> m]. real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units [Z ~> m]. real, dimension(SZK_(GV)) :: & - T0, S0, & ! Profiles of temperature [degC] and salinity [ppt] + T0, S0, & ! Profiles of temperature [C ~> degC] and salinity [S ~> ppt] rho_guess, & ! Potential density at T0 & S0 [R ~> kg m-3]. - drho_dT, & ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - drho_dS ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + drho_dT, & ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1]. + drho_dS ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: pres(SZK_(GV)) ! Reference pressure [R L2 T-2 ~> Pa]. real :: a_exp ! The fraction of the overall stratification that is exponential. real :: I_ts, I_md ! Inverse lengthscales [Z-1 ~> m-1]. @@ -147,9 +147,9 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e ! This block calculates T0(k) for the purpose of diagnosing where the ! interfaces will be found. do k=1,nz - pres(k) = P_Ref ; S0(k) = 35.0 + pres(k) = P_Ref ; S0(k) = 35.0*US%ppt_to_S enddo - T0(k1) = 29.0 + T0(k1) = 29.0*US%degC_to_C call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state) call calculate_density_derivs(T0(k1), S0(k1), pres(k1), drho_dT(k1), drho_dS(k1), eqn_of_state) @@ -217,9 +217,9 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature - !! that is being initialized [degC] + !! that is being initialized [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being - !! initialized [ppt] + !! initialized [S ~> ppt] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for @@ -230,14 +230,14 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing T & S. ! Local variables - real :: T0(SZK_(GV)) ! A profile of temperatures [degC] - real :: S0(SZK_(GV)) ! A profile of salinities [ppt] + real :: T0(SZK_(GV)) ! A profile of temperatures [C ~> degC] + real :: S0(SZK_(GV)) ! A profile of salinities [S ~> ppt] real :: pres(SZK_(GV)) ! Reference pressure [R L2 T-2 ~> Pa] - real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] + real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3] real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: SST ! The initial sea surface temperature [degC] + real :: SST ! The initial sea surface temperature [C ~> degC] integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -247,10 +247,10 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & k1 = GV%nk_rho_varies + 1 do k=1,nz - pres(k) = P_Ref ; S0(k) = 35.0 + pres(k) = P_Ref ; S0(k) = 35.0*US%ppt_to_S enddo - T0(k1) = 29.0 + T0(k1) = 29.0*US%degC_to_C call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state) call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, (/k1,k1/) ) diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 99836f5ad0..1c372bf1b7 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -95,12 +95,13 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) end subroutine dense_water_initialize_topography !> Initialize the temperature and salinity for the dense water experiment -subroutine dense_water_initialize_TS(G, GV, param_file, T, S, h, just_read) +subroutine dense_water_initialize_TS(G, GV, US, param_file, T, S, h, just_read) type(ocean_grid_type), intent(in) :: G !< Horizontal grid control structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Output temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Output salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Output temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Output salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. @@ -115,11 +116,11 @@ subroutine dense_water_initialize_TS(G, GV, param_file, T, S, h, just_read) "Depth of unstratified mixed layer as a fraction of the water column.", & units="nondim", default=default_mld, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & - default=35.0, units='1e-3', do_not_log=just_read) - call get_param(param_file, mdl,"T_REF", T_ref, 'Reference temperature', units='degC', & - fail_if_missing=.not.just_read, do_not_log=just_read) + default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl,"T_REF", T_ref, 'Reference temperature', & + units='degC', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl,"S_RANGE", S_range, 'Initial salinity range', & - units='1e-3', default=2.0, do_not_log=just_read) + units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -165,8 +166,8 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, real, dimension(SZI_(G),SZJ_(G)) :: Idamp ! inverse damping timescale [T-1 ~> s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h ! sponge thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T ! sponge temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S ! sponge salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T ! sponge temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S ! sponge salinity [S ~> ppt] real, dimension(SZK_(GV)+1) :: e0, eta1D ! interface positions for ALE sponge [Z ~> m] integer :: i, j, k, nz @@ -195,9 +196,9 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, call get_param(param_file, mdl, "DENSE_WATER_MLD", mld, default=default_mld, do_not_log=.true.) call get_param(param_file, mdl, "DENSE_WATER_SILL_HEIGHT", sill_height, default=default_sill, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) - call get_param(param_file, mdl, "S_RANGE", S_range, do_not_log=.true.) - call get_param(param_file, mdl, "T_REF", T_ref, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "S_RANGE", S_range, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "T_REF", T_ref, scale=US%degC_to_C, do_not_log=.true.) ! no active sponges if (west_sponge_time_scale <= 0. .and. east_sponge_time_scale <= 0.) return diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index e3d97412bd..e83d1b78a1 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -122,7 +122,7 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=just_read, scale=US%m_to_Z) + units='m', default=1.0e-3, scale=US%m_to_Z, do_not_log=just_read) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -205,12 +205,13 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, end subroutine dumbbell_initialize_thickness !> Initial values for temperature and salinity for the dumbbell test case -subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) +subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. @@ -224,7 +225,7 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - T_surf = 20.0 + T_surf = 20.0*US%degC_to_C call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -232,10 +233,11 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file 'Initial profile shape. Valid values are "linear", "parabolic" '// & 'and "exponential".', default='linear', do_not_log=just_read) call get_param(param_file, mdl, "DUMBBELL_SREF", S_surf, & - 'DUMBBELL REFERENCE SALINITY', units='1e-3', default=34., do_not_log=just_read) + 'DUMBBELL REFERENCE SALINITY', & + units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "DUMBBELL_S_RANGE", S_range, & - 'DUMBBELL salinity range (right-left)', units='1e-3', default=2., & - do_not_log=just_read) + 'DUMBBELL salinity range (right-left)', & + units='1e-3', default=2., scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "DUMBBELL_LEN", dblen, & 'Lateral Length scale for dumbbell ', & units='km', default=600., do_not_log=just_read) @@ -296,7 +298,7 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use integer :: i, j, k, nz real :: x, min_thickness, dblen - real :: S_ref, S_range + real :: S_ref, S_range ! Salinities [S ~> ppt] logical :: dbrotate ! If true, rotate the domain. call get_param(param_file, mdl,"DUMBBELL_LEN",dblen, & @@ -315,11 +317,15 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use call get_param(param_file, mdl, "DUMBBELL_SPONGE_TIME_SCALE", sponge_time_scale, & "The time scale in the reservoir for restoring. If zero, the sponge is disabled.", & units="s", default=0., scale=US%s_to_T) - call get_param(param_file, mdl, "DUMBBELL_SREF", S_ref, do_not_log=.true.) - call get_param(param_file, mdl, "DUMBBELL_S_RANGE", S_range, do_not_log=.true.) + call get_param(param_file, mdl, "DUMBBELL_SREF", S_ref, & + 'DUMBBELL REFERENCE SALINITY', & + units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "DUMBBELL_S_RANGE", S_range, & + 'DUMBBELL salinity range (right-left)', & + units='1e-3', default=2., scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=.true., scale=US%m_to_Z) + units='m', default=1.0e-3, scale=US%m_to_Z, do_not_log=.true.) ! no active sponges if (sponge_time_scale <= 0.) return diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index dfd39e328f..57de92a867 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -188,12 +188,13 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j end subroutine seamount_initialize_thickness !> Initial values for temperature and salinity -subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, param_file, just_read) +subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. @@ -212,25 +213,31 @@ subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, param_file, 'Initial profile shape. Valid values are "linear", "parabolic" '//& 'and "exponential".', default='linear', do_not_log=just_read) call get_param(param_file, mdl,"INITIAL_SSS", S_surf, & - 'Initial surface salinity', units='1e-3', default=34., do_not_log=just_read) + 'Initial surface salinity', & + units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl,"INITIAL_SST", T_surf, & - 'Initial surface temperature', units='C', default=0., do_not_log=just_read) + 'Initial surface temperature', & + units='C', default=0., scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl,"INITIAL_S_RANGE", S_range, & - 'Initial salinity range (bottom - surface)', units='1e-3', & - default=2., do_not_log=just_read) + 'Initial salinity range (bottom - surface)', & + units='1e-3', default=2., scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl,"INITIAL_T_RANGE", T_range, & - 'Initial temperature range (bottom - surface)', units='C', & - default=0., do_not_log=just_read) + 'Initial temperature range (bottom - surface)', & + units='C', default=0., scale=US%degC_to_C, do_not_log=just_read) select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER ) ! Initial thicknesses for layer isopycnal coordinates ! These parameters are used in MOM_fixed_initialization.F90 when CONFIG_COORD="ts_range" call get_param(param_file, mdl, "T_REF", T_ref, default=10.0, do_not_log=.true.) - call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_light, default=T_Ref, do_not_log=.true.) - call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_dense, default=T_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_light, & + default=T_Ref, scale=US%degC_to_C, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_dense, & + default=T_Ref, scale=US%degC_to_C, do_not_log=.true.) call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) - call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) - call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & + default = S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & + default = S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, default=1.0, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 641afa5f3e..de7869511b 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -175,12 +175,13 @@ end subroutine sloshing_initialize_thickness !! reference surface layer salinity and temperature and a specified range. !! Note that the linear distribution is set up with respect to the layer !! number, not the physical position). -subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) +subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -189,9 +190,9 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file integer :: i, j, k, is, ie, js, je, nz real :: delta_T - real :: S_ref, T_ref; ! Reference salinity and temerature within + real :: S_ref, T_ref; ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within ! surface layer - real :: S_range, T_range; ! Range of salinities and temperatures over the + real :: S_range, T_range; ! Range of [S ~> ppt] and temperatures [C ~> degC] over the ! vertical integer :: kdelta real :: deltah @@ -202,15 +203,15 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call get_param(param_file, mdl, "S_REF", S_ref, 'Reference value for salinity', & - default=35.0, units='1e-3', do_not_log=just_read) + default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "T_REF", T_ref, 'Reference value for temperature', & - units='degC', fail_if_missing=.not.just_read, do_not_log=just_read) + units='degC', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) ! The default is to assume an increase by 2 ppt for the salinity and a uniform temperature. call get_param(param_file, mdl,"S_RANGE",S_range,'Initial salinity range.', & - units='1e-3', default=2.0, do_not_log=just_read) + units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', & - units='degC', default=0.0, do_not_log=just_read) + units='degC', default=0.0, scale=US%degC_to_C, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -227,7 +228,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file xi0 = 0.0 do k = 1,nz xi1 = xi0 + deltah / G%max_depth ! = xi0 + 1.0 / real(nz) - S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) + S(i,j,k) = 34.0*US%ppt_to_S + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo enddo ; enddo @@ -240,7 +241,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file T(:,:,k) = T(:,:,k-1) + delta_T enddo kdelta = 2 - T(:,:,GV%ke/2 - (kdelta-1):GV%ke/2 + kdelta) = 1.0 + T(:,:,GV%ke/2 - (kdelta-1):GV%ke/2 + kdelta) = 1.0*US%degC_to_C end subroutine sloshing_initialize_temperature_salinity From 31d411776fe6dc30a94e1a672bd02aa689c00143 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 7 May 2022 21:50:37 -0400 Subject: [PATCH 16/68] Correct a few more temperature and salin units Corrected the units in comments describing some temperature and salinity variables that had been accidentally omitted from the previous commits in this sequence. Also rescaled some local temperature and salinity variables used in seamount_initialize_thickness and added missing unit conversion factors for several diagnostics in MOM_oda_incupd. All answers are bitwise identical. --- src/core/MOM.F90 | 14 ++++------- src/ocean_data_assim/MOM_oda_incupd.F90 | 20 ++++++++-------- .../vertical/MOM_CVMix_KPP.F90 | 8 +++---- .../vertical/MOM_bulk_mixed_layer.F90 | 24 +++++++++---------- .../vertical/MOM_full_convection.F90 | 24 +++++++++---------- .../vertical/MOM_opacity.F90 | 2 +- src/user/DOME2d_initialization.F90 | 4 ++-- src/user/Phillips_initialization.F90 | 4 ++-- src/user/seamount_initialization.F90 | 19 +++++++++------ src/user/user_initialization.F90 | 4 ++-- 10 files changed, 62 insertions(+), 61 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 92434c0039..82c4692c1e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -182,7 +182,7 @@ module MOM real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: & h, & !< layer thickness [H ~> m or kg m-2] T, & !< potential temperature [C ~> degC] - S !< salinity [ppt] + S !< salinity [S ~> ppt] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & u, & !< zonal velocity component [L T-1 ~> m s-1] uh, & !< uh = u * h * dy at u grid points [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -286,10 +286,6 @@ module MOM real, dimension(:,:), pointer :: frac_shelf_h => NULL() !< fraction of total area occupied !! by ice shelf [nondim] real, dimension(:,:), pointer :: mass_shelf => NULL() !< Mass of ice shelf [R Z ~> kg m-2] - real, dimension(:,:,:), pointer :: & - h_pre_dyn => NULL(), & !< The thickness before the transports [H ~> m or kg m-2]. - T_pre_dyn => NULL(), & !< Temperature before the transports [degC]. - S_pre_dyn => NULL() !< Salinity before the transports [ppt]. type(accel_diag_ptrs) :: ADp !< structure containing pointers to accelerations, !! for derived diagnostics (e.g., energy budgets) type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation @@ -3600,15 +3596,15 @@ subroutine rotate_initial_state(u_in, v_in, h_in, T_in, S_in, & real, dimension(:,:,:), intent(in) :: u_in !< Zonal velocity on the initial grid [L T-1 ~> m s-1] real, dimension(:,:,:), intent(in) :: v_in !< Meridional velocity on the initial grid [L T-1 ~> m s-1] real, dimension(:,:,:), intent(in) :: h_in !< Layer thickness on the initial grid [H ~> m or kg m-2] - real, dimension(:,:,:), intent(in) :: T_in !< Temperature on the initial grid [degC] - real, dimension(:,:,:), intent(in) :: S_in !< Salinity on the initial grid [ppt] + real, dimension(:,:,:), intent(in) :: T_in !< Temperature on the initial grid [C ~> degC] + real, dimension(:,:,:), intent(in) :: S_in !< Salinity on the initial grid [S ~> ppt] logical, intent(in) :: use_temperature !< If true, temperature and salinity are active integer, intent(in) :: turns !< The number quarter-turns to apply real, dimension(:,:,:), intent(out) :: u !< Zonal velocity on the rotated grid [L T-1 ~> m s-1] real, dimension(:,:,:), intent(out) :: v !< Meridional velocity on the rotated grid [L T-1 ~> m s-1] real, dimension(:,:,:), intent(out) :: h !< Layer thickness on the rotated grid [H ~> m or kg m-2] - real, dimension(:,:,:), intent(out) :: T !< Temperature on the rotated grid [degC] - real, dimension(:,:,:), intent(out) :: S !< Salinity on the rotated grid [ppt] + real, dimension(:,:,:), intent(out) :: T !< Temperature on the rotated grid [C ~> degC] + real, dimension(:,:,:), intent(out) :: S !< Salinity on the rotated grid [S ~> ppt] call rotate_vector(u_in, v_in, turns, u, v) call rotate_array(h_in, turns, h) diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index 623f7da7b9..77f20c4f66 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -527,8 +527,8 @@ subroutine apply_oda_incupd(h, tv, u, v, dt, G, GV, US, CS) real, dimension(SZK_(GV)) :: tmp_val1 ! data values remapped to model grid real, dimension(SZK_(GV)) :: hu, hv ! A column of thicknesses at u or v points [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tmp_t !< A temporary array for t increments [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tmp_s !< A temporary array for s increments [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tmp_t !< A temporary array for t increments [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tmp_s !< A temporary array for s increments [S ~> ppt] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: tmp_u !< A temporary array for u increments [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: tmp_v !< A temporary array for v increments [L T-1 ~> m s-1] @@ -726,6 +726,7 @@ subroutine apply_oda_incupd(h, tv, u, v, dt, G, GV, US, CS) if (CS%id_u_oda_inc > 0) call post_data(CS%id_u_oda_inc, tmp_u, CS%diag) if (CS%id_v_oda_inc > 0) call post_data(CS%id_v_oda_inc, tmp_v, CS%diag) endif + !### The argument here seems wrong. if (CS%id_h_oda_inc > 0) call post_data(CS%id_h_oda_inc, h , CS%diag) if (CS%id_T_oda_inc > 0) call post_data(CS%id_T_oda_inc, tmp_t, CS%diag) if (CS%id_S_oda_inc > 0) call post_data(CS%id_S_oda_inc, tmp_s, CS%diag) @@ -795,7 +796,7 @@ end subroutine output_oda_incupd_inc subroutine init_oda_incupd_diags(Time, G, GV, diag, CS, US) type(time_type), target, intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. type(oda_incupd_CS), pointer :: CS !< ALE sponge control structure @@ -804,18 +805,17 @@ subroutine init_oda_incupd_diags(Time, G, GV, diag, CS, US) if (.not.associated(CS)) return CS%diag => diag - ! These diagnostics of the state variables increments,useful for debugging the - ! ODA code. + ! These diagnostics of the state variables increments are useful for debugging the ODA code. CS%id_u_oda_inc = register_diag_field('ocean_model', 'u_oda_inc', diag%axesCuL, Time, & - 'Zonal velocity ODA inc.', 'm s-1') + 'Zonal velocity ODA inc.', 'm s-1', conversion=US%L_T_to_m_s) CS%id_v_oda_inc = register_diag_field('ocean_model', 'v_oda_inc', diag%axesCvL, Time, & - 'Meridional velocity ODA inc.', 'm s-1') + 'Meridional velocity ODA inc.', 'm s-1', conversion=US%L_T_to_m_s) CS%id_h_oda_inc = register_diag_field('ocean_model', 'h_oda_inc', diag%axesTL, Time, & - 'Layer Thickness ODA inc.', get_thickness_units(GV)) + 'Layer Thickness ODA inc.', get_thickness_units(GV), conversion=GV%H_to_mks) CS%id_T_oda_inc = register_diag_field('ocean_model', 'T_oda_inc', diag%axesTL, Time, & - 'Temperature ODA inc.', 'degC') + 'Temperature ODA inc.', 'degC', conversion=US%C_to_degC) CS%id_S_oda_inc = register_diag_field('ocean_model', 'S_oda_inc', diag%axesTL, Time, & - 'Salinity ODA inc.', 'PSU') + 'Salinity ODA inc.', 'PSU', conversion=US%S_to_ppt) end subroutine init_oda_incupd_diags diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 7b9e89edf1..aa9468b67f 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1394,12 +1394,12 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of temperature !! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, intent(in) :: dt !< Time-step [T ~> s] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< temperature [C ~> degC] real, intent(in) :: C_p !< Seawater specific heat capacity !! [Q C-1 ~> J kg-1 degC-1] integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [degC T-1 ~> degC s-1] + real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [C T-1 ~> degC s-1] dtracer(:,:,:) = 0.0 @@ -1458,10 +1458,10 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt !! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] real, intent(in) :: dt !< Time-step [T ~> s] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [S ~> ppt] integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [ppt T-1 ~> ppt s-1] + real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [S T-1 ~> ppt s-1] dtracer(:,:,:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index a627314336..5df132a44d 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -761,7 +761,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential !! density [R ~> kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures [C ~> degC]. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities [ppt]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities [S ~> ppt]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The negligibly small amount of water !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a layer @@ -908,7 +908,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G),SZK0_(GV)), & intent(in) :: T !< Layer temperatures [C ~> degC]. real, dimension(SZI_(G),SZK0_(GV)), & - intent(in) :: S !< Layer salinities [ppt]. + intent(in) :: S !< Layer salinities [C ~> ppt]. real, dimension(SZI_(G),SZK0_(GV)), & intent(in) :: R0 !< Potential density referenced to !! surface pressure [R ~> kg m-3]. @@ -940,7 +940,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! shortwave radiation. real, dimension(max(nsw,1),SZI_(G)), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave !! heating at the sea surface in each penetrating - !! band [degC H ~> C m or degC kg m-2]. + !! band [C H ~> degC m or degC kg m-2]. real, dimension(max(nsw,1),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< The opacity in each band of !! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(out) :: Conv_En !< The buoyant turbulent kinetic energy source @@ -1465,9 +1465,9 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: v !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK0_(GV)), & - intent(in) :: T !< Layer temperatures [degC]. + intent(in) :: T !< Layer temperatures [C ~> degC]. real, dimension(SZI_(G),SZK0_(GV)), & - intent(in) :: S !< Layer salinities [ppt]. + intent(in) :: S !< Layer salinities [S ~> ppt]. real, dimension(SZI_(G),SZK0_(GV)), & intent(in) :: R0 !< Potential density referenced to !! surface pressure [R ~> kg m-3]. @@ -1478,7 +1478,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & intent(in) :: eps !< The negligibly small amount of water !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to - !! temperature [R degC-1 ~> kg m-3 degC-1]. + !! temperature [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to !! temperature [R C-1 ~> kg m-3 degC-1]. real, dimension(2,SZI_(G)), intent(in) :: cMKE !< Coefficients of HpE and HpE^2 used in calculating the @@ -1832,8 +1832,8 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! structure. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures [degC]. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities [ppt]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures [C ~> degC]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities [S ~> ppt]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to !! surface pressure [R ~> kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining @@ -2151,8 +2151,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature [degC]. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [ppt]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature [C ~> degC]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [S ~> ppt]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to !! surface pressure [R ~> kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential @@ -3040,8 +3040,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature [degC]. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [ppt]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature [C ~> degC]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [S ~> ppt]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to !! surface pressure [R ~> kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index fc006af605..344511bf29 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -270,22 +270,22 @@ end subroutine full_convection !! above and below, including partial calculations from a tridiagonal solver. function is_unstable(dRho_dT, dRho_dS, h_a, h_b, mix_A, mix_B, T_a, T_b, S_a, S_b, & Te_aa, Te_bb, Se_aa, Se_bb, d_A, d_B) - real, intent(in) :: dRho_dT !< The derivative of in situ density with temperature [R degC-1 ~> kg m-3 degC-1] - real, intent(in) :: dRho_dS !< The derivative of in situ density with salinity [R ppt-1 ~> kg m-3 ppt-1] + real, intent(in) :: dRho_dT !< The derivative of in situ density with temperature [R C-1 ~> kg m-3 degC-1] + real, intent(in) :: dRho_dS !< The derivative of in situ density with salinity [R S-1 ~> kg m-3 ppt-1] real, intent(in) :: h_a !< The thickness of the layer above [H ~> m or kg m-2] real, intent(in) :: h_b !< The thickness of the layer below [H ~> m or kg m-2] real, intent(in) :: mix_A !< The time integrated mixing rate of the interface above [H ~> m or kg m-2] real, intent(in) :: mix_B !< The time integrated mixing rate of the interface below [H ~> m or kg m-2] - real, intent(in) :: T_a !< The initial temperature of the layer above [degC] - real, intent(in) :: T_b !< The initial temperature of the layer below [degC] - real, intent(in) :: S_a !< The initial salinity of the layer below [ppt] - real, intent(in) :: S_b !< The initial salinity of the layer below [ppt] - real, intent(in) :: Te_aa !< The estimated temperature two layers above rescaled by d_A [degC] - real, intent(in) :: Te_bb !< The estimated temperature two layers below rescaled by d_B [degC] - real, intent(in) :: Se_aa !< The estimated salinity two layers above rescaled by d_A [ppt] - real, intent(in) :: Se_bb !< The estimated salinity two layers below rescaled by d_B [ppt] - real, intent(in) :: d_A !< The rescaling dependency across the interface above, nondim. - real, intent(in) :: d_B !< The rescaling dependency across the interface below, nondim. + real, intent(in) :: T_a !< The initial temperature of the layer above [C ~> degC] + real, intent(in) :: T_b !< The initial temperature of the layer below [C ~> degC] + real, intent(in) :: S_a !< The initial salinity of the layer below [S ~> ppt] + real, intent(in) :: S_b !< The initial salinity of the layer below [S ~> ppt] + real, intent(in) :: Te_aa !< The estimated temperature two layers above rescaled by d_A [C ~> degC] + real, intent(in) :: Te_bb !< The estimated temperature two layers below rescaled by d_B [C ~> degC] + real, intent(in) :: Se_aa !< The estimated salinity two layers above rescaled by d_A [S ~> ppt] + real, intent(in) :: Se_bb !< The estimated salinity two layers below rescaled by d_B [S ~> ppt] + real, intent(in) :: d_A !< The rescaling dependency across the interface above [nondim] + real, intent(in) :: d_B !< The rescaling dependency across the interface below [nondim] logical :: is_unstable !< The return value, true if the profile is statically unstable !! around the interface in question. diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 31adc9d446..7f9f61a1dc 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -568,7 +568,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature [C H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: dSV_dT !< The partial derivative of specific volume - !! with temperature [R-1 degC-1 ~> m3 kg-1 degC-1] + !! with temperature [R-1 C-1 ~> m3 kg-1 degC-1] real, dimension(SZI_(G),SZK_(GV)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating !! throughout a layer [R Z3 T-2 ~> J m-2]. diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 5669359c55..054a9fe81c 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -357,8 +357,8 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure ! Local variables - real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temp [degC] - real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt [ppt] + real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temp [C ~> degC] + real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt [S ~> ppt] real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness [H ~> m or kg m-2]. real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m] real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index f4f18869c4..97d26f7ee2 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -383,8 +383,8 @@ end subroutine Phillips_initialize_topography !! D - Basin depth [Z ~> m] (positive downward) !! f - The Coriolis parameter [T-1 ~> s-1]. !! If ENABLE_THERMODYNAMICS is defined: -!! T - Temperature [degC]. -!! S - Salinity [ppt]. +!! T - Temperature [C ~> degC]. +!! S - Salinity [S ~> ppt]. !! If SPONGE is defined: !! A series of subroutine calls are made to set up the damping !! rates and reference profiles for all variables that are damped diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 57de92a867..5b62993551 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -93,7 +93,8 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. - real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities [ppt]. + real :: S_ref ! A default value for salinities [ppt]. + real :: S_surf, S_range, S_light, S_dense ! Various salinities [S ~> ppt]. real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. character(len=20) :: verticalCoordinate integer :: i, j, k, is, ie, js, je, nz @@ -123,11 +124,15 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) ! Initial thicknesses for isopycnal coordinates - call get_param(param_file, mdl,"INITIAL_SSS", S_surf, default=34., do_not_log=.true.) - call get_param(param_file, mdl,"INITIAL_S_RANGE", S_range, default=2., do_not_log=.true.) + call get_param(param_file, mdl,"INITIAL_SSS", S_surf, & + units="ppt", default=34., scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl,"INITIAL_S_RANGE", S_range, & + units="ppt", default=2., scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) - call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) - call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & + units="ppt", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & + units="ppt", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "INTERFACE_IC_QUANTA", eta_IC_quanta, & "The granularity of initial interface height values "//& "per meter, to avoid sensivity to order-of-arithmetic changes.", & @@ -191,8 +196,8 @@ end subroutine seamount_initialize_thickness subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file structure diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 08c75a6ced..b9d16e548a 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -238,8 +238,8 @@ end subroutine write_user_log !! - GV%g_prime - The reduced gravity at each interface [L2 Z-1 T-2 ~> m s-2]. !! - GV%Rlay - Layer potential density (coordinate variable) [R ~> kg m-3]. !! If ENABLE_THERMODYNAMICS is defined: -!! - T - Temperature [degC]. -!! - S - Salinity [ppt]. +!! - T - Temperature [C ~> degC]. +!! - S - Salinity [S ~> ppt]. !! If BULKMIXEDLAYER is defined: !! - Rml - Mixed layer and buffer layer potential densities [R ~> kg m-3]. !! If SPONGE is defined: From b3c41b10570260c3ede81e4f90b39bd834279950 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 12 May 2022 05:50:57 -0400 Subject: [PATCH 17/68] +Rescale vars in MOM_temp_salt_initialize_from_Z Works with rescaled temperatures and salinities for the internal calculations in MOM_temp_salt_initialize_from_Z, taking advantage of the recently corrected rescaling capabilities in horiz_interp_and_extrap_tracer. This commit also includes these other closely related changes. - Modified convert_temp_salt_for_TEOS10 to work with rescaled temperature and salinity units - Eliminated unused land_fill argument from determine_temperature - Slightly refactored tracer_z_init_array to avoid needing an extra set of do loop through the 3-d array when a scale argument is present All answers are bitwise identical, but there are changes in the arguments to publicly visible interfaces. --- src/equation_of_state/MOM_EOS.F90 | 8 +- src/framework/MOM_diag_mediator.F90 | 4 +- .../MOM_state_initialization.F90 | 126 ++++++++---------- src/tracer/MOM_tracer_Z_init.F90 | 22 ++- 4 files changed, 72 insertions(+), 88 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 440bd8aa36..a6156d05c0 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1606,9 +1606,9 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) integer, intent(in) :: kd !< The number of layers to work on type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & - intent(inout) :: T !< Potential temperature referenced to the surface [degC] + intent(inout) :: T !< Potential temperature referenced to the surface [C ~> degC] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & - intent(inout) :: S !< Salinity [ppt] + intent(inout) :: S !< Salinity [S ~> ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & intent(in) :: mask_z !< 3d mask regulating which points to convert. type(EOS_type), intent(in) :: EOS !< Equation of state structure @@ -1620,12 +1620,12 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) do k=1,kd ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec if (mask_z(i,j,k) >= 1.0) then - S(i,j,k) = gsw_sr_from_sp(S(i,j,k)) + S(i,j,k) = EOS%ppt_to_S*gsw_sr_from_sp(EOS%S_to_ppt*S(i,j,k)) ! Get absolute salinity from practical salinity, converting pressures from Pascal to dbar. ! If this option is activated, pressure will need to be added as an argument, and it should be ! moved out into module that is not shared between components, where the ocean_grid can be used. ! S(i,j,k) = gsw_sa_from_sp(S(i,j,k),pres(i,j,k)*1.0e-4,G%geoLonT(i,j),G%geoLatT(i,j)) - T(i,j,k) = gsw_ct_from_pt(S(i,j,k), T(i,j,k)) + T(i,j,k) = EOS%degC_to_C*gsw_ct_from_pt(EOS%S_to_ppt*S(i,j,k), EOS%S_to_ppt*T(i,j,k)) endif enddo ; enddo ; enddo end subroutine convert_temp_salt_for_TEOS10 diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 2816ac2c6a..1f6b4133c0 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -306,8 +306,8 @@ module MOM_diag_mediator ! Pointer to H, G and T&S needed for remapping real, dimension(:,:,:), pointer :: h => null() !< The thicknesses needed for remapping [H ~> m or kg m-2] - real, dimension(:,:,:), pointer :: T => null() !< The temperatures needed for remapping [degC] - real, dimension(:,:,:), pointer :: S => null() !< The salinities needed for remapping [ppt] + real, dimension(:,:,:), pointer :: T => null() !< The temperatures needed for remapping [C ~> degC] + real, dimension(:,:,:), pointer :: S => null() !< The salinities needed for remapping [S ~> ppt] type(EOS_type), pointer :: eqn_of_state => null() !< The equation of state type type(ocean_grid_type), pointer :: G => null() !< The ocean grid type type(verticalGrid_type), pointer :: GV => null() !< The model's vertical ocean grid diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index b6a3e9ee9d..829368efbc 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1783,9 +1783,9 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is - !! being initialized [degC] + !! being initialized [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is - !! being initialized [ppt] + !! being initialized [S ~> ppt] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters @@ -2419,7 +2419,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just real :: PI_180 ! for conversion from degrees to radians real :: Hmix_default ! The default initial mixed layer depth [m]. real :: Hmix_depth ! The mixed layer depth in the initial condition [Z ~> m]. - real :: missing_value_temp, missing_value_salt + real :: missing_value_temp ! The missing value in the input temperature field + real :: missing_value_salt ! The missing value in the input salinity field logical :: correct_thickness real :: h_tolerance ! A parameter that controls the tolerance when adjusting the ! thickness to fit the bathymetry [Z ~> m]. @@ -2427,15 +2428,15 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just integer, parameter :: niter=10 ! number of iterations for t/s adjustment to layer density logical :: adjust_temperature = .true. ! fit t/s to target densities - real, parameter :: missing_value = -1.e20 - real, parameter :: temp_land_fill = 0.0, salt_land_fill = 35.0 + real :: temp_land_fill ! A temperature value to use for land points [C ~> degC] + real :: salt_land_fill ! A salinity value to use for land points [C ~> degC] logical :: reentrant_x, tripolar_n ! data arrays real, dimension(:), allocatable :: z_edges_in, z_in ! Interface heights [Z ~> m] real, dimension(:), allocatable :: Rb ! Interface densities [R ~> kg m-3] - real, dimension(:,:,:), allocatable, target :: temp_z ! Input temperatures [degC] - real, dimension(:,:,:), allocatable, target :: salt_z ! Input salinities [ppt] + real, dimension(:,:,:), allocatable, target :: temp_z ! Input temperatures [C ~> degC] + real, dimension(:,:,:), allocatable, target :: salt_z ! Input salinities [S ~> ppt] real, dimension(:,:,:), allocatable, target :: mask_z ! 1 for valid data points [nondim] real, dimension(:,:,:), allocatable :: rho_z ! Densities in Z-space [R ~> kg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: zi ! Interface heights [Z ~> m]. @@ -2464,8 +2465,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 [degC] - real :: saltAvg ! Spatially averaged salinities on a layer [ppt] + real :: tempAvg ! Spatially averaged temperatures on a layer [C ~> degC] + real :: saltAvg ! Spatially averaged salinities on a layer [S ~> ppt] logical :: do_conv_adj, ignore integer :: nPoints integer :: id_clock_routine, id_clock_ALE @@ -2592,6 +2593,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just return ! All run-time parameters have been read, so return. endif + !### These hard-coded constants should be made into runtime parameters + temp_land_fill = 0.0*US%degC_to_C + salt_land_fill = 35.0*US%ppt_to_S + eps_z = GV%Angstrom_Z eps_rho = 1.0e-10*US%kg_m3_to_R @@ -2610,35 +2615,24 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just ! to the North/South Pole past the limits of the input data, they are extrapolated using the average ! value at the northernmost/southernmost latitude. - call horiz_interp_and_extrap_tracer(tfilename, potemp_var, 1.0, 1, & + call horiz_interp_and_extrap_tracer(tfilename, potemp_var, US%degC_to_C, 1, & G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, & - tripolar_n, homogenize, m_to_Z=US%m_to_Z, answers_2018=hor_regrid_answers_2018, ongrid=pre_gridded) + tripolar_n, homogenize, m_to_Z=US%m_to_Z, answers_2018=hor_regrid_answers_2018, & + ongrid=pre_gridded, tr_iter_tol=1.0e-3*US%degC_to_C) - call horiz_interp_and_extrap_tracer(sfilename, salin_var, 1.0, 1, & + call horiz_interp_and_extrap_tracer(sfilename, salin_var, US%ppt_to_S, 1, & G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, & - tripolar_n, homogenize, m_to_Z=US%m_to_Z, answers_2018=hor_regrid_answers_2018, ongrid=pre_gridded) + tripolar_n, homogenize, m_to_Z=US%m_to_Z, answers_2018=hor_regrid_answers_2018, & + ongrid=pre_gridded, tr_iter_tol=1.0e-3*US%ppt_to_S) kd = size(z_in,1) ! Convert the sign convention of Z_edges_in. do k=1,size(Z_edges_in,1) ; Z_edges_in(k) = -Z_edges_in(k) ; enddo - allocate(rho_z(isd:ied,jsd:jed,kd)) - ! Convert T&S to Absolute Salinity and Conservative Temperature if using TEOS10 or NEMO call convert_temp_salt_for_TEOS10(temp_z, salt_z, G%HI, kd, mask_z, eos) - press(:) = tv%P_Ref - EOSdom(:) = EOS_domain(G%HI) - do k=1,kd ; do j=js,je - call calculate_density(US%degC_to_C*temp_z(:,j,k), US%ppt_to_S*salt_z(:,j,k), press, rho_z(:,j,k), eos, EOSdom) - enddo ; enddo - - call pass_var(temp_z,G%Domain) - call pass_var(salt_z,G%Domain) - call pass_var(mask_z,G%Domain) - call pass_var(rho_z,G%Domain) - do j=js,je ; do i=is,ie Z_bottom(i,j) = -depth_tot(i,j) enddo ; enddo @@ -2661,15 +2655,15 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just do k = 1, nkd if (tmp_mask_in(i,j,k)>0. .and. k<=kd) then zBottomOfCell = max( z_edges_in(k+1), Z_bottom(i,j)) - tmpT1dIn(i,j,k) = US%degC_to_C*temp_z(i,j,k) - tmpS1dIn(i,j,k) = US%ppt_to_S*salt_z(i,j,k) + tmpT1dIn(i,j,k) = temp_z(i,j,k) + tmpS1dIn(i,j,k) = salt_z(i,j,k) elseif (k>1) then zBottomOfCell = Z_bottom(i,j) tmpT1dIn(i,j,k) = tmpT1dIn(i,j,k-1) tmpS1dIn(i,j,k) = tmpS1dIn(i,j,k-1) else ! This next block should only ever be reached over land - tmpT1dIn(i,j,k) = -99.9*US%degC_to_C - tmpS1dIn(i,j,k) = -99.9*US%ppt_to_S + tmpT1dIn(i,j,k) = -99.9*US%degC_to_C ! Change to temp_land_fill + tmpS1dIn(i,j,k) = -99.9*US%ppt_to_S ! Change to salt_land_fill endif h1(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k @@ -2679,9 +2673,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just endif ! mask2dT enddo ; enddo deallocate( tmp_mask_in ) - call pass_var(h1, G%Domain) - call pass_var(tmpT1dIn, G%Domain) - call pass_var(tmpS1dIn, G%Domain) ! Build the target grid (and set the model thickness to it) ! This call can be more general but is hard-coded for z* coordinates... ???? @@ -2705,7 +2696,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just h(i,j,:) = 0. endif ! mask2dT enddo ; enddo - call pass_var(h, G%Domain) deallocate( hTarget ) endif @@ -2756,9 +2746,18 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just nkml = 0 ; if (separate_mixed_layer) nkml = GV%nkml + press(:) = tv%P_Ref + EOSdom(:) = EOS_domain(G%HI) + allocate(rho_z(isd:ied,jsd:jed,kd)) + do k=1,kd ; do j=js,je + call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), eos, EOSdom) + enddo ; enddo + call find_interfaces(rho_z, z_in, kd, Rb, Z_bottom, zi, G, GV, US, nlevs, nkml, & Hmix_depth, eps_z, eps_rho, density_extrap_bug) + deallocate(rho_z) + if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, US, zi, h, h_tolerance, dZ_ref_eta=G%Z_ref) else @@ -2784,21 +2783,21 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just endif endif - call tracer_z_init_array(temp_z, z_edges_in, kd, zi, missing_value, G, nz, nlevs, eps_z, & - tv%T, scale=US%degC_to_C) - call tracer_z_init_array(salt_z, z_edges_in, kd, zi, missing_value, G, nz, nlevs, eps_z, & - tv%S, scale=US%ppt_to_S) - - do k=1,nz - nPoints = 0 ; tempAvg = 0. ; saltAvg = 0. - do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then - nPoints = nPoints + 1 - tempAvg = tempAvg + US%C_to_degC*tv%T(i,j,k) - saltAvg = saltAvg + US%S_to_ppt*tv%S(i,j,k) - endif ; enddo ; enddo + call tracer_z_init_array(temp_z, z_edges_in, kd, zi, temp_land_fill, G, nz, nlevs, eps_z, & + tv%T) + call tracer_z_init_array(salt_z, z_edges_in, kd, zi, salt_land_fill, G, nz, nlevs, eps_z, & + tv%S) + if (homogenize) then ! Horizontally homogenize data to produce perfectly "flat" initial conditions - if (homogenize) then + do k=1,nz + nPoints = 0 ; tempAvg = 0. ; saltAvg = 0. + do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then + nPoints = nPoints + 1 + tempAvg = tempAvg + tv%T(i,j,k) + saltAvg = saltAvg + tv%S(i,j,k) + endif ; enddo ; enddo + !### These averages will not reproduce across PE layouts or grid rotation. call sum_across_PEs(nPoints) call sum_across_PEs(tempAvg) @@ -2807,32 +2806,21 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just tempAvg = tempAvg / real(nPoints) saltAvg = saltAvg / real(nPoints) endif - tv%T(:,:,k) = US%degC_to_C*tempAvg - tv%S(:,:,k) = US%ppt_to_S*saltAvg - endif - enddo - - endif ! useALEremapping - - ! Fill land values - do k=1,nz ; do j=js,je ; do i=is,ie - if (tv%T(i,j,k) == US%degC_to_C*missing_value) then - tv%T(i,j,k) = US%degC_to_C*temp_land_fill - tv%S(i,j,k) = US%ppt_to_S*salt_land_fill + tv%T(:,:,k) = tempAvg + tv%S(:,:,k) = saltAvg + enddo endif - enddo ; enddo ; enddo + if (adjust_temperature) then + ! Finally adjust to target density + ks = 1 ; if (separate_mixed_layer) ks = GV%nk_rho_varies + 1 + call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), tv%P_Ref, niter, & + h, ks, G, GV, US, eos) + endif - if (adjust_temperature .and. .not. useALEremapping) then - ! Finally adjust to target density - ks = 1 ; if (separate_mixed_layer) ks = GV%nk_rho_varies + 1 - call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), tv%P_Ref, niter, & - missing_value, h, ks, G, GV, US, eos) - endif + endif ! useALEremapping deallocate(z_in, z_edges_in, temp_z, salt_z, mask_z) - deallocate(rho_z) - call pass_var(h, G%Domain) call pass_var(tv%T, G%Domain) @@ -2984,7 +2972,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) ! Local variables integer, parameter :: nk=5 real, dimension(nk) :: T, T_t, T_b ! Temperatures [C ~> degC] - real, dimension(nk) :: S, S_t, S_b ! Salinities [ppt] + real, dimension(nk) :: S, S_t, S_b ! Salinities [S ~> ppt] real, dimension(nk) :: rho ! Layer density [R ~> kg m-3] real, dimension(nk) :: h ! Layer thicknesses [H ~> m or kg m-2] real, dimension(nk) :: z ! Height of layer center [Z ~> m] diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index d5c3851b60..85a858b8df 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -42,7 +42,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, GV, US, missing_val, land_va real, optional, intent(in) :: land_val !< A value to use to fill in land points ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" real, allocatable, dimension(:,:,:) :: & tr_in ! The z-space array of tracer concentrations that is read in. @@ -283,7 +283,7 @@ subroutine tracer_z_init_array(tr_in, z_edges, nk_data, e, land_fill, G, nlay, n integer, intent(in) :: nlay !< The number of vertical layers in the target grid real, dimension(SZI_(G),SZJ_(G),nlay+1), & intent(in) :: e !< The depths of the target layer interfaces [Z ~> m] or [m] - real, intent(in) :: land_fill !< fill in data over land [A] + real, intent(in) :: land_fill !< fill in data over land [B] integer, dimension(SZI_(G),SZJ_(G)), & intent(in) :: nlevs !< The number of input levels with valid data real, intent(in) :: eps_z !< A negligibly thin layer thickness [Z ~> m]. @@ -293,19 +293,22 @@ subroutine tracer_z_init_array(tr_in, z_edges, nk_data, e, land_fill, G, nlay, n !! input tracers [B A-1 ~> 1] ! Local variables - real :: tr_1d(nk_data) ! A copy of the input tracer concentrations in a column [A] + real :: tr_1d(nk_data) ! A copy of the input tracer concentrations in a column [B] real :: e_1d(nlay+1) ! A 1-d column of interface heights, in the same units as e [Z ~> m] or [m] - real :: sl_tr ! The tracer concentration slope times the layer thickness, in tracer units [A] + real :: sl_tr ! The tracer concentration slope times the layer thickness, in tracer units [B] real :: wt(nk_data) ! The fractional weight for each layer in the range between z1 and z2 [nondim] real :: z1(nk_data) ! z1 and z2 are the fractional depths of the top and bottom real :: z2(nk_data) ! limits of the part of a z-cell that contributes to a layer, relative ! to the cell center and normalized by the cell thickness [nondim]. ! Note that -1/2 <= z1 <= z2 <= 1/2. + real :: scale_fac ! A factor by which to scale the output tracers from the input tracers [B A-1 ~> 1] integer :: k_top, k_bot, k_bot_prev, kstart integer :: i, j, k, kz, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + scale_fac = 1.0 ; if (present(scale)) then ; scale_fac = scale ; endif + do j=js,je i_loop: do i=is,ie if (nlevs(i,j) == 0 .or. G%mask2dT(i,j) == 0.) then @@ -314,7 +317,7 @@ subroutine tracer_z_init_array(tr_in, z_edges, nk_data, e, land_fill, G, nlay, n endif do k=1,nk_data - tr_1d(k) = tr_in(i,j,k) + tr_1d(k) = scale_fac*tr_in(i,j,k) enddo do k=1,nlay+1 @@ -372,12 +375,6 @@ subroutine tracer_z_init_array(tr_in, z_edges, nk_data, e, land_fill, G, nlay, n enddo i_loop enddo - if (present(scale)) then ; if (scale /= 1.0) then - do k=1,nlay ; do j=js,je ; do i=is,ie - tr(i,j,k) = scale*tr(i,j,k) - enddo ; enddo ; enddo - endif ; endif - end subroutine tracer_z_init_array !> This subroutine reads the vertical coordinate data for a field from a NetCDF file. @@ -559,7 +556,7 @@ end function find_limited_slope !> This subroutine determines the potential temperature and salinity that !! is consistent with the target density using provided initial guess -subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, k_start, G, GV, US, & +subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, GV, US, & EOS, h_massless) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -571,7 +568,6 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, real, intent(in) :: p_ref !< reference pressure [R L2 T-2 ~> Pa]. integer, intent(in) :: niter !< maximum number of iterations integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) - real, intent(in) :: land_fill !< land fill value real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< layer thickness, used only to avoid working on !! massless layers [H ~> m or kg m-2] From d4ccf5663f0a60f2e45f33a2381b2cd84bc561d5 Mon Sep 17 00:00:00 2001 From: Angus Gibson Date: Mon, 16 May 2022 10:18:21 +1000 Subject: [PATCH 18/68] Fix data read for on-grid interpolation The wrong MOM_read_data interface was being used: a 2D slice of a 3D field was expected, but the interface for a 2D field was being called. --- src/framework/MOM_horizontal_regridding.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index ebc59cd288..05e3e393b6 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -456,7 +456,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (is_ongrid) then start(1) = is+G%HI%idg_offset ; start(2) = js+G%HI%jdg_offset ; start(3) = k count(1) = ie-is+1 ; count(2) = je-js+1; count(3) = 1; start(4) = 1; count(4) = 1 - call MOM_read_data(trim(filename), trim(varnam), tr_in, G%Domain, timelevel=1) + call MOM_read_data(trim(filename), trim(varnam), tr_in, start, count, G%Domain) do j=js,je do i=is,ie if (abs(tr_in(i,j)-missing_val_in) > abs(roundoff*missing_val_in)) then From 079fd3e44b0a461c180e23f17cc73cfbc5f09dba Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 16 May 2022 05:31:39 -0400 Subject: [PATCH 19/68] +Add cons_temp_to_pot_temp & abs_saln_to_prac_saln This commit adds new functionality to the MOM_EOS module to support the dimensional rescaling of temperatures and salinities. - Added the new routines cons_temp_to_pot_temp and abs_saln_to_prac_saln to convert between forms of temperature and salinity variables, respectively. These work on arrays of rescaled variables. - Added the new optional argument scale_from_EOS to calculate_TFreeze_scalar, to indicate that this routine should use the unit scaling stored in their EOS_type arguments. - Also corrected some comments throughout MOM_EOS.F90. All answers are bitwise identical, but there are new public interfaces. --- src/equation_of_state/MOM_EOS.F90 | 159 +++++++++++++++++++++++++----- 1 file changed, 132 insertions(+), 27 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index a6156d05c0..0995895569 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -53,6 +53,8 @@ module MOM_EOS public calculate_TFreeze public convert_temp_salt_for_TEOS10 public extract_member_EOS +public cons_temp_to_pot_temp +public abs_saln_to_prac_saln public gsw_sp_from_sr public gsw_pt_from_ct public query_compressible @@ -162,7 +164,7 @@ module MOM_EOS !> Calls the appropriate subroutine to calculate density of sea water for scalar inputs. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. The pressure and -!! density can be rescaled with the US. If both the US and scale arguments are present the density +!! density can be rescaled with the values stored in EOS. If the scale argument is present the density !! scaling uses the product of the two scaling factors. subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] @@ -172,7 +174,7 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [R ~> kg m-3] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale output density in - !! combination with scaling given by US [various] + !! combination with scaling stored in EOS [various] real :: Ta(1) ! An array of temperatures [degC] real :: Sa(1) ! An array of salinities [ppt] @@ -212,7 +214,7 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [R ~> kg m-3]. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale output density in - !! combination with scaling given by US [various] + !! combination with scaling stored in EOS [various] ! Local variables real :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] @@ -350,7 +352,7 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) !! into account that arrays start at 1. real, optional, intent(in) :: rho_ref !< A reference density [R ~> kg m-3] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! in combination with scaling given by US [various] + !! in combination with scaling stored in EOS [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] @@ -407,7 +409,7 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, !! into account that arrays start at 1. real, optional, intent(in) :: rho_ref !< A reference density [R ~> kg m-3] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! in combination with scaling given by US [various] + !! in combination with scaling stored in EOS [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: T2_scale ! A factor to convert temperature variance to units of degC2 [degC2 C-2 ~> 1] @@ -486,7 +488,7 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific - !! volume in combination with scaling given by US [various] + !! volume in combination with scaling stored in EOS [various] real, dimension(size(specvol)) :: rho ! Density [kg m-3] integer :: j @@ -529,7 +531,7 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific - !! volume in combination with scaling given by US [various] + !! volume in combination with scaling stored in EOS [various] real, dimension(1) :: Ta ! Rescaled single element array version of temperature [degC] real, dimension(1) :: Sa ! Rescaled single element array version of salinity [ppt] @@ -568,7 +570,7 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale !! output specific volume in combination with - !! scaling given by US [various] + !! scaling stored in EOS [various] ! Local variables real, dimension(size(T)) :: pres ! Pressure converted to [Pa] real, dimension(size(T)) :: Ta ! Temperature converted to [degC] @@ -610,32 +612,45 @@ end subroutine calc_spec_vol_1d !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs. -subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) - real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure, in [Pa] or [R L2 T-2 ~> Pa] depending on pres_scale - real, intent(out) :: T_fr !< Freezing point potential temperature referenced - !! to the surface [degC] - type(EOS_type), intent(in) :: EOS !< Equation of state structure +subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale, scale_from_EOS) + real, intent(in) :: S !< Salinity, [ppt] or [Z ~> ppt] depending on scale_from_EOS + real, intent(in) :: pressure !< Pressure, in [Pa] or [R L2 T-2 ~> Pa] depending on + !! pres_scale or scale_from_EOS + real, intent(out) :: T_fr !< Freezing point potential temperature referenced to the + !! surface [degC] or [degC ~> C] depending on scale_from_EOS + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure - !! into Pa [Pa T2 R-1 L-2 ~> 1]. + !! into Pa [Pa T2 R-1 L-2 ~> 1]. + logical, optional, intent(in) :: scale_from_EOS !< If present true use the dimensional scaling + !! factors stored in EOS. Omission is the same .false. ! Local variables - real :: p_scale ! A factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] + real :: S_scale ! A factor to convert salinity to units of ppt [ppt S-1 ~> 1] - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + p_scale = 1.0 ; S_scale = 1.0 + if (present(pres_scale)) p_scale = pres_scale + if (present(scale_from_EOS)) then ; if (scale_from_EOS) then + p_scale = EOS%RL2_T2_to_Pa + S_scale = EOS%S_to_ppt + endif ; endif select case (EOS%form_of_TFreeze) case (TFREEZE_LINEAR) - call calculate_TFreeze_linear(S, p_scale*pressure, T_fr, EOS%TFr_S0_P0, & + call calculate_TFreeze_linear(S_scale*S, p_scale*pressure, T_fr, EOS%TFr_S0_P0, & EOS%dTFr_dS, EOS%dTFr_dp) case (TFREEZE_MILLERO) - call calculate_TFreeze_Millero(S, p_scale*pressure, T_fr) + call calculate_TFreeze_Millero(S_scale*S, p_scale*pressure, T_fr) case (TFREEZE_TEOS10) - call calculate_TFreeze_teos10(S, p_scale*pressure, T_fr) + call calculate_TFreeze_teos10(S_scale*S, p_scale*pressure, T_fr) case default call MOM_error(FATAL, "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") end select + if (present(scale_from_EOS)) then ; if (scale_from_EOS) then + T_fr = EOS%degC_to_C * T_fr + endif ; endif + end subroutine calculate_TFreeze_scalar !> Calls the appropriate subroutine to calculate the freezing point for a 1-D array. @@ -760,7 +775,7 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! in combination with scaling given by US [various] + !! in combination with scaling stored in EOS [various] ! Local variables integer :: j @@ -802,7 +817,7 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! in combination with scaling given by US [various] + !! in combination with scaling stored in EOS [various] ! Local variables real, dimension(size(drho_dT)) :: pres ! Pressure converted to [Pa] real, dimension(size(drho_dT)) :: Ta ! Temperature converted to [degC] @@ -855,7 +870,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS !! determined by the optional scale argument type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! in combination with scaling given by US [various] + !! in combination with scaling stored in EOS [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: dRdT_scale ! A factor to convert drho_dT to the desired units [R degC m3 C-1 kg-1 ~> 1] @@ -911,7 +926,7 @@ subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_d integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! in combination with scaling given by US [various] + !! in combination with scaling stored in EOS [various] ! Local variables real, dimension(size(T)) :: pres ! Pressure converted to [Pa] real, dimension(size(T)) :: Ta ! Temperature converted to [degC] @@ -1007,7 +1022,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr !! [T2 C-1 L-2 ~> kg m-3 degC-1 Pa-1] type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! in combination with scaling given by US [various] + !! in combination with scaling stored in EOS [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] @@ -1123,7 +1138,7 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific - !! volume in combination with scaling given by US [various] + !! volume in combination with scaling stored in EOS [various] ! Local variables real, dimension(size(T)) :: pres ! Pressure converted to [Pa] @@ -1433,7 +1448,8 @@ logical function query_compressible(EOS) query_compressible = EOS%compressible end function query_compressible -!> Initializes EOS_type by allocating and reading parameters +!> Initializes EOS_type by allocating and reading parameters. The scaling factors in +!! US are stored in EOS for later use. subroutine EOS_init(param_file, EOS, US) type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), intent(inout) :: EOS !< Equation of state structure @@ -1630,6 +1646,95 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) enddo ; enddo ; enddo end subroutine convert_temp_salt_for_TEOS10 + +!> Converts an array of conservative temperatures to potential temperatures. The input arguments +!! use the dimesionally rescaling as specified within the EOS type. The output potential +!! temperature uses this same scaling, but this can be replaced by the factor given by scale. +subroutine cons_temp_to_pot_temp(T, S, poTemp, EOS, dom, scale) + real, dimension(:), intent(in) :: T !< Conservative temperature [C ~> degC] + real, dimension(:), intent(in) :: S !< Absolute salinity [S ~> ppt] + real, dimension(:), intent(inout) :: poTemp !< The potential temperature with a reference pressure + !! of 0 Pa, [C ~> degC] + type(EOS_type), intent(in) :: EOS !< Equation of state structure + integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking + !! into account that arrays start at 1. + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale the output + !! potential temperature in place of with scaling stored + !! in EOS. A value of 1.0 returns temperatures in [degC], + !! while the default is equivalent to EOS%degC_to_C. + + ! Local variables + real, dimension(size(T)) :: Ta ! Temperature converted to [degC] + real, dimension(size(S)) :: Sa ! Salinity converted to [ppt] + real :: T_scale ! A factor to convert potential temperature from degC to the desired units [C degC-1 ~> 1] + integer :: i, is, ie + + if (present(dom)) then + is = dom(1) ; ie = dom(2) + else + is = 1 ; ie = size(T) + endif + + if ((EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then + poTemp(is:ie) = gsw_pt_from_ct(S(is:ie), T(is:ie)) + else + do i=is,ie + Ta(i) = EOS%C_to_degC * T(i) + Sa(i) = EOS%S_to_ppt * S(i) + enddo + poTemp(is:ie) = gsw_pt_from_ct(Sa(is:ie), Ta(is:ie)) + endif + + T_scale = EOS%degC_to_C + if (present(scale)) T_scale = scale + if (T_scale /= 1.0) then ; do i=is,ie + poTemp(i) = T_scale * poTemp(i) + enddo ; endif + +end subroutine cons_temp_to_pot_temp + + +!> Converts an array of absolute salinity to practical salinity. The input arguments +!! use the dimesionally rescaling as specified within the EOS type. The output potential +!! temperature uses this same scaling, but this can be replaced by the factor given by scale. +subroutine abs_saln_to_prac_saln(S, prSaln, EOS, dom, scale) + real, dimension(:), intent(in) :: S !< Absolute salinity [S ~> ppt] + real, dimension(:), intent(inout) :: prSaln !< Practical salinity [S ~> ppt] + type(EOS_type), intent(in) :: EOS !< Equation of state structure + integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking + !! into account that arrays start at 1. + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale the output + !! practical in place of with scaling stored + !! in EOS. A value of 1.0 returns salinities in [PSU], + !! 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 salnity from ppt to the desired units [S ppt-1 ~> 1] + integer :: i, is, ie + + if (present(dom)) then + is = dom(1) ; ie = dom(2) + else + is = 1 ; ie = size(S) + endif + + if ((EOS%C_to_degC == 1.0) .and. (EOS%S_to_ppt == 1.0)) then + prSaln(is:ie) = gsw_sp_from_sr(Sa(is:ie)) + else + do i=is,ie ; Sa(i) = EOS%S_to_ppt * S(i) ; enddo + prSaln(is:ie) = gsw_sp_from_sr(Sa(is:ie)) + endif + + S_scale = EOS%ppt_to_S + if (present(scale)) S_scale = scale + if (S_scale /= 1.0) then ; do i=is,ie + prSaln(i) = S_scale * prSaln(i) + enddo ; endif + +end subroutine abs_saln_to_prac_saln + + !> Return value of EOS_quadrature logical function EOS_quadrature(EOS) type(EOS_type), intent(in) :: EOS !< Equation of state structure From 1c6696427916b480144b7096e69a6f0316107ab7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 18 May 2022 11:18:10 -0400 Subject: [PATCH 20/68] Rescaled dumbbell_initialize_thickness salinities Rescaled the units of some salinities in dumbbell_initialize_thickness and added comments or corrected the unit descriptions in comments describing several variables. All answers are bitwise identical. --- src/core/MOM_PressureForce_FV.F90 | 4 +-- .../lateral/MOM_thickness_diffuse.F90 | 4 +-- src/user/dumbbell_initialization.F90 | 35 +++++++++++++------ 3 files changed, 28 insertions(+), 15 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index ffd2c61d97..e66732c50d 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -522,11 +522,11 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm ! This block calculates a simple |delta T| along coordinates and does ! not allow vanishing layer thicknesses or layers tracking topography - !! SGS variance in i-direction [degC2] + !! SGS variance in i-direction [C2 ~> degC2] !dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( tv%T(i+1,j,k) - tv%T(i,j,k) ) & ! + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( tv%T(i,j,k) - tv%T(i-1,j,k) ) & ! ) * G%dxT(i,j) * 0.5 )**2 - !! SGS variance in j-direction [degC2] + !! SGS variance in j-direction [C2 ~> degC2] !dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( tv%T(i,j+1,k) - tv%T(i,j,k) ) & ! + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( tv%T(i,j,k) - tv%T(i,j-1,k) ) & ! ) * G%dyT(i,j) * 0.5 )**2 diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index f979008f1d..4ab0c0cf3d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -761,11 +761,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (use_Stanley) then !$OMP do do k=1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - !! SGS variance in i-direction [degC2] + !! SGS variance in i-direction [C2 ~> degC2] !dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) & ! + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) & ! ) * G%dxT(i,j) * 0.5 )**2 - !! SGS variance in j-direction [degC2] + !! SGS variance in j-direction [C2 ~> degC2] !dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) & ! + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) & ! ) * G%dyT(i,j) * 0.5 )**2 diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index e83d1b78a1..c197274067 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -107,7 +107,10 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. - real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities [ppt]. + real :: S_ref ! A default value for salinities [ppt]. + real :: S_surf ! The surface salinity [S ~> ppt] + real :: S_range ! The range of salinities in this test case [S ~> ppt] + real :: S_light, S_dense ! The lightest and densest salinities in the sponges [S ~> ppt]. real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -140,11 +143,15 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) ! Initial thicknesses for isopycnal coordinates - call get_param(param_file, mdl, "INITIAL_SSS", S_surf, default=34., do_not_log=.true.) - call get_param(param_file, mdl, "INITIAL_S_RANGE", S_range, default=2., do_not_log=.true.) + call get_param(param_file, mdl, "INITIAL_SSS", S_surf, & + units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "INITIAL_S_RANGE", S_range, & + units='1e-3', default=2., scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) - call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) - call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & + units='1e-3', default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & + units='1e-3', default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "INTERFACE_IC_QUANTA", eta_IC_quanta, & "The granularity of initial interface height values "//& "per meter, to avoid sensivity to order-of-arithmetic changes.", & @@ -218,9 +225,12 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ ! Local variables integer :: i, j, k, is, ie, js, je, nz - real :: S_surf, T_surf, S_range - real :: x, dblen - logical :: dbrotate ! If true, rotate the domain. + real :: S_surf ! The surface salinity [S ~> ppt] + real :: S_range ! The range of salinities in this test case [S ~> ppt] + real :: T_surf ! The surface temperature [C ~> degC] + real :: x ! The fractional position in the domain [nondim] + real :: dblen ! The size of the dumbbell test case [axis_units] + logical :: dbrotate ! If true, rotate the domain. character(len=20) :: verticalCoordinate, density_profile is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -293,12 +303,15 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use real :: sponge_time_scale ! The damping time scale [T ~> s] real, dimension(SZI_(G),SZJ_(G)) :: Idamp ! inverse damping timescale [T-1 ~> s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h, S ! sponge thicknesses, temp and salt + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h ! sponge thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S ! sponge salinities [S ~> ppt] real, dimension(SZK_(GV)+1) :: eta1D ! interface positions for ALE sponge integer :: i, j, k, nz - real :: x, min_thickness, dblen - real :: S_ref, S_range ! Salinities [S ~> ppt] + real :: x ! The fractional position in the domain [nondim] + real :: dblen ! The size of the dumbbell test case [axis_units] + real :: min_thickness ! The minimum layer thickness [Z ~> m] + real :: S_ref, S_range ! A reference salinity and the range of salinities in this test case [S ~> ppt] logical :: dbrotate ! If true, rotate the domain. call get_param(param_file, mdl,"DUMBBELL_LEN",dblen, & From cf448a1ecfec90f2b6436062f6d662b23fb47af3 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 6 Dec 2021 15:50:08 -0500 Subject: [PATCH 21/68] MOM_file_parser unit test implementation This patch introduces new features to support unit testing of the MOM6 source code. The patch includes two new modules (MOM_unit_testing, MOM_file_parser_tests), two new classes (UnitTest, TestSuite), and a new driver (unit_testing). A UnitTest object consists of the following: * The test subroutine * Test name (for reporting) * A flag indicating whether the test should fail (FATAL) * An optional cleanup subroutine The UnitTest objects are gathered into a TestSuite object, which provides a batch job for running all of its tests. The use of these features is demonstrated in a driver, unit_tests, which runs the tests provided in the MOM_file_parser_tests module This patch also includes changes to the ".testing" build system. * The optional FCFLAGS_COVERAGE has been removed from the testing Makefile. Instead, a new "cov" target is optionally built if one wants to check the coverage. It is currently based on "symmetric". * A new "unit" target has been added to run the unit testing driver and report its code coverage. * GitHub Actions has been modified to include the unit driver test. * The gcov output now includes branching (-b), which allows reporting of partial line coverage in some cases. * codecov.io "smart" report searching has been replaced with an explicit setting of the root directory (-R) and *.gcda paths. Other minor changes: * MOM_coms include an infra-level sync function (sync_PEs) as a wrapper to mpp_sync (or others in the future). --- .codecov.yml | 5 +- .github/actions/testing-setup/action.yml | 1 - .github/workflows/coverage.yml | 11 +- .testing/Makefile | 105 +- ac/configure.ac | 6 +- .../unit_tests/MOM_unit_test_driver.F90 | 65 + config_src/infra/FMS1/MOM_coms_infra.F90 | 9 +- config_src/infra/FMS2/MOM_coms_infra.F90 | 9 +- src/framework/MOM_coms.F90 | 2 + src/framework/MOM_unit_testing.F90 | 306 +++ .../testing/MOM_file_parser_tests.F90 | 1924 +++++++++++++++++ 11 files changed, 2411 insertions(+), 32 deletions(-) create mode 100644 config_src/drivers/unit_tests/MOM_unit_test_driver.F90 create mode 100644 src/framework/MOM_unit_testing.F90 create mode 100644 src/framework/testing/MOM_file_parser_tests.F90 diff --git a/.codecov.yml b/.codecov.yml index 84e438145e..aa85b2b3ac 100644 --- a/.codecov.yml +++ b/.codecov.yml @@ -9,5 +9,6 @@ coverage: threshold: 100% base: parent comment: - # This must be set to the number of test cases (TCs) - after_n_builds: 8 + # This is set to the number of TCs, plus unit, but can be removed + # (i.e. set to 1) when reporting is separated from coverage. + after_n_builds: 9 diff --git a/.github/actions/testing-setup/action.yml b/.github/actions/testing-setup/action.yml index 1ab96aa3df..e95145c1a1 100644 --- a/.github/actions/testing-setup/action.yml +++ b/.github/actions/testing-setup/action.yml @@ -52,7 +52,6 @@ runs: echo "FCFLAGS_DEBUG=-g -O0 -Wextra -Wno-compare-reals -fbacktrace -ffpe-trap=invalid,zero,overflow -fcheck=bounds" >> config.mk echo "FCFLAGS_REPRO=-g -O2 -fbacktrace" >> config.mk echo "FCFLAGS_INIT=-finit-real=snan -finit-integer=2147483647 -finit-derived" >> config.mk - echo "FCFLAGS_COVERAGE=--coverage" >> config.mk cat config.mk echo "::endgroup::" diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index 60b85e412b..84fc4c75ff 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -20,5 +20,14 @@ jobs: - uses: ./.github/actions/testing-setup + - name: Compile unit testing + run: make -j build/unit/MOM6 + + - name: Run unit tests + run: make unit.cov.upload + + - name: Compile MOM6 with code coverage + run: make -j build/cov/MOM6 + - name: Run and post coverage - run: make run.symmetric -k -s + run: make run.cov -k -s diff --git a/.testing/Makefile b/.testing/Makefile index 4096436f30..d9feb25f0b 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -28,7 +28,7 @@ # MPIRUN MPI job launcher (mpirun, srun, etc) # DO_REPRO_TESTS Enable production ("repro") testing equivalence # DO_REGRESSION_TESTS Enable regression tests (usually dev/gfdl) -# REPORT_COVERAGE Enable code coverage and report to codecov +# REPORT_COVERAGE Enable code coverage and generate reports # # Compiler configuration: # CC C compiler @@ -82,11 +82,11 @@ export MPIFC FCFLAGS_DEBUG ?= -g -O0 FCFLAGS_REPRO ?= -g -O2 FCFLAGS_OPT ?= -g -O3 -mavx -fno-omit-frame-pointer +FCFLAGS_COVERAGE ?= -g -O0 -fbacktrace --coverage FCFLAGS_INIT ?= -FCFLAGS_COVERAGE ?= # Additional notes: # - These default values are simple, minimalist flags, supported by nearly all -# compilers which are comparable to GFDL's canonical DEBUG and REPRO builds. +# compilers, and are comparable to GFDL's canonical DEBUG and REPRO builds. # # - These flags should be configured outside of the Makefile, either with # config.mk or as environment variables. @@ -95,6 +95,7 @@ FCFLAGS_COVERAGE ?= # so FCFLAGS_INIT is used to provide additional MOM6 configuration. # User-defined LDFLAGS (applied to all builds and FMS) +LDFLAGS_COVERAGE ?= --coverage LDFLAGS_USER ?= # Set to `true` to require identical results from DEBUG and REPRO builds @@ -139,6 +140,9 @@ ifeq ($(DO_PROFILE), false) BUILDS += opt opt_target endif +# Unit test testing +BUILDS += cov unit + # The following variables are configured by Travis: # DO_REGRESSION_TESTS: true if $(TRAVIS_PULL_REQUEST) is a PR number # MOM_TARGET_SLUG: TRAVIS_REPO_SLUG @@ -165,8 +169,6 @@ else TARGET_CODEBASE = endif - - # 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 # (1): Root directory @@ -220,10 +222,8 @@ build.prof: $(foreach b,opt opt_target,build/$(b)/MOM6) BUILD_TARGETS = MOM6 Makefile path_names .PRECIOUS: $(foreach b,$(BUILDS),$(foreach f,$(BUILD_TARGETS),build/$(b)/$(f))) -# Compiler flags -# Conditionally build symmetric with coverage support -COVERAGE=$(if $(REPORT_COVERAGE),$(FCFLAGS_COVERAGE),) +# Compiler flags # .testing dependencies # TODO: We should probably build TARGET with the FMS that it was configured @@ -234,28 +234,31 @@ PATH_FMS = PATH="${PATH}:../../$(DEPS)/bin" # Define the build targets in terms of the traditional DEBUG/REPRO/etc labels -SYMMETRIC_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(COVERAGE) $(FCFLAGS_FMS)" +SYMMETRIC_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" ASYMMETRIC_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" REPRO_FCFLAGS := FCFLAGS="$(FCFLAGS_REPRO) $(FCFLAGS_FMS)" OPT_FCFLAGS := FCFLAGS="$(FCFLAGS_OPT) $(FCFLAGS_FMS)" OPENMP_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" TARGET_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" +COV_FCFLAGS := FCFLAGS="$(FCFLAGS_COVERAGE) $(FCFLAGS_FMS)" MOM_LDFLAGS := LDFLAGS="$(LDFLAGS_FMS) $(LDFLAGS_USER)" -SYMMETRIC_LDFLAGS := LDFLAGS="$(COVERAGE) $(LDFLAGS_FMS) $(LDFLAGS_USER)" +COV_LDFLAGS := LDFLAGS="$(LDFLAGS_COVERAGE) $(LDFLAGS_FMS) $(LDFLAGS_USER)" # Environment variable configuration -build/symmetric/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) +build/symmetric/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) build/asymmetric/Makefile: MOM_ENV=$(PATH_FMS) $(ASYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) build/repro/Makefile: MOM_ENV=$(PATH_FMS) $(REPRO_FCFLAGS) $(MOM_LDFLAGS) build/openmp/Makefile: MOM_ENV=$(PATH_FMS) $(OPENMP_FCFLAGS) $(MOM_LDFLAGS) build/target/Makefile: MOM_ENV=$(PATH_FMS) $(TARGET_FCFLAGS) $(MOM_LDFLAGS) build/opt/Makefile: MOM_ENV=$(PATH_FMS) $(OPT_FCFLAGS) $(MOM_LDFLAGS) build/opt_target/Makefile: MOM_ENV=$(PATH_FMS) $(OPT_FCFLAGS) $(MOM_LDFLAGS) -build/coupled/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) -build/nuopc/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) -build/mct/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) +build/coupled/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) +build/nuopc/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) +build/mct/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) +build/cov/Makefile: MOM_ENV=$(PATH_FMS) $(COV_FCFLAGS) $(COV_LDFLAGS) +build/unit/Makefile: MOM_ENV=$(PATH_FMS) $(COV_FCFLAGS) $(COV_LDFLAGS) # Configure script flags build/symmetric/Makefile: MOM_ACFLAGS= @@ -268,6 +271,8 @@ build/opt_target/Makefile: MOM_ACFLAGS= build/coupled/Makefile: MOM_ACFLAGS=--with-driver=FMS_cap build/nuopc/Makefile: MOM_ACFLAGS=--with-driver=nuopc_cap build/mct/Makefile: MOM_ACFLAGS=--with-driver=mct_cap +build/cov/Makefile: MOM_ACFLAGS= +build/unit/Makefile: MOM_ACFLAGS=--with-driver=unit_tests # Fetch regression target source code build/target/Makefile: | $(TARGET_CODEBASE) @@ -276,7 +281,7 @@ build/opt_target/Makefile: | $(TARGET_CODEBASE) # Define source code dependencies # NOTE: ./configure is too much, but Makefile is not enough! -# Ideally we would want to re-run both Makefile and mkmf, but our mkmf call +# Ideally we only want to re-run both Makefile and mkmf, but the mkmf call # is inside ./configure, so we must re-run ./configure as well. $(foreach b,$(filter-out target,$(BUILDS)),build/$(b)/Makefile): $(MOM_SOURCE) build/target_codebase/configure: $(TARGET_SOURCE) @@ -362,11 +367,13 @@ $(DEPS)/Makefile: ../ac/deps/Makefile #--- -# The following block does a non-library build of a coupled driver interface to MOM, along with everything below it. -# This simply checks that we have not broken the ability to compile. This is not a means to build a complete coupled executable. -# Todo: -# - avoid re-building FMS and MOM6 src by re-using existing object/mod files -# - use autoconf rather than mkmf templates +# The following block does a non-library build of a coupled driver interface to +# MOM, along with everything below it. This simply checks that we have not +# broken the ability to compile. This is not a means to build a complete +# coupled executable. +# TODO: +# - Avoid re-building FMS and MOM6 src by re-using existing object/mod files +# - Use autoconf rather than mkmf templates MK_TEMPLATE ?= ../../$(DEPS)/mkmf/templates/ncrc-gnu.mk # NUOPC driver build/nuopc/mom_ocean_model_nuopc.o: build/nuopc/Makefile @@ -425,11 +432,12 @@ test.dim.$(1): $(foreach c,$(CONFIGS),$(c).dim.$(1) $(c).dim.$(1).diag) endef $(foreach d,$(DIMS),$(eval $(call TEST_DIM_RULE,$(d)))) -.PHONY: run.symmetric run.asymmetric run.nans run.openmp +.PHONY: run.symmetric run.asymmetric run.nans run.openmp run.cov run.symmetric: $(foreach c,$(CONFIGS),work/$(c)/symmetric/ocean.stats) run.asymmetric: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(CONFIGS),work/$(c)/asymmetric/ocean.stats) run.nan: $(foreach c,$(CONFIGS),work/$(c)/nan/ocean.stats) run.openmp: $(foreach c,$(CONFIGS),work/$(c)/openmp/ocean.stats) +run.cov: $(foreach c,$(CONFIGS),work/$(c)/cov/ocean.stats) # Configuration test rules # $(1): Configuration name (tc1, tc2, &c.) @@ -573,11 +581,11 @@ work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 $(VENV_PATH) @echo -e "$(DONE): $$*.$(1); no runtime errors." if [ $(3) ]; then \ mkdir -p results/$$* ; \ - cd build/symmetric ; \ - gcov *.gcda > gcov.$$*.$(1).out ; \ + cd build/$(2) ; \ + gcov -b *.gcda > gcov.$$*.$(1).out ; \ curl -s $(CODECOV_UPLOADER_URL) -o codecov ; \ chmod +x codecov ; \ - ./codecov -Z -f "*.gcov" -n $$@ \ + ./codecov -R . -Z -f "*.gcov" -n $$@ \ > codecov.$$*.$(1).out \ 2> codecov.$$*.$(1).err \ && echo -e "${MAGENTA}Report uploaded to codecov.${RESET}"; \ @@ -603,6 +611,7 @@ $(eval $(call STAT_RULE,dim.z,symmetric,,Z_RESCALE_POWER=11,,1)) $(eval $(call STAT_RULE,dim.q,symmetric,,Q_RESCALE_POWER=11,,1)) $(eval $(call STAT_RULE,dim.r,symmetric,,R_RESCALE_POWER=11,,1)) +$(eval $(call STAT_RULE,cov,cov,$(REPORT_COVERAGE),,,1)) # Generate the half-period input namelist as follows: # 1. Fetch DAYMAX and TIMEUNIT from MOM_input @@ -652,7 +661,6 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 $(VENV_PATH) # TODO: Restart checksum diagnostics - #--- # Not a true rule; only call this after `make test` to summarize test results. .PHONY: test.summary @@ -679,6 +687,53 @@ test.summary: fi +#--- +# unit test + +.PHONY: unit.cov +unit.cov: build/unit/MOM_new_unit_tests.gcov + +work/unit/std.out: build/unit/MOM6 + if [ $(REPORT_COVERAGE) ]; then \ + find build/unit -name *.gcda -exec rm -f '{}' \; ; \ + fi + rm -rf $(@D) + mkdir -p $(@D) + cd $(@D) \ + && $(TIME) $(MPIRUN) -n 1 ../../$< 2> std.err > std.out \ + || !( \ + cat std.out | tail -n 100 ; \ + cat std.err | tail -n 100 ; \ + ) + cd $(@D) \ + && $(TIME) $(MPIRUN) -n 2 ../../$< 2> p2.std.err > p2.std.out \ + || !( \ + cat p2.std.out | tail -n 100 ; \ + cat p2.std.err | tail -n 100 ; \ + ) + +build/unit/codecov: + mkdir -p $(@D) + cd $(@D) \ + && curl -s $(CODECOV_UPLOADER_URL) -o $(@F) + chmod +x $@ + +# Use driver coverage file as a proxy for the run +# TODO: Replace work/unit/std.out with *.gcda? +build/unit/MOM_new_unit_tests.gcov: work/unit/std.out + mkdir -p $(@D) + cd $(@D) \ + && gcov -b *.gcda > gcov.unit.out + +# Use driver coverage file as a proxy for the run +.PHONY: unit.cov.upload +unit.cov.upload: build/unit/MOM_new_unit_tests.gcov build/unit/codecov + cd build/unit \ + && ./codecov -R . -Z -f "*.gcov" -n "Unit tests" \ + > codecov.unit.out \ + 2> codecov.unit.err \ + && echo -e "${MAGENTA}Report uploaded to codecov.${RESET}" + #--- # Profiling # XXX: This is experimental work to track, log, and report changes in runtime diff --git a/ac/configure.ac b/ac/configure.ac index 3d1af81b05..00c8917734 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -51,7 +51,11 @@ AS_IF([test "$enable_asymmetric" = yes], # Default to solo_driver DRIVER_DIR=${srcdir}/config_src/drivers/solo_driver AC_ARG_WITH([driver], - AS_HELP_STRING([--with-driver=coupled_driver|solo_driver], [Select directory for driver source code])) + AS_HELP_STRING( + [--with-driver=coupled_driver|solo_driver|unit_tests], + [Select directory for driver source code] + ) +) AS_IF([test "x$with_driver" != "x"], [DRIVER_DIR=${srcdir}/config_src/drivers/${with_driver}]) diff --git a/config_src/drivers/unit_tests/MOM_unit_test_driver.F90 b/config_src/drivers/unit_tests/MOM_unit_test_driver.F90 new file mode 100644 index 0000000000..eafa8fa722 --- /dev/null +++ b/config_src/drivers/unit_tests/MOM_unit_test_driver.F90 @@ -0,0 +1,65 @@ +program MOM_unit_tests + +use MPI +use MOM_domains, only : MOM_infra_init +use MOM_domains, only : MOM_infra_end +use MOM_file_parser_tests, only : run_file_parser_tests + +implicit none + +integer, parameter :: comm = MPI_COMM_WORLD +integer, parameter :: root = 0 +integer :: rank +logical :: file_exists_on_rank +logical :: input_nml_exists, MOM_input_exists +integer :: io_unit +logical :: is_open, is_file +integer :: rc + +! NOTE: Bootstrapping requires external MPI configuration. +! - FMS initialization requires the presence of input.nml +! - MOM initialization requires MOM_input (if unspecificed by input.nml) +! - Any MPI-based I/O prior to MOM and FMS init will MPI initialization +! Thus, we need to do some minimal MPI setup. +call MPI_Init(rc) +call MPI_Comm_rank(comm, rank, rc) + +inquire(file='input.nml', exist=file_exists_on_rank) +call MPI_Reduce(file_exists_on_rank, input_nml_exists, 1, MPI_LOGICAL, & + MPI_LOR, root, comm, rc) + +inquire(file='MOM_input', exist=file_exists_on_rank) +call MPI_Reduce(file_exists_on_rank, MOM_input_exists, 1, MPI_LOGICAL, & + MPI_LOR, root, comm, rc) + +if (rank == root) then + ! Abort if at least one rank sees either input.nml or MOM_input + if (input_nml_exists) error stop "Remove existing 'input.nml' file." + if (MOM_input_exists) error stop "Remove existing 'MOM_input' file." + + ! Otherwise, create the (empty) files + open(newunit=io_unit, file='input.nml', status='replace') + write(io_unit, '(a)') "&fms2_io_nml /" + close(io_unit) + + open(newunit=io_unit, file='MOM_input', status='replace') + close(io_unit) +endif + +call MOM_infra_init(comm) + +! Run tests +call run_file_parser_tests + +! Cleanup +call MOM_infra_end + +if (rank == root) then + open(newunit=io_unit, file='MOM_input') + close(io_unit, status='delete') + + open(newunit=io_unit, file='input.nml') + close(io_unit, status='delete') +endif + +end program MOM_unit_tests diff --git a/config_src/infra/FMS1/MOM_coms_infra.F90 b/config_src/infra/FMS1/MOM_coms_infra.F90 index 561cf6c333..939161875e 100644 --- a/config_src/infra/FMS1/MOM_coms_infra.F90 +++ b/config_src/infra/FMS1/MOM_coms_infra.F90 @@ -14,7 +14,7 @@ module MOM_coms_infra implicit none ; private -public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist +public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist, sync_PEs public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs public :: any_across_PEs, all_across_PEs public :: field_chksum, MOM_infra_init, MOM_infra_end @@ -108,6 +108,13 @@ subroutine Get_PEList(pelist, name, commID) call mpp_get_current_pelist(pelist, name, commiD) end subroutine Get_PEList +!> Sync the PEs at a defined point in the model +subroutine sync_PEs(pelist) + integer, optional, intent(in) :: pelist(:) !< The list of PEs to be synced + + call mpp_sync(pelist) +end subroutine sync_PEs + !> Communicate a 1-D array of character strings from one PE to others subroutine broadcast_char(dat, length, from_PE, PElist, blocking) character(len=*), intent(inout) :: dat(:) !< The data to communicate and destination diff --git a/config_src/infra/FMS2/MOM_coms_infra.F90 b/config_src/infra/FMS2/MOM_coms_infra.F90 index 561cf6c333..939161875e 100644 --- a/config_src/infra/FMS2/MOM_coms_infra.F90 +++ b/config_src/infra/FMS2/MOM_coms_infra.F90 @@ -14,7 +14,7 @@ module MOM_coms_infra implicit none ; private -public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist +public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist, sync_PEs public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs public :: any_across_PEs, all_across_PEs public :: field_chksum, MOM_infra_init, MOM_infra_end @@ -108,6 +108,13 @@ subroutine Get_PEList(pelist, name, commID) call mpp_get_current_pelist(pelist, name, commiD) end subroutine Get_PEList +!> Sync the PEs at a defined point in the model +subroutine sync_PEs(pelist) + integer, optional, intent(in) :: pelist(:) !< The list of PEs to be synced + + call mpp_sync(pelist) +end subroutine sync_PEs + !> Communicate a 1-D array of character strings from one PE to others subroutine broadcast_char(dat, length, from_PE, PElist, blocking) character(len=*), intent(inout) :: dat(:) !< The data to communicate and destination diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index 8bf1164a70..38ad55fd96 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -9,10 +9,12 @@ module MOM_coms use MOM_coms_infra, only : sum_across_PEs, max_across_PEs, min_across_PEs use MOM_coms_infra, only : all_across_PEs, any_across_PEs use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_coms_infra, only : sync_PEs implicit none ; private public :: PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end +public :: sync_PEs public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs, field_chksum public :: all_across_PEs, any_across_PEs public :: set_PElist, Get_PElist, Set_rootPE diff --git a/src/framework/MOM_unit_testing.F90 b/src/framework/MOM_unit_testing.F90 new file mode 100644 index 0000000000..312914933c --- /dev/null +++ b/src/framework/MOM_unit_testing.F90 @@ -0,0 +1,306 @@ +module MOM_unit_testing + +use posix, only : chmod +use posix, only : sigsetjmp +use posix, only : sigjmp_buf + +use MOM_coms, only : num_PEs, sync_PEs +use MOM_error_handler, only : is_root_pe +use MOM_error_handler, only : disable_fatal_errors +use MOM_error_handler, only : enable_fatal_errors + +implicit none ; private + +public :: string +public :: create_test_file +public :: delete_test_file +public :: TestSuite + + +!> String container type +type :: string + character(len=:), allocatable :: s + !< Internal character array of string +end type string + + +!> String constructor +interface string + module procedure init_string_char + module procedure init_string_int +end interface string + + +!> A generalized instance of a unit test function +type :: UnitTest + private + procedure(), nopass, pointer :: proc => null() + !< Unit test function/subroutine + procedure(), nopass, pointer :: cleanup => null() + !< Cleanup function to be run after proc + character(len=:), allocatable :: name + !< Unit test name (usually set to name of proc) + logical :: is_fatal + !< True if proc() is expected to fail +contains + procedure :: run => run_unit_test + !< Run the unit test function, proc +end type UnitTest + + +!> Unit test constructor +interface UnitTest + module procedure create_unit_test_basic + module procedure create_unit_test_full +end interface UnitTest + + +!> Collection of unit tests +type :: TestSuite + private + type(UnitTestNode), pointer :: head => null() + !< Head of the unit test linked list + type(UnitTestNode), pointer :: tail => null() + !< Tail of the unit test linked list (pre-allocated and unconfigured) + + ! Public API + procedure(), nopass, pointer, public :: cleanup => null() + !< Default cleanup function for unit tests in suite +contains + private + procedure :: add_basic => add_unit_test_basic + !< Add a unit test without a cleanup function + procedure :: add_full => add_unit_test_full + !< Add a unit test with an explicit cleanup function + generic, public :: add => add_basic, add_full + !< Add a unit test to the test suite + procedure, public :: run => run_test_suite + !< Run all unit tests in the suite +end type TestSuite + + +!> TestSuite constructor +interface TestSuite + module procedure create_test_suite +end interface TestSuite + + +!> UnitTest node of TestSuite's linked list +type :: UnitTestNode + private + type(UnitTest), pointer :: test => null() + !< Node contents + type(UnitTestNode), pointer :: next => null() + !< Pointer to next node in list +end type UnitTestNode + +contains + +!> Return a new unit test without a cleanup function +function create_unit_test_basic(proc, name, fatal) result(test) + procedure() :: proc + !< Subroutine which defines the unit test + character(len=*), intent(in) :: name + !< Name of the unit test + logical, intent(in), optional :: fatal + !< True if the test is expected to raise a FATAL error + type(UnitTest) :: test + + procedure(), pointer :: cleanup + cleanup => null() + + test = create_unit_test_full(proc, name, fatal, cleanup) +end function create_unit_test_basic + + +!> Return a new unit test with an explicit cleanup function +function create_unit_test_full(proc, name, fatal, cleanup) result(test) + procedure() :: proc + !< Subroutine which defines the unit test + character(len=*), intent(in) :: name + !< Name of the unit test + logical, optional :: fatal + !< True if the test is expected to raise a FATAL error + procedure() :: cleanup + !< Cleanup subroutine, called after test + type(UnitTest) :: test + + test%proc => proc + test%name = name + test%is_fatal = .false. + if (present(fatal)) test%is_fatal = fatal + test%cleanup => cleanup +end function create_unit_test_full + + +!> Launch a unit test with a custom cleanup procedure +subroutine run_unit_test(test) + class(UnitTest), intent(in) :: test + + type(sigjmp_buf) :: env + integer :: rc + + call sync_PEs + + ! FIXME: Some FATAL tests under MPI are unable to recover after jumpback, so + ! we disable these tests for now. + if (test%is_fatal .and. num_PEs() > 1) return + + if (test%is_fatal) then + rc = sigsetjmp(env, 1) + if (rc == 0) then + call disable_fatal_errors(env) + call test%proc + endif + call enable_fatal_errors + else + call test%proc + endif + + if (associated(test%cleanup)) call test%cleanup +end subroutine run_unit_test + + +!> Return a new test suite +function create_test_suite() result(suite) + type(TestSuite) :: suite + + ! Setup the head node, but do not populate it + allocate(suite%head) + suite%tail => suite%head +end function create_test_suite + + +subroutine add_unit_test_basic(suite, test, name, fatal) + class(TestSuite), intent(inout) :: suite + procedure() :: test + character(len=*), intent(in) :: name + logical, intent(in), optional :: fatal + + procedure(), pointer :: cleanup + + cleanup => null() + if (associated(suite%cleanup)) cleanup => suite%cleanup + + call add_unit_test_full(suite, test, name, fatal, cleanup) +end subroutine add_unit_test_basic + + +subroutine add_unit_test_full(suite, test, name, fatal, cleanup) + class(TestSuite), intent(inout) :: suite + procedure() :: test + character(len=*), intent(in) :: name + procedure() :: cleanup + logical, intent(in), optional :: fatal + + type(UnitTest), pointer :: utest + type(UnitTestNode), pointer :: node + + ! Populate the current tail + allocate(utest) + utest = UnitTest(test, name, fatal, cleanup) + suite%tail%test => utest + + ! Create and append the new (empty) node, and update the tail + allocate(node) + suite%tail%next => node + suite%tail => node +end subroutine add_unit_test_full + + +subroutine run_test_suite(suite) + class(TestSuite), intent(in) :: suite + + type(UnitTestNode), pointer :: node + + node => suite%head + do while(associated(node%test)) + ! TODO: Capture FMS stdout/stderr + print '(/a)', "=== "//node%test%name + + call node%test%run + if (associated(node%test%cleanup)) call node%test%cleanup + + node => node%next + enddo +end subroutine run_test_suite + + +!> Initialize string with a character array. +function init_string_char(c) result(str) + character(len=*), dimension(:), intent(in) :: c + !< List of character arrays + type(string), dimension(size(c)) :: str + !< String output + + integer :: i + + do i = 1, size(c) + str(i)%s = c(i) + enddo +end function init_string_char + + +!> Convert an integer to a string +function init_string_int(n) result(str) + integer, intent(in) :: n + !< Integer input + type(string) :: str + !< String output + + ! TODO: Estimate this with integer arithmetic + character(1 + floor(log10(real(abs(n)))) + (1 - sign(1, n))/2) :: chr + + write(chr, '(i0)') n + str = string(chr) +end function init_string_int + + +!> Create a text file for unit testing +subroutine create_test_file(filename, lines, mode) + character(len=*), intent(in) :: filename + !< Name of file to be created + type(string), intent(in), optional :: lines(:) + !< list of strings to write to file + integer, optional, intent(in) :: mode + !< Permissions of new file + + integer :: param_unit + integer :: i + integer :: rc + logical :: sync + + if (is_root_PE()) then + open(newunit=param_unit, file=filename, status='replace') + if (present(lines)) then + do i = 1, size(lines) + write(param_unit, '(a)') lines(i)%s + enddo + endif + close(param_unit) + if (present(mode)) rc = chmod(filename, mode) + endif + call sync_PEs +end subroutine create_test_file + + +!> Delete a file created during testing +subroutine delete_test_file(filename) + character(len=*), intent(in) :: filename + !< Name of file to be deleted + + logical :: is_file, is_open + integer :: io_unit + + if (is_root_PE()) then + inquire(file=filename, exist=is_file, opened=is_open, number=io_unit) + + if (is_file) then + if (.not. is_open) open(newunit=io_unit, file=filename) + close(io_unit, status='delete') + endif + endif + call sync_PEs +end subroutine delete_test_file + +end module MOM_unit_testing diff --git a/src/framework/testing/MOM_file_parser_tests.F90 b/src/framework/testing/MOM_file_parser_tests.F90 new file mode 100644 index 0000000000..5ad90caf1b --- /dev/null +++ b/src/framework/testing/MOM_file_parser_tests.F90 @@ -0,0 +1,1924 @@ +module MOM_file_parser_tests + +use posix, only : chmod + +use MOM_file_parser, only : param_file_type +use MOM_file_parser, only : open_param_file +use MOM_file_parser, only : close_param_file +use MOM_file_parser, only : read_param +use MOM_file_parser, only : log_param +use MOM_file_parser, only : get_param +use MOM_file_parser, only : log_version +use MOM_file_parser, only : clearParameterBlock +use MOM_file_parser, only : openParameterBlock +use MOM_file_parser, only : closeParameterBlock + +use MOM_time_manager, only : time_type +use MOM_time_manager, only : set_date +use MOM_time_manager, only : set_ticks_per_second +use MOM_time_manager, only : set_calendar_type +use MOM_time_manager, only : NOLEAP, NO_CALENDAR + +use MOM_error_handler, only : assert +use MOM_error_handler, only : MOM_error +use MOM_error_handler, only : FATAL + +use MOM_unit_testing, only : TestSuite +use MOM_unit_testing, only : string +use MOM_unit_testing, only : create_test_file +use MOM_unit_testing, only : delete_test_file + +implicit none ; private + +public :: run_file_parser_tests + +character(len=*), parameter :: param_filename = 'TEST_input' +character(len=*), parameter :: missing_param_filename = 'MISSING_input' +character(len=*), parameter :: netcdf_param_filename = 'TEST_input.nc' + +character(len=*), parameter :: sample_param_name = 'SAMPLE_PARAMETER' +character(len=*), parameter :: missing_param_name = 'MISSING_PARAMETER' + +character(len=*), parameter :: module_name = "SAMPLE_module" +character(len=*), parameter :: module_version = "SAMPLE_version" +character(len=*), parameter :: module_desc = "Description here" + +character(len=9), parameter :: param_docfiles(4) = [ & + "all ", & + "debugging", & + "layout ", & + "short " & +] + +contains + +subroutine test_open_param_file + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call close_param_file(param) +end subroutine test_open_param_file + + +subroutine test_close_param_file_quiet + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call close_param_file(param, quiet_close=.true.) +end subroutine test_close_param_file_quiet + + +subroutine test_open_param_file_component + type(param_file_type) :: param + integer :: i + + call create_test_file(param_filename) + + call open_param_file(param_filename, param, component="TEST") + call close_param_file(param, component="TEST") +end subroutine test_open_param_file_component + + +subroutine cleanup_open_param_file_component + integer :: i + + call delete_test_file(param_filename) + do i = 1, 4 + call delete_test_file("TEST_parameter_doc."//param_docfiles(i)) + enddo +end subroutine cleanup_open_param_file_component + + +subroutine test_open_param_file_docdir + ! TODO: Make a new directory...? + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param, doc_file_dir='./') + call close_param_file(param) +end subroutine test_open_param_file_docdir + + +subroutine test_open_param_file_empty_filename + type(param_file_type) :: param + + call open_param_file('', param) + ! FATAL; return to program +end subroutine test_open_param_file_empty_filename + + +subroutine test_open_param_file_long_name + !> Store filename in a variable longer than FILENAME_LENGTH + type(param_file_type) :: param + character(len=250) :: long_filename + + long_filename = param_filename + + call create_test_file(long_filename) + + call open_param_file(long_filename, param) + call close_param_file(param) +end subroutine test_open_param_file_long_name + + +subroutine test_missing_param_file + type(param_file_type) :: param + logical :: file_exists + + inquire(file=missing_param_filename, exist=file_exists) + if (file_exists) call MOM_error(FATAL, "Missing file already exists!") + + call open_param_file(missing_param_filename, param) + ! FATAL; return to program +end subroutine test_missing_param_file + + +subroutine test_open_param_file_ioerr + type(param_file_type) :: param + ! NOTE: Induce an I/O error in open() by making the file unreadable + + call create_test_file(param_filename, mode=int(o'000')) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_open_param_file_ioerr + + +subroutine cleanup_open_param_file_ioerr + integer :: rc + + rc = chmod(param_filename, int(o'700')) + call cleanup_file_parser() +end subroutine cleanup_open_param_file_ioerr + + +subroutine test_open_param_file_netcdf + type(param_file_type) :: param + + call create_test_file(netcdf_param_filename) + + call open_param_file(netcdf_param_filename, param) + ! FATAL; return to program +end subroutine test_open_param_file_netcdf + + +subroutine cleanup_open_param_file_netcdf + integer :: param_unit + logical :: is_open + + call delete_test_file(netcdf_param_filename) +end subroutine cleanup_open_param_file_netcdf + + +subroutine test_open_param_file_checkable + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param, checkable=.false.) + call close_param_file(param) +end subroutine test_open_param_file_checkable + + +subroutine test_reopen_param_file + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call open_param_file(param_filename, param) + call close_param_file(param) +end subroutine test_reopen_param_file + + +subroutine test_open_param_file_no_doc + type(param_file_type) :: param + type(string) :: lines(1) + + lines(1) = string('DOCUMENT_FILE = ""') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call close_param_file(param) +end subroutine test_open_param_file_no_doc + + +subroutine test_read_param_int + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '123' + integer, parameter :: sample_result = 123 + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_int + + +subroutine test_read_param_int_missing + type(param_file_type) :: param + integer :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_int_missing + + +subroutine test_read_param_int_undefined + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines = string('#undef ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_int_undefined + + +subroutine test_read_param_int_type_err + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = not_an_integer') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_int_type_err + + +subroutine test_read_param_int_array + type(param_file_type) :: param + integer :: sample(3) + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '1, 2, 3' + integer, parameter :: sample_result(3) = [1, 2, 3] + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(all(sample == sample_result), 'Incorrect value') +end subroutine test_read_param_int_array + + +subroutine test_read_param_int_array_missing + type(param_file_type) :: param + integer :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_int_array_missing + + +subroutine test_read_param_int_array_undefined + type(param_file_type) :: param + integer :: sample(3) + type(string) :: lines(1) + + lines = string('#undef ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_int_array_undefined + + +subroutine test_read_param_int_array_type_err + type(param_file_type) :: param + integer :: sample(3) + type(string) :: lines(1) + + lines = string(sample_param_name // ' = not_an_int_array') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_int_array_type_err + + +subroutine test_read_param_real + type(param_file_type) :: param + real :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '3.14' + real, parameter :: sample_result = 3.14 + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_real + + +subroutine test_read_param_real_missing + type(param_file_type) :: param + real :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_real_missing + + +subroutine test_read_param_real_undefined + type(param_file_type) :: param + real :: sample + type(string) :: lines(1) + + lines = string('#undef ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_real_undefined + + +subroutine test_read_param_real_type_err + type(param_file_type) :: param + real :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = not_a_real') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_real_type_err + + +subroutine test_read_param_real_array + type(param_file_type) :: param + real :: sample(3) + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '1., 2., 3.' + real, parameter :: sample_result(3) = [1., 2., 3.] + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(all(sample == sample_result), 'Incorrect value') +end subroutine test_read_param_real_array + + +subroutine test_read_param_real_array_missing + type(param_file_type) :: param + real :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_real_array_missing + + +subroutine test_read_param_real_array_undefined + type(param_file_type) :: param + real :: sample(3) + type(string) :: lines(1) + + lines = string('#undef ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_real_array_undefined + + +subroutine test_read_param_real_array_type_err + type(param_file_type) :: param + real :: sample(3) + type(string) :: lines(1) + + lines = string(sample_param_name // ' = not_a_real_array') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_real_array_type_err + + +subroutine test_read_param_logical + type(param_file_type) :: param + logical :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = 'True' + logical, parameter :: sample_result = .true. + + lines = string(sample_param_name // ' = ' // sample_input) + + !lines = string(sample_param_name // ' = True') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample .eqv. sample_result, 'Incorrect value') +end subroutine test_read_param_logical + + +subroutine test_read_param_logical_missing + type(param_file_type) :: param + logical :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_logical_missing + + +subroutine test_read_param_char_no_delim + type(param_file_type) :: param + character(len=8) :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = "abcdefgh" + character(len=*), parameter :: sample_result = "abcdefgh" + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_char_no_delim + + +subroutine test_read_param_char_quote_delim + type(param_file_type) :: param + character(len=8) :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '"abcdefgh"' + character(len=*), parameter :: sample_result = "abcdefgh" + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_char_quote_delim + + +subroutine test_read_param_char_apostrophe_delim + type(param_file_type) :: param + character(len=8) :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = "'abcdefgh'" + character(len=*), parameter :: sample_result = "abcdefgh" + + lines = string(sample_param_name // " = " // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_char_apostrophe_delim + + +subroutine test_read_param_char_missing + type(param_file_type) :: param + character(len=8) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_char_missing + + +subroutine test_read_param_char_array + type(param_file_type) :: param + character(len=3) :: sample(3) + type(string) :: lines(1) + character(len=*), parameter :: sample_input = '"abc", "def", "ghi"' + character(len=*), parameter :: sample_result(3) = ["abc", "def", "ghi"] + + lines = string(sample_param_name // ' = ' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(all(sample == sample_result), 'Incorrect value') +end subroutine test_read_param_char_array + + +subroutine test_read_param_char_array_missing + type(param_file_type) :: param + character(len=8) :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_char_array_missing + + +subroutine test_read_param_time_date + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1980-01-01 00:00:00') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_time_date + + +subroutine test_read_param_time_date_bad_format + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1980--01--01 00::00::00') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_time_date_bad_format + + +subroutine test_read_param_time_tuple + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1980,1,1,0,0,0') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_time_tuple + + +subroutine test_read_param_time_bad_tuple + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1980, 1') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_time_bad_tuple + + +subroutine test_read_param_time_bad_tuple_values + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 0, 0, 0, 0, 0, 0') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_time_bad_tuple_values + + +subroutine test_read_param_time_unit + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 0.5') + call create_test_file(param_filename, lines) + + call set_calendar_type(NOLEAP) + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, timeunit=86400.) + call close_param_file(param) +end subroutine test_read_param_time_unit + + +subroutine test_read_param_time_missing + type(param_file_type) :: param + type(time_type) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, missing_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_time_missing + + +subroutine test_read_param_time_undefined + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string('#undef ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample, fail_if_missing=.true.) + ! FATAL; return to program +end subroutine test_read_param_time_undefined + + +subroutine test_read_param_time_type_err + type(param_file_type) :: param + type(time_type) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1., 2., 3., 4., 5., 6.') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_time_type_err + +! Generic parameter tests + +subroutine test_read_param_unused_fatal + type(param_file_type) :: param + type(string) :: lines(2) + + lines = [ & + string('FATAL_UNUSED_PARAMS = True'), & + string(sample_param_name // ' = 1') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call close_param_file(param) + ! FATAL; return to program +end subroutine test_read_param_unused_fatal + + +subroutine test_read_param_replace_tabs + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = "1" + integer, parameter :: sample_result = 1 + character, parameter :: tab = achar(9) + + lines = string(sample_param_name // tab // '=' // tab // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_replace_tabs + + +subroutine test_read_param_pad_equals + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + character(len=*), parameter :: sample_input = "1" + integer, parameter :: sample_result = 1 + + lines = string(sample_param_name // '=' // sample_input) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_pad_equals + + +subroutine test_read_param_multiline_param + type(param_file_type) :: param + integer :: sample + type(string) :: lines(2) + integer, parameter :: sample_result = 1 + character, parameter :: backslash = achar(92) + + lines = [ & + string(sample_param_name // ' = ' // backslash), & + string(' 1') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect result') +end subroutine test_read_param_multiline_param + + +subroutine test_read_param_multiline_param_unclosed + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + character, parameter :: backslash = achar(92) + + lines = string(sample_param_name // ' = ' // backslash) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_multiline_param_unclosed + + +subroutine test_read_param_multiline_comment + type(param_file_type) :: param + integer :: sample + + type(string) :: lines(6) + + lines = [ & + string('/* First C comment line'), & + string(' Second C comment line */'), & + string('// First C++ comment line'), & + string('// Second C++ comment line'), & + string('! First Fortran comment line'), & + string('! Second Fortran comment line') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call close_param_file(param) +end subroutine test_read_param_multiline_comment + + +subroutine test_read_param_multiline_comment_unclosed + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines = string('/* Unclosed C comment') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_multiline_comment_unclosed + + +subroutine test_read_param_misplaced_quote + type(param_file_type) :: param + character(len=20) :: sample + type(string) :: lines(1) + + lines = string(sample_param_name // ' = "abc') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_misplaced_quote + + +subroutine test_read_param_define + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + integer, parameter :: sample_result = 2 + + lines = string('#define ' // sample_param_name // ' 2') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_define + + +subroutine test_read_param_define_as_flag + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines = string('#define ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_define_as_flag + + +subroutine test_read_param_override + type(param_file_type) :: param + integer :: sample + type(string) :: lines(2) + integer, parameter :: sample_result = 2 + + lines = [ & + string(sample_param_name // ' = 1'), & + string('#override ' // sample_param_name // ' = 2') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_override + + +subroutine test_read_param_override_misplaced + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines(1) = string('#define #override ' // sample_param_name // ' = 1') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_override_misplaced + + +subroutine test_read_param_override_twice + type(param_file_type) :: param + integer :: sample + type(string) :: lines(3) + + lines = [ & + string(sample_param_name // ' = 1'), & + string('#override ' // sample_param_name // ' = 2'), & + string('#override ' // sample_param_name // ' = 3') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_override_twice + + +subroutine test_read_param_override_repeat + type(param_file_type) :: param + integer :: sample + type(string) :: lines(3) + + lines = [ & + string(sample_param_name // ' = 1'), & + string('#override ' // sample_param_name // ' = 2'), & + string('#override ' // sample_param_name // ' = 2') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_override_repeat + + +subroutine test_read_param_override_warn_chain + type(param_file_type) :: param + integer :: sample + character(len=*), parameter :: other_param_name = 'OTHER_PARAMETER' + type(string) :: lines(4) + + lines = [ & + string(other_param_name // ' = 1'), & + string(sample_param_name // ' = 2'), & + string('#override ' // other_param_name // ' = 3'), & + string('#override ' // sample_param_name // ' = 4') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! First invoke the "other" override, adding it to the chain + call read_param(param, other_param_name, sample) + ! Now invoke the "sample" override, with "other" in the chain + call read_param(param, sample_param_name, sample) + ! Finally, re-invoke the "other" override, having already been issued. + call read_param(param, other_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_override_warn_chain + + +subroutine test_read_param_assign_after_override + type(param_file_type) :: param + integer :: sample + type(string) :: lines(2) + + lines = [ & + string('#override ' // sample_param_name // ' = 2'), & + string(sample_param_name // ' = 3') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_assign_after_override + + +subroutine test_read_param_override_no_def + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines(1) = string('#override ' // sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_override_no_def + + +subroutine test_read_param_assign_twice + type(param_file_type) :: param + integer :: sample + type(string) :: lines(2) + + lines = [ & + string(sample_param_name // ' = 1'), & + string(sample_param_name // ' = 2') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_assign_twice + + +subroutine test_read_param_assign_repeat + type(param_file_type) :: param + integer :: sample + type(string) :: lines(2) + + lines = [ & + string(sample_param_name // ' = 1'), & + string(sample_param_name // ' = 1') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call close_param_file(param) +end subroutine test_read_param_assign_repeat + + +subroutine test_read_param_null_stmt + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines(1) = string(sample_param_name) + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_null_stmt + + +subroutine test_read_param_assign_in_define + type(param_file_type) :: param + integer :: sample + type(string) :: lines(1) + + lines = string('#define ' // sample_param_name // ' = 1') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + ! FATAL; return to program +end subroutine test_read_param_assign_in_define + +!-- Blocks + +subroutine test_read_param_block + type(param_file_type) :: param + integer :: sample + type(string) :: lines(3) + integer, parameter :: sample_result = 123 + + lines = [ & + string('ABC%'), & + string('ABC%' // sample_param_name // ' = 123'), & + string('%ABC') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call openParameterBlock(param, 'ABC') + call read_param(param, sample_param_name, sample) + call closeParameterBlock(param) + call clearParameterBlock(param) + call close_param_file(param) + + call assert(sample == sample_result, 'Incorrect value') +end subroutine test_read_param_block + + +! TODO: This test fails due to an implementation issue. +subroutine test_read_param_block_stack + type(param_file_type) :: param + integer :: sample + type(string) :: lines(5) + + lines = [ & + string('ABC%'), & + string('DEF%'), & + string(sample_param_name // ' = 123'), & + string('DEF%'), & + string('%ABC') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call openParameterBlock(param, 'ABC') + call openParameterBlock(param, 'DEF') + call read_param(param, sample_param_name, sample) + call closeParameterBlock(param) + call clearParameterBlock(param) + call close_param_file(param) +end subroutine test_read_param_block_stack + + +! NOTE: This is a simpler version of the block_stack test which works +subroutine test_read_param_block_inline_stack + type(param_file_type) :: param + integer :: sample + type(string) :: lines(3) + + lines = [ & + string('ABC%'), & + string('DEF%' // sample_param_name // ' = 123'), & + string('%ABC') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call openParameterBlock(param, 'ABC') + call openParameterBlock(param, 'DEF') + call read_param(param, sample_param_name, sample) + call closeParameterBlock(param) + call clearParameterBlock(param) + call close_param_file(param) +end subroutine test_read_param_block_inline_stack + + +subroutine test_read_param_block_empty_pop + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call openParameterBlock(param, '%') + call openParameterBlock(param, 'ABC') + call closeParameterBlock(param) + call closeParameterBlock(param) + ! FATAL; return to program +end subroutine test_read_param_block_empty_pop + + +subroutine test_read_param_block_close_unnamed + type(param_file_type) :: param + type(string) :: lines(2) + + lines = [ & + string('ABC%'), & + string('%ABC') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call openParameterBlock(param, 'ABC') + call closeParameterBlock(param) + call closeParameterBlock(param) + ! FATAL; return to program +end subroutine test_read_param_block_close_unnamed + + +subroutine test_read_param_block_close_unopened + type(param_file_type) :: param + type(string) :: lines(1) + + lines = string('%CBA') + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_block_close_unopened + + +subroutine test_read_param_block_unmatched + type(param_file_type) :: param + type(string) :: lines(2) + + lines = [ & + string('ABC%'), & + string('%CBA') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + ! FATAL; return to program +end subroutine test_read_param_block_unmatched + + +subroutine test_open_unallocated_block + type(param_file_type) :: param + character(len=*), parameter :: block_name = "ABC" + + call openParameterBlock(param, block_name) + ! FATAL; return to program +end subroutine test_open_unallocated_block + + +subroutine test_close_unallocated_block + type(param_file_type) :: param + + call closeParameterBlock(param) + ! FATAL; return to program +end subroutine test_close_unallocated_block + + +subroutine test_clear_unallocated_block + type(param_file_type) :: param + + call clearParameterBlock(param) + ! FATAL; return to program +end subroutine test_clear_unallocated_block + + +subroutine test_read_param_block_outside_block + type(param_file_type) :: param + integer :: sample + type(string) :: lines(3) + + lines = [ & + string('ABC%'), & + string(sample_param_name // ' = 1'), & + string('%ABC') & + ] + call create_test_file(param_filename, lines) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) +end subroutine test_read_param_block_outside_block + +!--- + +subroutine test_log_version_cs + type(param_file_type) :: param + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_version(param, module_name, module_version, desc=module_desc) + call close_param_file(param) +end subroutine test_log_version_cs + + +subroutine test_log_version_plain + call log_version(module_name, module_version) +end subroutine test_log_version_plain + + +subroutine test_log_param_int + type(param_file_type) :: param + integer, parameter :: sample = 1 + character(len=*), parameter :: desc = "Parameter description" + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc) + call close_param_file(param) +end subroutine test_log_param_int + + +subroutine test_log_param_int_array + type(param_file_type) :: param + integer, parameter :: sample(3) = [1, 2, 3] + character(len=*), parameter :: desc = "Parameter description" + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc) + call close_param_file(param) +end subroutine test_log_param_int_array + + +subroutine test_log_param_real + type(param_file_type) :: param + real, parameter :: sample = 1. + character(len=*), parameter :: desc = "Parameter description" + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc) + call close_param_file(param) +end subroutine test_log_param_real + + +subroutine test_log_param_real_array + type(param_file_type) :: param + real, parameter :: sample(3) = [1., 2., 3.] + character(len=*), parameter :: desc = "Parameter description" + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc) + call close_param_file(param) +end subroutine test_log_param_real_array + + +subroutine test_log_param_time + type(param_file_type) :: param + type(time_type) :: sample + character(len=*), parameter :: desc = "Parameter description" + type(string) :: lines(1) + + lines = string(sample_param_name // ' = 1980,1,1,0,0,0') + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call read_param(param, sample_param_name, sample) + call log_param(param, module_name, sample_param_name, sample, desc=desc) + call close_param_file(param) +end subroutine test_log_param_time + + +subroutine test_log_param_time_as_date + type(param_file_type) :: param + type(time_type) :: sample + character(len=*), parameter :: desc = "Parameter description" + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + sample = set_date(1980, 1, 1, 0, 0, 0) + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + log_date=.true.) + call close_param_file(param) +end subroutine test_log_param_time_as_date + + +subroutine test_log_param_time_as_date_default + type(param_file_type) :: param + type(time_type) :: sample + type(time_type) :: default_date + character(len=*), parameter :: desc = "Parameter description" + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + + call set_ticks_per_second(60) + default_date = set_date(1980, 1, 1, 0, 0, 0, 30) + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + log_date=.true., default=default_date) + + call set_ticks_per_second(300) + default_date = set_date(1980, 1, 1, 0, 0, 0, 150) + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + log_date=.true., default=default_date) + + call close_param_file(param) +end subroutine test_log_param_time_as_date_default + + +subroutine test_log_param_time_as_date_tick + type(param_file_type) :: param + type(time_type) :: sample + character(len=*), parameter :: desc = "Parameter description" + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + log_date=.true.) + call close_param_file(param) +end subroutine test_log_param_time_as_date_tick + + +subroutine test_log_param_time_with_unit + type(param_file_type) :: param + type(time_type) :: sample + type(time_type) :: default_date + character(len=*), parameter :: desc = "Parameter description" + character(len=*), parameter :: sample_units = "days since whatever" + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call set_ticks_per_second(60) + sample = set_date(1980, 1, 1, 0, 0, 0, 30) + + default_date = set_date(1980, 1, 1, 0, 0, 0, 30) + + call open_param_file(param_filename, param) + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + units=sample_units, timeunit=86400., default=default_date) + call close_param_file(param) +end subroutine test_log_param_time_with_unit + + +subroutine test_log_param_time_with_timeunit + type(param_file_type) :: param + type(time_type) :: sample + integer :: i + character(len=*), parameter :: desc = "Parameter description" + real, parameter :: timeunits(5) = [1., 3600., 86400., 3.1e7, 1e8] + + call set_calendar_type(NOLEAP) + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + do i = 1,5 + call log_param(param, module_name, sample_param_name, sample, desc=desc, & + timeunit=timeunits(i)) + enddo + call close_param_file(param) +end subroutine test_log_param_time_with_timeunit + +!---- + +subroutine test_get_param_int + type(param_file_type) :: param + integer :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_int + + +subroutine test_get_param_int_no_read_no_log + type(param_file_type) :: param + integer :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_int_no_read_no_log + + +subroutine test_get_param_int_array + type(param_file_type) :: param + integer :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_int_array + + +subroutine test_get_param_int_array_no_read_no_log + type(param_file_type) :: param + integer :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_int_array_no_read_no_log + + +subroutine test_get_param_real + type(param_file_type) :: param + real :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_real + + +subroutine test_get_param_real_no_read_no_log + type(param_file_type) :: param + real :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_real_no_read_no_log + + +subroutine test_get_param_real_array + type(param_file_type) :: param + real :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_real_array + + +subroutine test_get_param_real_array_no_read_no_log + type(param_file_type) :: param + real :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_real_array_no_read_no_log + + +subroutine test_get_param_char + type(param_file_type) :: param + character(len=8) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_char + + +subroutine test_get_param_char_no_read_no_log + type(param_file_type) :: param + character(len=8) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_char_no_read_no_log + + +subroutine test_get_param_char_array + type(param_file_type) :: param + character(len=8) :: sample(3) + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_char_array + + +subroutine test_get_param_logical + type(param_file_type) :: param + logical :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_logical + + +subroutine test_get_param_logical_no_read_no_log + type(param_file_type) :: param + logical :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_logical_no_read_no_log + + +subroutine test_get_param_logical_default + type(param_file_type) :: param + logical :: sample + logical, parameter :: default_value = .false. + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + default=default_value) + call close_param_file(param) +end subroutine test_get_param_logical_default + + +subroutine test_get_param_time + type(param_file_type) :: param + type(time_type) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample) + call close_param_file(param) +end subroutine test_get_param_time + + +subroutine test_get_param_time_no_read_no_log + type(param_file_type) :: param + type(time_type) :: sample + + call create_test_file(param_filename) + + call open_param_file(param_filename, param) + call get_param(param, module_name, sample_param_name, sample, & + do_not_read=.true., do_not_log=.true.) + call close_param_file(param) +end subroutine test_get_param_time_no_read_no_log + + +! Utility functions +! TODO: Move to a generic testing module + +subroutine cleanup_file_parser + integer :: i + + call delete_test_file(param_filename) + do i = 1, 4 + call delete_test_file("MOM_parameter_doc."//param_docfiles(i)) + enddo + + call set_calendar_type(NO_CALENDAR) +end subroutine cleanup_file_parser + + +subroutine run_file_parser_tests + ! testing... + type(TestSuite) :: suite + + ! Delete any pre-existing test parameter files + call cleanup_file_parser + + ! Build the test suite + suite = TestSuite() + suite%cleanup => cleanup_file_parser + + call suite%add(test_open_param_file, "test_open_param_file") + + call suite%add(test_close_param_file_quiet, "test_close_param_file_quiet") + + call suite%add(test_open_param_file_component, "test_open_param_file_component", & + cleanup=cleanup_open_param_file_component) + + call suite%add(test_open_param_file_docdir, "test_open_param_file_docdir") + + call suite%add(test_open_param_file_empty_filename, & + "test_open_param_file_empty_filename", fatal=.true.) + + call suite%add(test_open_param_file_long_name, & + "test_open_param_file_longname") + + call suite%add(test_missing_param_file, "test_missing_param_file", & + fatal=.true.) + + call suite%add(test_open_param_file_ioerr, "test_open_param_file_ioerr", & + fatal=.true., cleanup=cleanup_open_param_file_ioerr) + + call suite%add(test_open_param_file_checkable, & + "test_open_param_file_checkable") + + call suite%add(test_reopen_param_file, "test_reopen_param_file") + + call suite%add(test_open_param_file_netcdf, "test_open_param_file_netcdf", & + fatal=.true., cleanup=cleanup_open_param_file_netcdf) + + call suite%add(test_open_param_file_no_doc, "test_open_param_file_no_doc") + + call suite%add(test_read_param_int, "test_read_param_int") + + call suite%add(test_read_param_int_missing, "test_read_param_int_missing", & + fatal=.true.) + + call suite%add(test_read_param_int_undefined, & + "test_read_param_int_undefined", fatal=.true.) + + call suite%add(test_read_param_int_type_err, & + "test_read_param_int_type_err", fatal=.true.) + + call suite%add(test_read_param_int_array, "test_read_param_int_array") + + call suite%add(test_read_param_int_array_missing, & + "test_read_param_int_array_missing", fatal=.true.) + + call suite%add(test_read_param_int_array_undefined, & + "test_read_param_int_array_undefined", fatal=.true.) + + call suite%add(test_read_param_int_array_type_err, & + "test_read_param_int_array_type_err", fatal=.true.) + + call suite%add(test_read_param_real, "test_read_param_real") + + call suite%add(test_read_param_real_missing, & + "test_read_param_real_missing", fatal=.true.) + + call suite%add(test_read_param_real_undefined, & + "test_read_param_real_undefined", fatal=.true.) + + call suite%add(test_read_param_real_type_err, & + "test_read_param_real_type_err", fatal=.true.) + + call suite%add(test_read_param_real_array, "test_read_param_real_array") + + call suite%add(test_read_param_real_array_missing, & + "test_read_param_real_array_missing", fatal=.true.) + + call suite%add(test_read_param_real_array_undefined, & + "test_read_param_real_array_undefined", fatal=.true.) + + call suite%add(test_read_param_real_array_type_err, & + "test_read_param_real_array_type_err", fatal=.true.) + + call suite%add(test_read_param_logical, "test_read_param_logical") + + call suite%add(test_read_param_logical_missing, & + "test_read_param_logical_missing", fatal=.true.) + + call suite%add(test_read_param_char_no_delim, & + "test_read_param_char_no_delim") + + call suite%add(test_read_param_char_quote_delim, & + "test_read_param_char_quote_delim") + + call suite%add(test_read_param_char_apostrophe_delim, & + "test_read_param_char_apostrophe_delim") + + call suite%add(test_read_param_char_missing, & + "test_read_param_char_missing", fatal=.true.) + + call suite%add(test_read_param_char_array, "test_read_param_char_array") + + call suite%add(test_read_param_char_array_missing, & + "test_read_param_char_array_missing", fatal=.true.) + + call suite%add(test_read_param_time_date, "test_read_param_time_date") + + call suite%add(test_read_param_time_date_bad_format, & + "test_read_param_time_date_bad_format", fatal=.true.) + + call suite%add(test_read_param_time_tuple, "test_read_param_time_tuple") + + call suite%add(test_read_param_time_bad_tuple, & + "test_read_param_time_bad_tuple", fatal=.true.) + + call suite%add(test_read_param_time_bad_tuple_values, & + "test_read_param_time_bad_tuple_values", fatal=.true.) + + call suite%add(test_read_param_time_missing, & + "test_read_param_time_missing", fatal=.true.) + + call suite%add(test_read_param_time_undefined, & + "test_read_param_time_undefined", fatal=.true.) + + call suite%add(test_read_param_time_type_err, & + "test_read_param_time_type_err", fatal=.true.) + + call suite%add(test_read_param_time_unit, "test_read_param_time_unit") + + call suite%add(test_read_param_unused_fatal, & + "test_read_param_unused_fatal", fatal=.true.) + + call suite%add(test_read_param_multiline_comment, & + "test_read_param_multiline_comment") + + call suite%add(test_read_param_multiline_comment_unclosed, & + "test_read_param_multiline_comment_unclosed", fatal=.true.) + + call suite%add(test_read_param_multiline_param, & + "test_read_param_multiline_param") + + call suite%add(test_read_param_multiline_param_unclosed, & + "test_read_param_multiline_param_unclosed", fatal=.true.) + + call suite%add(test_read_param_replace_tabs, "test_read_param_replace_tabs") + + call suite%add(test_read_param_pad_equals, "test_read_param_pad_equals") + + call suite%add(test_read_param_misplaced_quote, & + "test_read_param_misplaced_quote", fatal=.true.) + + call suite%add(test_read_param_define, "test_read_param_define") + + call suite%add(test_read_param_define_as_flag, & + "test_read_param_define_as_flag") + + call suite%add(test_read_param_override, "test_read_param_override") + + call suite%add(test_read_param_override_misplaced, & + "test_read_param_override_misplaced", fatal=.true.) + + call suite%add(test_read_param_override_twice, & + "test_read_param_override_twice", fatal=.true.) + + call suite%add(test_read_param_override_repeat, & + "test_read_param_override_repeat", fatal=.true.) + + call suite%add(test_read_param_override_warn_chain, & + "test_read_param_override_warn_chain") + + call suite%add(test_read_param_override_no_def, & + "test_read_param_override_no_def", fatal=.true.) + + call suite%add(test_read_param_assign_after_override, & + "test_read_param_assign_after_override") + + call suite%add(test_read_param_assign_twice, & + "test_read_param_assign_twice", fatal=.true.) + + call suite%add(test_read_param_assign_repeat, & + "test_read_param_assign_repeat") + + call suite%add(test_read_param_null_stmt, "test_read_param_null_stmt", & + fatal=.true.) + + call suite%add(test_read_param_assign_in_define, & + "test_read_param_assign_in_define", fatal=.true.) + + call suite%add(test_read_param_block, "test_read_param_block") + + ! FIXME: Test does not pass + !call suite%add(test_read_param_block_stack, "test_read_param_block_stack") + + call suite%add(test_read_param_block_inline_stack, & + "test_read_param_block_inline_stack") + + call suite%add(test_read_param_block_empty_pop, & + "test_read_param_block_empty_pop", fatal=.true.) + + call suite%add(test_read_param_block_close_unopened, & + "test_read_param_block_close_unopened", fatal=.true.) + + call suite%add(test_read_param_block_close_unnamed, & + "test_read_param_block_close_unnamed", fatal=.true.) + + call suite%add(test_read_param_block_unmatched, & + "test_read_param_block_unmatched", fatal=.true.) + + call suite%add(test_read_param_block_outside_block, & + "test_read_param_block_outside_block") + + call suite%add(test_open_unallocated_block, "test_open_unallocated_block", & + fatal=.true.) + + call suite%add(test_close_unallocated_block, & + "test_close_unallocated_block", fatal=.true.) + + call suite%add(test_clear_unallocated_block, & + "test_clear_unallocated_block", fatal=.true.) + + call suite%add(test_log_version_cs, "test_log_version_cs") + + call suite%add(test_log_version_plain, "test_log_version_plain") + + call suite%add(test_log_param_int, "test_log_param_int") + + call suite%add(test_log_param_int_array, "test_log_param_int_array") + + call suite%add(test_log_param_real, "test_log_param_real") + + call suite%add(test_log_param_real_array, "test_log_param_real_array") + + call suite%add(test_log_param_time, "test_log_param_time") + + call suite%add(test_log_param_time_as_date, "test_log_param_time_as_date") + + call suite%add(test_log_param_time_as_date_default, & + "test_log_param_time_as_date_default") + + call suite%add(test_log_param_time_as_date_tick, & + "test_log_param_time_as_date_tick") + + call suite%add(test_log_param_time_with_unit, & + "test_log_param_time_with_unit") + + call suite%add(test_log_param_time_with_timeunit, & + "test_log_param_time_with_timeunit") + + call suite%add(test_get_param_int, "test_get_param_int") + + call suite%add(test_get_param_int_no_read_no_log, & + "test_get_param_int_no_read_no_log") + + call suite%add(test_get_param_int_array, "test_get_param_int_array") + + call suite%add(test_get_param_int_array_no_read_no_log, & + "test_get_param_int_array_no_read_no_log") + + call suite%add(test_get_param_real, "test_get_param_real") + + call suite%add(test_get_param_real_no_read_no_log, & + "test_get_param_real_n_read_no_log") + + call suite%add(test_get_param_real_array, "test_get_param_real_array") + + call suite%add(test_get_param_real_array_no_read_no_log, & + "test_get_param_real_array_no_read_no_log") + + call suite%add(test_get_param_char, "test_get_param_char") + + call suite%add(test_get_param_char_no_read_no_log, & + "test_get_param_char_no_read_no_log") + + call suite%add(test_get_param_char_array, "test_get_param_char_array") + + call suite%add(test_get_param_logical, "test_get_param_logical") + + call suite%add(test_get_param_logical_default, & + "test_get_param_logical_default") + + call suite%add(test_get_param_logical_no_read_no_log, & + "test_get_param_logical_no_read_no_log") + + call suite%add(test_get_param_time, "test_get_param_time") + + call suite%add(test_get_param_time_no_read_no_log, & + "test_get_param_time_np_read_no_log") + + call suite%run() +end subroutine run_file_parser_tests + +end module MOM_file_parser_tests From 0b056864e7084ccb39ce22e6cead14a1e1fc9006 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 3 May 2022 17:15:42 -0400 Subject: [PATCH 22/68] Fix bugs in output files with rescaled heights Fixed two minor bugs in the MOM6 output when run with Z_RESCALE_POWER not equal to 0. All solutions are bitwise identical, but some of the diagnostic output files have minor changes. With these corrections, several output files are now unaltered by internal dimensional rescaling. The specific bug fixes are: - Avoid using a rescaled depth as the vertical coordinate label in z-space output files. Only the coordinate label is impacted, but this bug fix avoids the chance of having silly values for this coordinate. - Rescale the depths back to mks units before taking their checksum for storage in the MOM_sum_output file. With this bug, the depth list file might be unnecessarily recreated with a new run with different scaling, but the file itself is fine. --- src/diagnostics/MOM_sum_output.F90 | 2 +- src/framework/MOM_diag_remap.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 33f3edcfd4..24c1b79bd2 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -1357,7 +1357,7 @@ subroutine get_depth_list_checksums(G, US, depth_chksum, area_chksum) ! Depth checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%bathyT(i,j) + G%Z_ref + field(i,j) = US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) enddo ; enddo write(depth_chksum, '(Z16)') field_chksum(field(:,:)) diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 63e6bcba7a..b665dcd748 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -217,7 +217,7 @@ subroutine diag_remap_configure_axes(remap_cs, GV, US, param_file) allocate(interfaces(remap_cs%nz+1)) allocate(layers(remap_cs%nz)) - interfaces(:) = getCoordinateInterfaces(remap_cs%regrid_cs) + interfaces(:) = getCoordinateInterfaces(remap_cs%regrid_cs, undo_scaling=.true.) layers(:) = 0.5 * ( interfaces(1:remap_cs%nz) + interfaces(2:remap_cs%nz+1) ) remap_cs%interface_axes_id = MOM_diag_axis_init(lowercase(trim(remap_cs%diag_coord_name))//'_i', & From 2b5b4388a5a5479ee567f66410248456eeee0532 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 16 May 2022 02:03:47 -0400 Subject: [PATCH 23/68] +Add optional scale argument to time_interp_external Added a new optional scale argument to time_interp_external that can be used to rescale the values that are set within the infrastructure routines that underlie time_interp_external. This new capability has been fully tested, although it is not being invoked with this commit. All answers are bitwise identical, but there is a new optional argument in a public interface. --- src/framework/MOM_interpolate.F90 | 112 ++++++++++++++++++++++++++++-- 1 file changed, 107 insertions(+), 5 deletions(-) diff --git a/src/framework/MOM_interpolate.F90 b/src/framework/MOM_interpolate.F90 index 8f20bf73fe..38a786e593 100644 --- a/src/framework/MOM_interpolate.F90 +++ b/src/framework/MOM_interpolate.F90 @@ -26,19 +26,45 @@ module MOM_interpolate contains !> Read a scalar field based on model time. -subroutine time_interp_external_0d(field_id, time, data_in, verbose) +subroutine time_interp_external_0d(field_id, time, data_in, verbose, scale) integer, intent(in) :: field_id !< The integer index of the external field returned !! from a previous call to init_external_field() type(time_type), intent(in) :: time !< The target time for the data real, intent(inout) :: data_in !< The interpolated value logical, optional, intent(in) :: verbose !< If true, write verbose output for debugging + real, optional, intent(in) :: scale !< A scaling factor that new values of data_in are + !! multiplied by before it is returned + real :: data_in_pre_scale ! The input data before rescaling + real :: I_scale ! The inverse of scale + + ! Store the input value in case the scaling factor is perfectly invertable. + data_in_pre_scale = data_in + I_scale = 1.0 + if (present(scale)) then ; if ((scale /= 1.0) .and. (scale /= 0.0)) then + ! Because time_interp_extern has the ability to only set some values, but no clear + ! mechanism to determine which values have been set, the input data has to + ! be unscaled so that it will have the right values when it is returned. + I_scale = 1.0 / scale + data_in = data_in * I_scale + endif ; endif call time_interp_extern(field_id, time, data_in, verbose=verbose) + + if (present(scale)) then ; if (scale /= 1.0) then + ! Rescale data that has been newly set and restore the scaling of unset data. + if (data_in == I_scale * data_in_pre_scale) then + data_in = data_in_pre_scale + else + data_in = scale * data_in + endif + endif ; endif + end subroutine time_interp_external_0d !> Read a 2d field from an external based on model time, potentially including horizontal !! interpolation and rotation of the data -subroutine time_interp_external_2d(field_id, time, data_in, interp, verbose, horz_interp, mask_out, turns) +subroutine time_interp_external_2d(field_id, time, data_in, interp, & + verbose, horz_interp, mask_out, turns, scale) integer, intent(in) :: field_id !< The integer index of the external field returned !! from a previous call to init_external_field() type(time_type), intent(in) :: time !< The target time for the data @@ -50,14 +76,32 @@ subroutine time_interp_external_2d(field_id, time, data_in, interp, verbose, hor logical, dimension(:,:), & optional, intent(out) :: mask_out !< An array that is true where there is valid data integer, optional, intent(in) :: turns !< Number of quarter turns to rotate the data + real, optional, intent(in) :: scale !< A scaling factor that new values of data_in are + !! multiplied by before it is returned - real, allocatable :: data_pre_rot(:,:) ! The input data before rotation + real, allocatable :: data_in_pre_scale(:,:) ! The input data before rescaling + real, allocatable :: data_pre_rot(:,:) ! The unscaled input data before rotation + real :: I_scale ! The inverse of scale integer :: qturns ! The number of quarter turns to rotate the data + integer :: i, j ! TODO: Mask rotation requires logical array rotation support if (present(mask_out)) & call MOM_error(FATAL, "Rotation of masked output not yet support") + if (present(scale)) then ; if ((scale /= 1.0) .and. (scale /= 0.0)) then + ! Because time_interp_extern has the ability to only set some values, but no clear mechanism + ! to determine which values have been set, the input data has to be unscaled so that it will + ! have the right values when it is returned. It may be a problem for some compiler settings + ! if there are NaNs in data_in, but they will not spread. + if (abs(fraction(scale)) /= 1.0) then + ! This scaling factor may not be perfectly invertable, so store the input value + allocate(data_in_pre_scale, source=data_in) + endif + I_scale = 1.0 / scale + data_in(:,:) = I_scale * data_in(:,:) + endif ; endif + qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) if (qturns == 0) then @@ -70,12 +114,30 @@ subroutine time_interp_external_2d(field_id, time, data_in, interp, verbose, hor call rotate_array(data_pre_rot, turns, data_in) deallocate(data_pre_rot) endif + + if (present(scale)) then ; if (scale /= 1.0) then + ! Rescale data that has been newly set and restore the scaling of unset data. + if ((abs(fraction(scale)) /= 1.0) .and. (scale /= 0.0)) then + do j=LBOUND(data_in,2),UBOUND(data_in,2) ; do i=LBOUND(data_in,1),UBOUND(data_in,1) + ! This handles the case where scale is not exactly invertable for data + ! values that have not been modified by time_interp_extern. + if (data_in(i,j) == I_scale * data_in_pre_scale(i,j)) then + data_in(i,j) = data_in_pre_scale(i,j) + else + data_in(i,j) = scale * data_in(i,j) + endif + enddo ; enddo + else + data_in(:,:) = scale * data_in(:,:) + endif + endif ; endif + end subroutine time_interp_external_2d !> Read a 3d field based on model time, and rotate to the model grid subroutine time_interp_external_3d(field_id, time, data_in, interp, & - verbose, horz_interp, mask_out, turns) + verbose, horz_interp, mask_out, turns, scale) integer, intent(in) :: field_id !< The integer index of the external field returned !! from a previous call to init_external_field() type(time_type), intent(in) :: time !< The target time for the data @@ -87,14 +149,32 @@ subroutine time_interp_external_3d(field_id, time, data_in, interp, & logical, dimension(:,:,:), & optional, intent(out) :: mask_out !< An array that is true where there is valid data integer, optional, intent(in) :: turns !< Number of quarter turns to rotate the data + real, optional, intent(in) :: scale !< A scaling factor that new values of data_in are + !! multiplied by before it is returned - real, allocatable :: data_pre_rot(:,:,:) ! The input data before rotation + real, allocatable :: data_in_pre_scale(:,:,:) ! The input data before rescaling + real, allocatable :: data_pre_rot(:,:,:) ! The unscaled input data before rotation + real :: I_scale ! The inverse of scale integer :: qturns ! The number of quarter turns to rotate the data + integer :: i, j, k ! TODO: Mask rotation requires logical array rotation support if (present(mask_out)) & call MOM_error(FATAL, "Rotation of masked output not yet support") + if (present(scale)) then ; if ((scale /= 1.0) .and. (scale /= 0.0)) then + ! Because time_interp_extern has the ability to only set some values, but no clear mechanism + ! to determine which values have been set, the input data has to be unscaled so that it will + ! have the right values when it is returned. It may be a problem for some compiler settings + ! if there are NaNs in data_in, but they will not spread. + if (abs(fraction(scale)) /= 1.0) then + ! This scaling factor may not be perfectly invertable, so store the input value + allocate(data_in_pre_scale, source=data_in) + endif + I_scale = 1.0 / scale + data_in(:,:,:) = I_scale * data_in(:,:,:) + endif ; endif + qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) if (qturns == 0) then @@ -107,6 +187,28 @@ subroutine time_interp_external_3d(field_id, time, data_in, interp, & call rotate_array(data_pre_rot, turns, data_in) deallocate(data_pre_rot) endif + + if (present(scale)) then ; if (scale /= 1.0) then + ! Rescale data that has been newly set and restore the scaling of unset data. + if ((abs(fraction(scale)) /= 1.0) .and. (scale /= 0.0)) then + do k=LBOUND(data_in,3),UBOUND(data_in,3) + do j=LBOUND(data_in,2),UBOUND(data_in,2) + do i=LBOUND(data_in,1),UBOUND(data_in,1) + ! This handles the case where scale is not exactly invertable for data + ! values that have not been modified by time_interp_extern. + if (data_in(i,j,k) == I_scale * data_in_pre_scale(i,j,k)) then + data_in(i,j,k) = data_in_pre_scale(i,j,k) + else + data_in(i,j,k) = scale * data_in(i,j,k) + endif + enddo + enddo + enddo + else + data_in(:,:,:) = scale * data_in(:,:,:) + endif + endif ; endif + end subroutine time_interp_external_3d end module MOM_interpolate From 8b513055b331bd6a09e2759aec2bd77f8ea1207c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 19 May 2022 02:44:44 -0400 Subject: [PATCH 24/68] Simplify set_grid_metrics_from_mosaic Simplified the code in set_grid_metrics_from_mosaic and set_coord_from_file using the scale argument to MOM_read_data, eliminating several arrays that are no longer needed. Also added a call to set RAD_EARTH via get_param for grids where it is not otherwise set, replacing a hard-coded constant. The variable G%Rad_Earth is used in a few places even in these cases, so it should be logged as a run-time parameter. All answers are bitwise identical, although there are new entries in some MOM_parameter_doc.all files. --- .../MOM_coord_initialization.F90 | 12 +-- src/initialization/MOM_grid_initialize.F90 | 86 +++++++------------ 2 files changed, 36 insertions(+), 62 deletions(-) diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index cb5d0ca81b..91b30a1e86 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -42,8 +42,8 @@ subroutine MOM_initialize_coord(GV, US, PF, tv, max_depth) ! Local character(len=200) :: config logical :: debug -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: nz nz = GV%ke @@ -414,10 +414,9 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) if (.not.file_exists(filename)) call MOM_error(FATAL, & " set_coord_from_file: Unable to open "//trim(filename)) - call MOM_read_data(filename, coord_var, Rlay) - do k=1,nz ; Rlay(k) = US%kg_m3_to_R*Rlay(k) ; enddo + call MOM_read_data(filename, coord_var, Rlay, scale=US%kg_m3_to_R) g_prime(1) = g_fs - do k=2,nz ; g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) ; enddo + do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo do k=1,nz ; if (g_prime(k) <= 0.0) then call MOM_error(FATAL, "MOM_initialization set_coord_from_file: "//& "Zero or negative g_primes read from variable "//"Layer"//" in file "//& @@ -442,7 +441,8 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) ! Local variables character(len=40) :: mdl = "set_coord_linear" ! This subroutine - real :: Rlay_ref, Rlay_range, g_fs + real :: Rlay_ref, Rlay_range ! A reference density and its range [R ~> kg m-3] + real :: g_fs ! The reduced gravity across the free surface [L2 Z-1 T-2 ~> m s-2] integer :: k, nz nz = GV%ke diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 09814403a4..bc004daa95 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -97,11 +97,8 @@ subroutine set_grid_metrics(G, param_file, US) end select if (G%Rad_Earth_L <= 0.0) then ! The grid metrics were set with an option that does not explicitly initialize Rad_Earth. - ! ### Rad_Earth should be read as in: - ! call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & - ! "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) - ! but for now it is being set via a hard-coded value to reproduce current behavior. - G%Rad_Earth_L = 6.378e6*US%m_to_L + call get_param(param_file, "MOM_grid_init", "RAD_EARTH", G%Rad_Earth_L, & + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) endif G%Rad_Earth = US%L_to_m*G%Rad_Earth_L @@ -170,20 +167,15 @@ end subroutine grid_metrics_chksum subroutine set_grid_metrics_from_mosaic(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + ! Local variables - ! These arrays are a holdover from earlier code in which the arrays in G were - ! macros and may have had reduced dimensions. - real, dimension(G%isd :G%ied ,G%jsd :G%jed ) :: dxT, dyT, areaT - real, dimension(G%IsdB:G%IedB,G%jsd :G%jed ) :: dxCu, dyCu - real, dimension(G%isd :G%ied ,G%JsdB:G%JedB) :: dxCv, dyCv - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: dxBu, dyBu, areaBu - ! This are symmetric arrays, corresponding to the data in the mosaic file - real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-2:2*G%jed+1) :: tmpT - real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-2:2*G%jed+1) :: tmpU - real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV - real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ - real, dimension(:,:), allocatable :: tmpGlbl + ! These are symmetric arrays, corresponding to the data in the mosaic file + real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-2:2*G%jed+1) :: tmpT ! Areas [L2 ~> m2] + real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-2:2*G%jed+1) :: tmpU ! East face supergrid spacing [L ~> m] + real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV ! North face supergrid spacing [L ~> m] + real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ ! Corner latitudes or longitudes [degN] or [degE] + real, dimension(:,:), allocatable :: tmpGlbl ! A global array of axis labels character(len=200) :: filename, grid_file, inputdir character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" type(MOM_domain_type), pointer :: SGdom => NULL() ! Supergrid domain @@ -208,11 +200,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) call MOM_error(FATAL," set_grid_metrics_from_mosaic: Unable to open "//& trim(filename)) - ! Initialize everything to 0. - dxCu(:,:) = 0.0 ; dyCu(:,:) = 0.0 - dxCv(:,:) = 0.0 ; dyCv(:,:) = 0.0 - dxBu(:,:) = 0.0 ; dyBu(:,:) = 0.0 ; areaBu(:,:) = 0.0 - ! call clone_MOM_domain(G%domain, SGdom, symmetric=.true., domain_name="MOM_MOSAIC", & @@ -264,69 +251,56 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) ! Read DX,DY from the supergrid tmpU(:,:) = 0. ; tmpV(:,:) = 0. - call MOM_read_data(filename,'dx',tmpV,SGdom,position=NORTH_FACE) - call MOM_read_data(filename,'dy',tmpU,SGdom,position=EAST_FACE) + call MOM_read_data(filename, 'dx', tmpV, SGdom, position=NORTH_FACE, scale=US%m_to_L) + call MOM_read_data(filename, 'dy', tmpU, SGdom, position=EAST_FACE, scale=US%m_to_L) call pass_vector(tmpU, tmpV, SGdom, To_All+Scalar_Pair, CGRID_NE) call extrapolate_metric(tmpV, 2*(G%jsc-G%jsd)+2, missing=0.) call extrapolate_metric(tmpU, 2*(G%jsc-G%jsd)+2, missing=0.) do j=G%jsd,G%jed ; do i=G%isd,G%ied ; i2 = 2*i ; j2 = 2*j - dxT(i,j) = tmpV(i2-1,j2-1) + tmpV(i2,j2-1) - dyT(i,j) = tmpU(i2-1,j2-1) + tmpU(i2-1,j2) + G%dxT(i,j) = tmpV(i2-1,j2-1) + tmpV(i2,j2-1) + G%dyT(i,j) = tmpU(i2-1,j2-1) + tmpU(i2-1,j2) enddo ; enddo do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB ; i2 = 2*i ; j2 = 2*j - dxCu(I,j) = tmpV(i2,j2-1) + tmpV(i2+1,j2-1) - dyCu(I,j) = tmpU(i2,j2-1) + tmpU(i2,j2) + G%dxCu(I,j) = tmpV(i2,j2-1) + tmpV(i2+1,j2-1) + G%dyCu(I,j) = tmpU(i2,j2-1) + tmpU(i2,j2) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied ; i2 = 2*i ; j2 = 2*j - dxCv(i,J) = tmpV(i2-1,j2) + tmpV(i2,j2) - dyCv(i,J) = tmpU(i2-1,j2) + tmpU(i2-1,j2+1) + G%dxCv(i,J) = tmpV(i2-1,j2) + tmpV(i2,j2) + G%dyCv(i,J) = tmpU(i2-1,j2) + tmpU(i2-1,j2+1) enddo ; enddo do J=G%JsdB,G%JedB ; do I=G%IsdB,G%IedB ; i2 = 2*i ; j2 = 2*j - dxBu(I,J) = tmpV(i2,j2) + tmpV(i2+1,j2) - dyBu(I,J) = tmpU(i2,j2) + tmpU(i2,j2+1) + G%dxBu(I,J) = tmpV(i2,j2) + tmpV(i2+1,j2) + G%dyBu(I,J) = tmpU(i2,j2) + tmpU(i2,j2+1) enddo ; enddo ! Read AREA from the supergrid tmpT(:,:) = 0. - call MOM_read_data(filename, 'area', tmpT, SGdom) + call MOM_read_data(filename, 'area', tmpT, SGdom, scale=US%m_to_L**2) call pass_var(tmpT, SGdom) call extrapolate_metric(tmpT, 2*(G%jsc-G%jsd)+2, missing=0.) do j=G%jsd,G%jed ; do i=G%isd,G%ied ; i2 = 2*i ; j2 = 2*j - areaT(i,j) = (tmpT(i2-1,j2-1) + tmpT(i2,j2)) + & - (tmpT(i2-1,j2) + tmpT(i2,j2-1)) + G%areaT(i,j) = (tmpT(i2-1,j2-1) + tmpT(i2,j2)) + & + (tmpT(i2-1,j2) + tmpT(i2,j2-1)) enddo ; enddo do J=G%JsdB,G%JedB ; do I=G%IsdB,G%IedB ; i2 = 2*i ; j2 = 2*j - areaBu(I,J) = (tmpT(i2,j2) + tmpT(i2+1,j2+1)) + & - (tmpT(i2,j2+1) + tmpT(i2+1,j2)) + G%areaBu(I,J) = (tmpT(i2,j2) + tmpT(i2+1,j2+1)) + & + (tmpT(i2,j2+1) + tmpT(i2+1,j2)) enddo ; enddo ni = SGdom%niglobal nj = SGdom%njglobal call deallocate_MOM_domain(SGdom) - call pass_vector(dyCu, dxCv, G%Domain, To_All+Scalar_Pair, CGRID_NE) - call pass_vector(dxCu, dyCv, G%Domain, To_All+Scalar_Pair, CGRID_NE) - call pass_vector(dxBu, dyBu, G%Domain, To_All+Scalar_Pair, BGRID_NE) - call pass_var(areaT, G%Domain) - call pass_var(areaBu, G%Domain, position=CORNER) - - do i=G%isd,G%ied ; do j=G%jsd,G%jed - G%dxT(i,j) = US%m_to_L*dxT(i,j) ; G%dyT(i,j) = US%m_to_L*dyT(i,j) ; G%areaT(i,j) = US%m_to_L**2*areaT(i,j) - enddo ; enddo - do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed - G%dxCu(I,j) = US%m_to_L*dxCu(I,j) ; G%dyCu(I,j) = US%m_to_L*dyCu(I,j) - enddo ; enddo - do i=G%isd,G%ied ; do J=G%JsdB,G%JedB - G%dxCv(i,J) = US%m_to_L*dxCv(i,J) ; G%dyCv(i,J) = US%m_to_L*dyCv(i,J) - enddo ; enddo - do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB - G%dxBu(I,J) = US%m_to_L*dxBu(I,J) ; G%dyBu(I,J) = US%m_to_L*dyBu(I,J) ; G%areaBu(I,J) = US%m_to_L**2*areaBu(I,J) - enddo ; enddo + call pass_vector(G%dyCu, G%dxCv, G%Domain, To_All+Scalar_Pair, CGRID_NE) + call pass_vector(G%dxCu, G%dyCv, G%Domain, To_All+Scalar_Pair, CGRID_NE) + call pass_vector(G%dxBu, G%dyBu, G%Domain, To_All+Scalar_Pair, BGRID_NE) + call pass_var(G%areaT, G%Domain) + call pass_var(G%areaBu, G%Domain, position=CORNER) ! Construct axes for diagnostic output (only necessary because "ferret" uses ! broken convention for interpretting netCDF files). From 9a604d4670a262288cd259ac5083d16ab23791b7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 20 May 2022 07:14:49 -0400 Subject: [PATCH 25/68] (*)Fix occasional bug with PFv_visc_rem diagnostic Corrected a bug that causes the bottom-drag filtered meridional acceleration diagnostics, like PFv_visc_rem, to erroneously be filled with all zeros unless one of the filtered u-point diagnostics is also enabled in the diag_table, and conversely could lead to segmentation fault if there are are only filtered u-point diagnostics. However, if at least one of both kinds of diagnostics are enabled, everything was already working as intended. Also changed a call to enabled_averaging into a call to enable_averages to avoid having to scale an argument. All solutions are bitwise identical, and in many cases the diagnostics are also unchanged. --- src/core/MOM_barotropic.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 7f91428c94..6c13fa8af0 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -6,7 +6,7 @@ module MOM_barotropic use MOM_debugging, only : hchksum, uvchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field -use MOM_diag_mediator, only : diag_ctrl, enable_averaging +use MOM_diag_mediator, only : diag_ctrl, enable_averaging, enable_averages use MOM_domains, only : min_across_PEs, clone_MOM_domain, deallocate_MOM_domain use MOM_domains, only : To_All, Scalar_Pair, AGRID, CORNER, MOM_domain_type use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type @@ -2351,7 +2351,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (do_hifreq_output) then time_step_end = time_bt_start + real_to_time(n*US%T_to_s*dtbt) - call enable_averaging(US%T_to_s*dtbt, time_step_end, CS%diag) + call enable_averages(dtbt, time_step_end, CS%diag) if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag) if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag) if (CS%id_eta_hifreq > 0) call post_data(CS%id_eta_hifreq, eta(isd:ied,jsd:jed), CS%diag) @@ -2711,7 +2711,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ADp%visc_rem_u(I,j,k) = visc_rem_u(I,j,k) enddo ; enddo ; enddo endif - if (associated(ADp%visc_rem_u)) then + if (associated(ADp%visc_rem_v)) then do k=1,nz ; do J=js-1,je ; do i=is,ie ADp%visc_rem_v(i,J,k) = visc_rem_v(i,J,k) enddo ; enddo ; enddo From 27bb8b8336ee565c4da53478fb2d6481f93ae3e7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 29 May 2022 06:46:59 -0400 Subject: [PATCH 26/68] (*)Corrected OBC restart scaling bugs Corrected two bugs in the code handling the unscaling of tracers in east-west open boundary segments. Both changes bring the east-west code into (closer?) agreement with the north-south code, and it might explain some recent reports of strange behavior. However, the fact that the existing MOM6-examples pipeline tests do not detect this bug reveals a clear shortcoming in the suite of test cases with OBCs that are currently being testing with MOM6 code changes. These bugs were introduced to dev/gfdl on May 22, 2022 (one week before this fix) as a part of PR# 122 (https://github.com/NOAA-GFDL/MOM6/pull/122). --- src/core/MOM_open_boundary.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index b449e7c9a5..768c234bae 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2010,6 +2010,7 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) if (segment%is_E_or_W) then I = segment%HI%IsdB do m=1,OBC%ntr + I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed @@ -5013,7 +5014,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & (u_L_out*Reg%Tr(m)%t(I+ishift,j,k) - & u_L_in*segment%tr_Reg%Tr(m)%t(I,j,k))) - if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) + if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k) enddo ; endif enddo enddo From 203a19f485cf13c43b75783cbd0ca8fcf717d21f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 29 May 2022 07:05:37 -0400 Subject: [PATCH 27/68] Fix a rescaling bug with MEKE_EQUILIBRIUM_ALT Corrected a bug in a dimensional rescaling factor that will cause test cases using MEKE with MEKE_EQUILIBRIUM_ALT = True to fail dimensional consistency testing. However, answers are unchanged when no rescaling is used. This minor bug has been in the code since the MEKE_EQUILIBRIUM_ALT was first introduced in 2019. All answers in the existing MOM6-examples test suite are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index bde8632170..1cd20d3c96 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -721,7 +721,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) if (CS%MEKE_equilibrium_alt) then - MEKE%MEKE(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_m*depth_tot(i,j))**2 / cd2 + MEKE%MEKE(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2 else FatH = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1))) ! Coriolis parameter at h points From 37782ebbc4af5dfbec1f41d43cfcab0b8545bb9e Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 31 May 2022 17:43:34 -0400 Subject: [PATCH 28/68] Fixes badge for doc build status - url was pointing to "latest" which is not a version. Pointing to "main" instead. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 46774baaf0..17b0a3661c 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -[![Read The Docs Status](https://readthedocs.org/projects/mom6/badge/?badge=latest)](http://mom6.readthedocs.io/) +[![Read The Docs Status](https://readthedocs.org/projects/mom6/badge/?version=main)](https://mom6.readthedocs.io/en/main/?badge=main) [![codecov](https://codecov.io/gh/NOAA-GFDL/MOM6/branch/dev/gfdl/graph/badge.svg?token=uF8SVydCdp)](https://codecov.io/gh/NOAA-GFDL/MOM6) # MOM6 From 1ad842cdb4b232178da3b6c2108d62b3c815a333 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 1 Jun 2022 16:57:22 -0400 Subject: [PATCH 29/68] Replace findloc() with user-defined find_index This patch replaces the instances of findloc() with a new function, find_index. They should be functionally equivalent. findloc() is a F2008 intrinsic which returns the index of the first instance of a value in an array. Support is still spotty on some older compilers in active use, so this function is the safer alternative. --- config_src/infra/FMS2/MOM_io_infra.F90 | 29 ++++++++++++++++++++++---- 1 file changed, 25 insertions(+), 4 deletions(-) diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index eb616dffa3..c815f2a227 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -659,10 +659,10 @@ subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain) ! Currently no z-test is supported, so disable assignment with 0 size_indices = [ & - findloc(is_x, .true.), & - findloc(is_y, .true.), & + find_index(is_x, .true.), & + find_index(is_y, .true.), & 0, & - findloc(is_t, .true.) & + find_index(is_t, .true.) & ] do i = 1, size(size_indices) @@ -684,9 +684,30 @@ subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain) else call field_size(filename, fieldname, sizes, field_found=field_found, no_domain=no_domain) endif - end subroutine get_field_size + +!> Return the index of the first True element of a logical array. +!! +!! If all elements are false, return zero. +integer function find_index(vec) result(idx) + ! NOTE: This function acts as a replacement for findloc() F2008 intrinsic, + ! which is not available on some compilers, or may not support logicals. + integer, intent(in) :: vec(:) + integer :: idx + + integer :: loc + + loc = 0 + do i = 1, size(vec) + if (vec(i)) then + loc = i + exit + endif + enddo +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 From 4a6a175caaf1476a93d7485136b38fc428cf4308 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 2 Jun 2022 15:35:14 -0400 Subject: [PATCH 30/68] Bugfix: find_index in FMS2 infra This patch fixes two major bugs in the find_index function: * Incorrect variable declarations have been fixed * The API is now followed, and assumes that it's looking for .true. Obviously the previous patch had not been tested with the FMS2 infra or a compatible FMS library. This was has been checked against FMS 2022.02. --- config_src/infra/FMS2/MOM_io_infra.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index c815f2a227..c8c55524f8 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -659,10 +659,10 @@ subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain) ! Currently no z-test is supported, so disable assignment with 0 size_indices = [ & - find_index(is_x, .true.), & - find_index(is_y, .true.), & + find_index(is_x), & + find_index(is_y), & 0, & - find_index(is_t, .true.) & + find_index(is_t) & ] do i = 1, size(size_indices) @@ -690,14 +690,14 @@ end subroutine get_field_size !> Return the index of the first True element of a logical array. !! !! If all elements are false, return zero. -integer function find_index(vec) result(idx) +function find_index(vec) result(loc) ! NOTE: This function acts as a replacement for findloc() F2008 intrinsic, ! which is not available on some compilers, or may not support logicals. - integer, intent(in) :: vec(:) - integer :: idx - + logical, intent(in) :: vec(:) integer :: loc + integer :: i + loc = 0 do i = 1, size(vec) if (vec(i)) then From 95119a251312c4168a601d8682cb552a891e78eb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 16 May 2022 04:44:43 -0400 Subject: [PATCH 31/68] (*)Fix ice shelf dimensional rescaling bugs Fixed two minor bugs in the ice-shelf code that impede its performance when dimensional scaling is used. - Report rescaling factors of 1 in the ice shelf restart files, now that the variables are rescaled before being written to the restart files. Without this change, certain runs with enabled ice shelf capabilities will not reproduce across restarts when dimensional rescaling is enabled. - Pass the unit scaling type to the EOS_init call. Without this change, cases with an active ice shelf will not pass dimensional rescaling tests if there is a nonlinear equation of state. All answers are bitwise identical without dimensional rescaling or an active ice shelf, but in some cases answers will be changed so that now the code will pass some reproducibility tests. --- src/ice_shelf/MOM_ice_shelf.F90 | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index a1766e7805..c9e83336b7 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1556,7 +1556,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, CS%utide(:,:) = utide endif - call EOS_init(param_file, CS%eqn_of_state) + call EOS_init(param_file, CS%eqn_of_state, US) !! new parameters that need to be in MOM_input @@ -1768,11 +1768,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, call hchksum(ISS%area_shelf_h, "IS init: area_shelf_h", G%HI, haloshift=0, scale=US%L_to_m*US%L_to_m) endif - - CS%Time = Time - if (CS%active_shelf_dynamics .and. .not.CS%isthermo) then ISS%water_flux(:,:) = 0.0 endif @@ -1780,7 +1777,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, if (shelf_mass_is_dynamic) & call initialize_ice_shelf_dyn(param_file, Time, ISS, CS%dCS, G, US, CS%diag, new_sim, solo_ice_sheet_in) - call fix_restart_unit_scaling(US) + call fix_restart_unit_scaling(US, unscaled=.true.) call get_param(param_file, mdl, "SAVE_INITIAL_CONDS", save_IC, & "If true, save the ice shelf initial conditions.", default=.false.) @@ -1794,7 +1791,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, filename=IC_file, write_ic=.true.) endif - CS%id_area_shelf_h = register_diag_field('ice_shelf_model', 'area_shelf_h', CS%diag%axesT1, CS%Time, & 'Ice Shelf Area in cell', 'meter-2', conversion=US%L_to_m**2) CS%id_shelf_mass = register_diag_field('ice_shelf_model', 'shelf_mass', CS%diag%axesT1, CS%Time, & From ec889238358f2d303293ab50f2d8cb5fe6fb5b38 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 22 May 2022 06:31:51 -0400 Subject: [PATCH 32/68] Rescale ice shelf temperatures Applied dimensional rescaling of all of the ice shelf temperature and salinity variables that could be modified without requiring any changes at the driver level. There is a new unit_scale_type argument to MOM_IS_diag_mediator_init, mirroring what is done in MOM_diag_mediator_init. This commit also includes changing the initial values in the stencil array from -1 to 0, but this initialization appears to be unnecessary. A large number of comments were added, corrected, or modified. All answers in the test cases are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 155 +++++++++--------- src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 | 19 ++- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 76 ++++----- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 1 - src/ice_shelf/MOM_ice_shelf_state.F90 | 2 +- src/ice_shelf/user_shelf_init.F90 | 9 +- 6 files changed, 136 insertions(+), 126 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index c9e83336b7..8c2f7dd4c9 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -16,7 +16,7 @@ module MOM_ice_shelf use MOM_IS_diag_mediator, only : set_IS_axes_info, diag_ctrl, time_type use MOM_IS_diag_mediator, only : MOM_IS_diag_mediator_init, MOM_IS_diag_mediator_end use MOM_IS_diag_mediator, only : set_IS_diag_mediator_grid -use MOM_IS_diag_mediator, only : enable_averages, enable_averaging, disable_averaging +use MOM_IS_diag_mediator, only : enable_averages, disable_averaging use MOM_IS_diag_mediator, only : MOM_IS_diag_mediator_infrastructure_init use MOM_IS_diag_mediator, only : MOM_IS_diag_mediator_close_registration use MOM_domains, only : MOM_domains_init, pass_var, pass_vector, clone_MOM_domain @@ -112,13 +112,13 @@ module MOM_ice_shelf !! have no limit [Z T-1 ~> m s-1]. real :: cdrag !< drag coefficient under ice shelves [nondim]. real :: g_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] - real :: Cp !< The heat capacity of sea water [Q degC-1 ~> J kg-1 degC-1]. + real :: Cp !< The heat capacity of sea water [Q C-1 ~> J kg-1 degC-1]. real :: Rho_ocn !< A reference ocean density [R ~> kg m-3]. - real :: Cp_ice !< The heat capacity of fresh ice [Q degC-1 ~> J kg-1 degC-1]. + real :: Cp_ice !< The heat capacity of fresh ice [Q C-1 ~> J kg-1 degC-1]. real :: gamma_t !< The (fixed) turbulent exchange velocity in the !< 2-equation formulation [Z T-1 ~> m s-1]. - real :: Salin_ice !< The salinity of shelf ice [ppt]. - real :: Temp_ice !< The core temperature of shelf ice [degC]. + real :: Salin_ice !< The salinity of shelf ice [S ~> ppt]. + real :: Temp_ice !< The core temperature of shelf ice [C ~> degC]. real :: kv_ice !< The viscosity of ice [L4 Z-2 T-1 ~> m2 s-1]. real :: density_ice !< A typical density of ice [R ~> kg m-3]. real :: kv_molec !< The molecular kinematic viscosity of sea water [Z2 T-1 ~> m2 s-1]. @@ -151,15 +151,14 @@ module MOM_ice_shelf !! should be exclusive) logical :: calve_to_mask !< If true, calve any ice that passes outside of a masked area real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving [Z ~> m]. - real :: T0 !< temperature at ocean surface in the restoring region [degC] - real :: S0 !< Salinity at ocean surface in the restoring region [ppt]. + real :: T0 !< temperature at ocean surface in the restoring region [C ~> degC] + real :: S0 !< Salinity at ocean surface in the restoring region [S ~> ppt]. real :: input_flux !< The vertically integrated inward ice thickness flux per !! unit face length at an upstream boundary [Z L T-1 ~> m2 s-1] real :: input_thickness !< Ice thickness at an upstream open boundary [Z ~> m]. type(time_type) :: Time !< The component's time. - type(EOS_type) :: eqn_of_state !< Type that indicates the - !! equation of state to use. + type(EOS_type) :: eqn_of_state !< Type that indicates the equation of state to use. logical :: active_shelf_dynamics !< True if the ice shelf mass changes as a result !! the dynamic ice-shelf model. logical :: data_override_shelf_fluxes !< True if the ice shelf surface mass fluxes can be @@ -180,10 +179,11 @@ module MOM_ice_shelf !! is used [R Z ~> kg m-2] real :: cutoff_depth !< Depth above which melt is set to zero (>= 0) [Z ~> m]. logical :: find_salt_root !< If true, if true find Sbdry using a quadratic eq. - real :: TFr_0_0 !< The freezing point at 0 pressure and 0 salinity [degC] - real :: dTFr_dS !< Partial derivative of freezing temperature with salinity [degC ppt-1] + real :: TFr_0_0 !< The freezing point at 0 pressure and 0 salinity [C ~> degC] + real :: dTFr_dS !< Partial derivative of freezing temperature with + !! salinity [C S-1 ~> degC ppt-1] real :: dTFr_dp !< Partial derivative of freezing temperature with - !! pressure [degC T2 R-1 L-2 ~> degC Pa-1] + !! pressure [C T2 R-1 L-2 ~> degC Pa-1] !>@{ Diagnostic handles integer :: id_melt = -1, id_exch_vel_s = -1, id_exch_vel_t = -1, & id_tfreeze = -1, id_tfl_shelf = -1, & @@ -219,14 +219,14 @@ module MOM_ice_shelf !> Calculates fluxes between the ocean and ice-shelf using the three-equations !! formulation (optional to use just two equations). !! See \ref section_ICE_SHELF_equations -subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) +subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) type(surface), target, intent(inout) :: sfc_state_in !< A structure containing fields that !! describe the surface state of the ocean. The !! intent is only inout to allow for halo updates. type(forcing), target, intent(inout) :: fluxes_in !< structure containing pointers to any !! possible thermodynamic or mass-flux forcing fields. type(time_type), intent(in) :: Time !< Start time of the fluxes. - real, intent(in) :: time_step !< Length of time over which these fluxes + real, intent(in) :: time_step_in !< Length of time over which these fluxes !! will be applied [s]. type(ice_shelf_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to initialize_ice_shelf. @@ -257,8 +257,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) mass_flux !< Total mass flux of freshwater across the ice-ocean interface. [R Z L2 T-1 ~> kg s-1] real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & haline_driving !< (SSS - S_boundary) ice-ocean - !! interface, positive for melting and negative for freezing [ppt]. + !! interface, positive for melting and negative for freezing [S ~> ppt]. !! 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, parameter :: VK = 0.40 !< Von Karman's constant - dimensionless real :: ZETA_N = 0.052 !> The fraction of the boundary layer over which the !! viscosity is linearly increasing [nondim]. (Was 1/8. Why?) @@ -270,34 +271,35 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) ! 3 equations formulation variables real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & - Sbdry !< Salinities in the ocean at the interface with the ice shelf [ppt]. - real :: Sbdry_it - real :: Sbdry1, Sbdry2 - real :: S_a, S_b, S_c ! Variables used to find salt roots - real :: dS_it !< The interface salinity change during an iteration [ppt]. + Sbdry !< Salinities in the ocean at the interface with the ice shelf [S ~> ppt]. + real :: Sbdry_it ! The boundary salinity at an iteration [S ~> ppt] + real :: S_a ! A variable used to find salt roots [S-1 ~> ppt-1] + real :: S_b ! A variable used to find salt roots [nondim] + real :: S_c ! A variable used to find salt roots [S ~> ppt] + real :: dS_it !< The interface salinity change during an iteration [S ~> ppt]. real :: hBL_neut !< The neutral boundary layer thickness [Z ~> m]. real :: hBL_neut_h_molec !< The ratio of the neutral boundary layer thickness !! to the molecular boundary layer thickness [nondim]. - real :: wT_flux !< The downward vertical flux of heat just inside the ocean [degC Z T-1 ~> degC m s-1]. + real :: wT_flux !< The downward vertical flux of heat just inside the ocean [C Z T-1 ~> degC m s-1]. 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 ppt-1 ~> m s-2 ppt-1]. - real :: dB_dT !< The derivative of buoyancy with temperature [Z T-2 degC-1 ~> m s-2 degC-1]. + 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 :: 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] real :: dT_ustar ! The difference between the the freezing point and the ocean boundary layer - ! temperature times the friction velocity [degC Z T-1 ~> degC m s-1] + ! temperature times the friction velocity [C Z T-1 ~> degC m s-1] real :: dS_ustar ! The difference between the salinity at the ice-ocean interface and the ocean - ! boundary layer salinity times the friction velocity [ppt Z T-1 ~> ppt m s-1] + ! 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_mol_t, Gam_mol_s ! Relative coefficients of molecular diffusivites [nondim] - real :: RhoCp ! A typical ocean density times the heat capacity of water [Q R ~> J m-3] + 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 :: mass_exch ! A mass exchange rate [R Z T-1 ~> kg m-2 s-1] - real :: Sb_min, Sb_max - real :: dS_min, dS_max + 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 @@ -324,6 +326,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) G => CS%grid ; US => CS%US ISS => CS%ISS + time_step = US%s_to_T*time_step_in if (CS%data_override_shelf_fluxes .and. CS%active_shelf_dynamics) then call data_override(G%Domain, 'shelf_sfc_mass_flux', fluxes_in%shelf_sfc_mass_flux, CS%Time, & @@ -362,13 +365,13 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) ISS%salt_flux(:,:) = 0.0 ; ISS%tflux_ocn(:,:) = 0.0 ; ISS%tfreeze(:,:) = 0.0 ! define Sbdry to avoid Run-Time Check Failure, when melt is not computed. haline_driving(:,:) = 0.0 - Sbdry(:,:) = sfc_state%sss(:,:) + Sbdry(:,:) = US%ppt_to_S*sfc_state%sss(:,:) !update time CS%Time = Time if (CS%override_shelf_movement) then - CS%time_step = US%s_to_T*time_step + CS%time_step = time_step ! update shelf mass if (CS%mass_from_file) call update_shelf_mass(G, US, CS, ISS, Time) endif @@ -451,8 +454,8 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) hBL_neut_h_molec = ZETA_N * ((hBL_neut * ustar_h) / (5.0 * CS%kv_molec)) ! Determine the mixed layer buoyancy flux, wB_flux. - dB_dS = (US%L_to_Z**2*CS%g_Earth / Rhoml(i)) * US%ppt_to_S*dR0_dS(i) - dB_dT = (US%L_to_Z**2*CS%g_Earth / Rhoml(i)) * US%degC_to_C*dR0_dT(i) + 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 @@ -463,9 +466,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) ! S_a is always < 0.0 with a realistic expression for the freezing point. S_a = CS%dTFr_dS * CS%Gamma_T_3EQ * CS%Cp - S_b = CS%Gamma_T_3EQ*CS%Cp*(CS%TFr_0_0 + CS%dTFr_dp*p_int(i) - sfc_state%sst(i,j)) - & + S_b = CS%Gamma_T_3EQ*CS%Cp*(CS%TFr_0_0 + CS%dTFr_dp*p_int(i) - US%degC_to_C*sfc_state%sst(i,j)) - & CS%Lat_fusion * CS%Gamma_S_3EQ ! S_b Can take either sign, but is usually negative. - S_c = CS%Lat_fusion * CS%Gamma_S_3EQ * sfc_state%sss(i,j) ! Always >= 0 + S_c = CS%Lat_fusion * CS%Gamma_S_3EQ * US%ppt_to_S*sfc_state%sss(i,j) ! Always >= 0 if (S_c == 0.0) then ! The solution for fresh water. Sbdry(i,j) = 0.0 @@ -483,25 +486,25 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) ! Safety check if (Sbdry(i,j) < 0.) then - write(mesg,*) 'sfc_state%sss(i,j) = ',sfc_state%sss(i,j), 'S_a, S_b, S_c', S_a, S_b, S_c - call MOM_error(WARNING, mesg, .true.) - write(mesg,*) 'I,J,Sbdry1,Sbdry2',i,j,Sbdry1,Sbdry2 + write(mesg,*) 'sfc_state%sss(i,j) = ',sfc_state%sss(i,j), & + 'S_a, S_b, S_c', US%ppt_to_S*S_a, S_b, US%S_to_ppt*S_c call MOM_error(WARNING, mesg, .true.) call MOM_error(FATAL, "shelf_calc_flux: Negative salinity (Sbdry).") endif else ! Guess sss as the iteration starting point for the boundary salinity. - Sbdry(i,j) = sfc_state%sss(i,j) ; Sb_max_set = .false. + Sbdry(i,j) = US%ppt_to_S*sfc_state%sss(i,j) ; Sb_max_set = .false. Sb_min_set = .false. endif !find_salt_root do it1 = 1,20 ! Determine the potential temperature at the ice-ocean interface. - call calculate_TFreeze(Sbdry(i,j), p_int(i), ISS%tfreeze(i,j), CS%eqn_of_state, & - pres_scale=US%RL2_T2_to_Pa) + ! The following two lines are equivalent: + ! call calculate_TFreeze(Sbdry(i,j), p_int(i), ISS%tfreeze(i,j), CS%eqn_of_state, scale_from_EOS=.true.) + call calculate_TFreeze(Sbdry(i:i,j), p_int(i:i), ISS%tfreeze(i:i,j), CS%eqn_of_state) - 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 + dT_ustar = (ISS%tfreeze(i,j) - US%degC_to_C*sfc_state%sst(i,j)) * ustar_h + dS_ustar = (Sbdry(i,j) - US%ppt_to_S*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 @@ -607,10 +610,10 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) else mass_exch = exch_vel_s(i,j) * CS%Rho_ocn - Sbdry_it = (sfc_state%sss(i,j) * mass_exch + CS%Salin_ice * ISS%water_flux(i,j)) / & + Sbdry_it = (US%ppt_to_S*sfc_state%sss(i,j) * mass_exch + CS%Salin_ice * ISS%water_flux(i,j)) / & (mass_exch + ISS%water_flux(i,j)) dS_it = Sbdry_it - Sbdry(i,j) - if (abs(dS_it) < 1.0e-4*(0.5*(sfc_state%sss(i,j) + Sbdry(i,j) + 1.0e-10))) exit + if (abs(dS_it) < 1.0e-4*(0.5*(US%ppt_to_S*sfc_state%sss(i,j) + Sbdry(i,j) + 1.0e-10*US%ppt_to_S))) exit if (dS_it < 0.0) then ! Sbdry is now the upper bound. @@ -644,12 +647,12 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) ! In the 2-equation form, the mixed layer turbulent exchange velocity ! is specified and large enough that the ocean salinity at the interface ! is about the same as the boundary layer salinity. - - call calculate_TFreeze(sfc_state%sss(i,j), p_int(i), ISS%tfreeze(i,j), CS%eqn_of_state, & - pres_scale=US%RL2_T2_to_Pa) + ! The following two lines are equivalent: + ! call calculate_TFreeze(Sbdry(i,j), p_int(i), ISS%tfreeze(i,j), CS%eqn_of_state, scale_from_EOS=.true.) + call calculate_TFreeze(US%ppt_to_S*sfc_state%SSS(i:i,j), p_int(i:i), ISS%tfreeze(i:i,j), CS%eqn_of_state) exch_vel_t(i,j) = CS%gamma_t - ISS%tflux_ocn(i,j) = RhoCp * exch_vel_t(i,j) * (ISS%tfreeze(i,j) - sfc_state%sst(i,j)) + ISS%tflux_ocn(i,j) = RhoCp * exch_vel_t(i,j) * (ISS%tfreeze(i,j) - US%degC_to_C*sfc_state%sst(i,j)) ISS%tflux_shelf(i,j) = 0.0 ISS%water_flux(i,j) = -I_LF * ISS%tflux_ocn(i,j) Sbdry(i,j) = 0.0 @@ -660,7 +663,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) ISS%tflux_ocn(i,j) = 0.0 endif -! haline_driving(i,j) = sfc_state%sss(i,j) - Sbdry(i,j) +! haline_driving(i,j) = US%ppt_to_S*sfc_state%sss(i,j) - Sbdry(i,j) enddo ! i-loop enddo ! j-loop @@ -684,11 +687,11 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) !!!!!!!!!!!!!!!!!!!!!!!!!!!!Safety checks !!!!!!!!!!!!!!!!!!!!!!!!! !1)Check if haline_driving computed above is consistent with - ! haline_driving = sfc_state%sss - Sbdry + ! haline_driving = US%ppt_to_S*sfc_state%sss - Sbdry !if (fluxes%iceshelf_melt(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',haline_driving(i,j), & - ! (sfc_state%sss(i,j) - Sbdry(i,j)) + ! if (haline_driving(i,j) /= (US%ppt_to_S*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*(US%ppt_to_S*sfc_state%sss(i,j) - Sbdry(i,j)) ! call MOM_error(FATAL, & ! "shelf_calc_flux: Inconsistency in melt and haline_driving"//trim(mesg)) ! endif @@ -721,7 +724,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) ! Melting has been computed, now is time to update thickness and mass if ( CS%override_shelf_movement .and. (.not.CS%mass_from_file)) then - call change_thickness_using_melt(ISS, G, US, US%s_to_T*time_step, fluxes, CS%density_ice, CS%debug) + call change_thickness_using_melt(ISS, G, US, time_step, fluxes, CS%density_ice, CS%debug) if (CS%debug) then call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0, scale=US%Z_to_m) @@ -732,7 +735,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) ! Melting has been computed, now is time to update thickness and mass with dynamic ice shelf if (CS%active_shelf_dynamics) then - call change_thickness_using_melt(ISS, G, US, US%s_to_T*time_step, fluxes, CS%density_ice, CS%debug) + call change_thickness_using_melt(ISS, G, US, time_step, fluxes, CS%density_ice, CS%debug) if (CS%debug) then call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0, scale=US%Z_to_m) @@ -740,7 +743,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) scale=US%RZ_to_kg_m2) endif - call change_thickness_using_precip(CS, ISS, G, US, fluxes, US%s_to_T*time_step, Time) + call change_thickness_using_precip(CS, ISS, G, US, fluxes, time_step, Time) if (CS%debug) then call hchksum(ISS%h_shelf, "h_shelf after change thickness using surf acc", G%HI, haloshift=0, scale=US%Z_to_m) @@ -762,19 +765,19 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) ! advect the ice shelf, and advance the front. Calving will be in here somewhere as well.. ! when we decide on how to do it - call update_ice_shelf(CS%dCS, ISS, G, US, US%s_to_T*time_step, Time, & + call update_ice_shelf(CS%dCS, ISS, G, US, time_step, Time, & sfc_state%ocean_mass, coupled_GL) endif - call enable_averaging(time_step,Time,CS%diag) + call enable_averages(time_step, Time, CS%diag) if (CS%id_shelf_mass > 0) call post_data(CS%id_shelf_mass, ISS%mass_shelf, CS%diag) if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) if (CS%id_ustar_shelf > 0) call post_data(CS%id_ustar_shelf, fluxes%ustar_shelf, CS%diag) if (CS%id_shelf_sfc_mass_flux > 0) call post_data(CS%id_shelf_sfc_mass_flux, fluxes%shelf_sfc_mass_flux, CS%diag) if (CS%id_melt > 0) call post_data(CS%id_melt, fluxes%iceshelf_melt, CS%diag) - if (CS%id_thermal_driving > 0) call post_data(CS%id_thermal_driving, (sfc_state%sst-ISS%tfreeze), CS%diag) + if (CS%id_thermal_driving > 0) call post_data(CS%id_thermal_driving,(US%degC_to_C*sfc_state%sst-ISS%tfreeze), CS%diag) if (CS%id_Sbdry > 0) call post_data(CS%id_Sbdry, Sbdry, CS%diag) if (CS%id_haline_driving > 0) call post_data(CS%id_haline_driving, haline_driving, CS%diag) if (CS%id_mass_flux > 0) call post_data(CS%id_mass_flux, mass_flux, CS%diag) @@ -1178,7 +1181,7 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes) ! evap is negative, and vprec has units of [R Z T-1 ~> kg m-2 s-1] fluxes%vprec(i,j) = -balancing_flux fluxes%sens(i,j) = fluxes%vprec(i,j) * CS%Cp * CS%T0 ! [Q R Z T-1 ~> W m-2] - fluxes%salt_flux(i,j) = fluxes%vprec(i,j) * CS%S0*1.0e-3 ! [kgSalt/kg R Z T-1 ~> kgSalt m-2 s-1] + fluxes%salt_flux(i,j) = fluxes%vprec(i,j) * CS%S0*1.0e-3*US%S_to_ppt ! [1e-3 S R Z T-1 ~> kgSalt m-2 s-1] endif enddo ; enddo @@ -1328,7 +1331,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, G => CS%Grid ; CS%Grid_in => CS%Grid allocate(CS%diag) - call MOM_IS_diag_mediator_init(G, param_file, CS%diag, component='MOM_IceShelf') + call MOM_IS_diag_mediator_init(G, CS%US, param_file, CS%diag, component='MOM_IceShelf') ! This call sets up the diagnostic axes. These are needed, ! e.g. to generate the target grids below. call set_IS_axes_info(G, param_file, CS%diag) @@ -1417,11 +1420,11 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, call get_param(param_file, mdl, "ISOMIP_S_SUR_SPONGE", CS%S0, & "Surface salinity in the restoring region.", & - default=33.8, units='ppt', do_not_log=.true.) + default=33.8, units='ppt', scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "ISOMIP_T_SUR_SPONGE", CS%T0, & "Surface temperature in the restoring region.", & - default=-1.9, units='degC', do_not_log=.true.) + default=-1.9, units='degC', scale=US%degC_to_C, do_not_log=.true.) call get_param(param_file, mdl, "SHELF_3EQ_GAMMA", CS%const_gamma, & "If true, user specifies a constant nondimensional heat-transfer coefficient "//& @@ -1454,13 +1457,13 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, if (CS%find_salt_root) then ! read liquidus coeffs. call get_param(param_file, mdl, "TFREEZE_S0_P0", CS%TFr_0_0, & "this is the freezing potential temperature at "//& - "S=0, P=0.", units="degC", default=0.0, do_not_log=.true.) + "S=0, P=0.", units="degC", default=0.0, scale=US%degC_to_C, do_not_log=.true.) call get_param(param_file, mdl, "DTFREEZE_DS", CS%dTFr_dS, & "this is the derivative of the freezing potential temperature with salinity.", & - units="degC psu-1", default=-0.054, do_not_log=.true.) + units="degC psu-1", default=-0.054, scale=US%degC_to_C*US%S_to_ppt, do_not_log=.true.) call get_param(param_file, mdl, "DTFREEZE_DP", CS%dTFr_dp, & "this is the derivative of the freezing potential temperature with pressure.", & - units="degC Pa-1", default=0.0, scale=US%RL2_T2_to_Pa, do_not_log=.true.) + units="degC Pa-1", default=0.0, scale=US%degC_to_C*US%RL2_T2_to_Pa, do_not_log=.true.) endif call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & @@ -1469,7 +1472,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, call get_param(param_file, mdl, "C_P", CS%Cp, & "The heat capacity of sea water, approximated as a constant. "//& "The default value is from the TEOS-10 definition of conservative temperature.", & - units="J kg-1 K-1", default=3991.86795711963, scale=US%J_kg_to_Q) + units="J kg-1 K-1", default=3991.86795711963, scale=US%J_kg_to_Q*US%C_to_degC) call get_param(param_file, mdl, "RHO_0", CS%Rho_ocn, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& @@ -1477,7 +1480,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "C_P_ICE", CS%Cp_ice, & - "The heat capacity of ice.", units="J kg-1 K-1", scale=US%J_kg_to_Q, & + "The heat capacity of ice.", units="J kg-1 K-1", scale=US%J_kg_to_Q*US%C_to_degC, & default=2.10e3) if (CS%constant_sea_level) CS%min_ocean_mass_float = dz_ocean_min_float*CS%Rho_ocn @@ -1492,11 +1495,11 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, "The molecular kinimatic viscosity of sea water at the freezing temperature.", & units="m2 s-1", default=1.95e-6, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "ICE_SHELF_SALINITY", CS%Salin_ice, & - "The salinity of the ice inside the ice shelf.", units="psu", & - default=0.0) + "The salinity of the ice inside the ice shelf.", & + units="psu", default=0.0, scale=US%ppt_to_S) call get_param(param_file, mdl, "ICE_SHELF_TEMPERATURE", CS%Temp_ice, & "The temperature at the center of the ice shelf.", & - units = "degC", default=-15.0) + units="degC", default=-15.0, scale=US%degC_to_C) call get_param(param_file, mdl, "KD_SALT_MOLECULAR", CS%kd_molec_salt, & "The molecular diffusivity of salt in sea water at the "//& "freezing point.", units="m2 s-1", default=8.02e-10, scale=US%m2_s_to_Z2_T) @@ -1809,11 +1812,13 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, CS%id_melt = register_diag_field('ice_shelf_model', 'melt', CS%diag%axesT1, CS%Time, & 'Ice Shelf Melt Rate', 'm yr-1', conversion=meltrate_conversion) CS%id_thermal_driving = register_diag_field('ice_shelf_model', 'thermal_driving', CS%diag%axesT1, CS%Time, & - 'pot. temp. in the boundary layer minus freezing pot. temp. at the ice-ocean interface.', 'Celsius') + 'pot. temp. in the boundary layer minus freezing pot. temp. at the ice-ocean interface.', & + 'Celsius', conversion=US%C_to_degC) CS%id_haline_driving = register_diag_field('ice_shelf_model', 'haline_driving', CS%diag%axesT1, CS%Time, & - 'salinity in the boundary layer minus salinity at the ice-ocean interface.', 'psu') + 'salinity in the boundary layer minus salinity at the ice-ocean interface.', & + 'psu', conversion=US%S_to_ppt) CS%id_Sbdry = register_diag_field('ice_shelf_model', 'sbdry', CS%diag%axesT1, CS%Time, & - 'salinity at the ice-ocean interface.', 'psu') + 'salinity at the ice-ocean interface.', 'psu', conversion=US%S_to_ppt) CS%id_u_ml = register_diag_field('ice_shelf_model', 'u_ml', CS%diag%axesCu1, CS%Time, & 'Eastward vel. in the boundary layer (used to compute ustar)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_v_ml = register_diag_field('ice_shelf_model', 'v_ml', CS%diag%axesCv1, CS%Time, & @@ -1823,7 +1828,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, CS%id_exch_vel_t = register_diag_field('ice_shelf_model', 'exch_vel_t', CS%diag%axesT1, CS%Time, & 'Sub-shelf thermal exchange velocity', 'm s-1' , conversion=US%Z_to_m*US%s_to_T) CS%id_tfreeze = register_diag_field('ice_shelf_model', 'tfreeze', CS%diag%axesT1, CS%Time, & - 'In Situ Freezing point at ice shelf interface', 'degC') + 'In Situ Freezing point at ice shelf interface', 'degC', conversion=US%C_to_degC) CS%id_tfl_shelf = register_diag_field('ice_shelf_model', 'tflux_shelf', CS%diag%axesT1, CS%Time, & 'Heat conduction into ice shelf', 'W m-2', conversion=-US%QRZ_T_to_W_m2) CS%id_ustar_shelf = register_diag_field('ice_shelf_model', 'ustar_shelf', CS%diag%axesT1, CS%Time, & diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index 778ac2ef12..479b1dfd1e 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -14,6 +14,7 @@ module MOM_IS_diag_mediator use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_string_functions, only : lowercase, uppercase, slasher use MOM_time_manager, only : time_type +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -91,6 +92,8 @@ module MOM_IS_diag_mediator !> default missing value to be sent to ALL diagnostics registerations real :: missing_value = -1.0e34 + type(unit_scale_type), pointer :: US => null() !< A dimensional unit scaling type + end type diag_ctrl contains @@ -373,8 +376,8 @@ subroutine enable_averages(time_int, time_end, diag_CS, T_to_s) if (present(T_to_s)) then diag_cs%time_int = time_int*T_to_s -! elseif (associated(diag_CS%US)) then -! diag_cs%time_int = time_int*diag_CS%US%T_to_s + elseif (associated(diag_CS%US)) then + diag_cs%time_int = time_int*diag_CS%US%T_to_s else diag_cs%time_int = time_int endif @@ -393,15 +396,13 @@ logical function query_averaging_enabled(diag_cs, time_int, time_end) query_averaging_enabled = diag_cs%ave_enabled end function query_averaging_enabled +!> This subroutine initializes the diag_manager via the MOM6 infrastructure subroutine MOM_IS_diag_mediator_infrastructure_init(err_msg) - ! This subroutine initializes the FMS diag_manager. character(len=*), optional, intent(out) :: err_msg !< An error message call MOM_diag_manager_init(err_msg=err_msg) end subroutine MOM_IS_diag_mediator_infrastructure_init -!> diag_mediator_init initializes the MOM diag_mediator and opens the available - !> Return the currently specified valid end time for diagnostics function get_diag_time_end(diag_cs) type(diag_ctrl), intent(in) :: diag_cs !< A structure that is used to regulate diagnostic output @@ -592,11 +593,12 @@ function i2s(a, n_in) end function i2s !> Initialize the MOM_IS diag_mediator and opens the available diagnostics file. -subroutine MOM_IS_diag_mediator_init(G, param_file, diag_cs, component, err_msg, & +subroutine MOM_IS_diag_mediator_init(G, US, param_file, diag_cs, component, err_msg, & doc_file_dir) - type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type + type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), target, intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output + type(diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output character(len=*), optional, intent(in) :: component !< An opitonal component name character(len=*), optional, intent(out) :: err_msg !< A string for a returned error message character(len=*), optional, intent(in) :: doc_file_dir !< A directory in which to create the file @@ -620,6 +622,7 @@ subroutine MOM_IS_diag_mediator_init(G, param_file, diag_cs, component, err_msg, diag_cs%next_free_diag_id = 1 diag_cs%diags(:)%in_use = .false. + diag_cs%US => US diag_cs%is = G%isc - (G%isd-1) ; diag_cs%ie = G%iec - (G%isd-1) diag_cs%js = G%jsc - (G%jsd-1) ; diag_cs%je = G%jec - (G%jsd-1) diag_cs%isd = G%isd ; diag_cs%ied = G%ied ; diag_cs%jsd = G%jsd ; diag_cs%jed = G%jed diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 7847da55fa..4015c5d602 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -76,7 +76,7 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: calve_mask => NULL() !< a mask to prevent the ice shelf front from !! advancing past its initial position (but it may retreat) real, pointer, dimension(:,:) :: t_shelf => NULL() !< Vertically integrated temperature in the ice shelf/stream, - !! on corner-points (B grid) [degC] + !! on corner-points (B grid) [C ~> degC] real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice. real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, often in [R L4 Z T-1 ~> kg m2 s-1]. real, pointer, dimension(:,:) :: AGlen_visc => NULL() !< Ice-stiffness parameter in Glen's law ice viscosity, @@ -86,8 +86,8 @@ module MOM_ice_shelf_dynamics !! [L yr-1 ~> m yr-1] real, pointer, dimension(:,:) :: v_bdry_val => NULL() !< The meridional ice velocity at inflowing boundaries !! [L yr-1 ~> m yr-1] - real, pointer, dimension(:,:) :: h_bdry_val => NULL() !< The ice thickness at inflowing boundaries [m]. - real, pointer, dimension(:,:) :: t_bdry_val => NULL() !< The ice temperature at inflowing boundaries [degC]. + real, pointer, dimension(:,:) :: h_bdry_val => NULL() !< The ice thickness at inflowing boundaries [Z ~> m]. + real, pointer, dimension(:,:) :: t_bdry_val => NULL() !< The ice temperature at inflowing boundaries [C ~> degC]. real, pointer, dimension(:,:) :: bed_elev => NULL() !< The bed elevation used for ice dynamics [Z ~> m], !! relative to mean sea-level. This is @@ -99,7 +99,7 @@ module MOM_ice_shelf_dynamics !! The exact form depends on basal law exponent and/or whether flow is "hybridized" a la Goldberg 2011 real, pointer, dimension(:,:) :: C_basal_friction => NULL()!< Coefficient in sliding law tau_b = C u^(n_basal_fric), !! units= Pa (m yr-1)-(n_basal_fric) - real, pointer, dimension(:,:) :: OD_rt => NULL() !< A running total for calculating OD_av. + real, pointer, dimension(:,:) :: OD_rt => NULL() !< A running total for calculating OD_av [Z ~> m]. real, pointer, dimension(:,:) :: ground_frac_rt => NULL() !< A running total for calculating ground_frac. real, pointer, dimension(:,:) :: OD_av => NULL() !< The time average open ocean depth [Z ~> m]. real, pointer, dimension(:,:) :: ground_frac => NULL() !< Fraction of the time a cell is "exposed", i.e. the column @@ -131,11 +131,11 @@ module MOM_ice_shelf_dynamics !! should be exclusive) real :: CFL_factor !< A factor used to limit subcycled advective timestep in uncoupled runs - !! i.e. dt <= CFL_factor * min(dx / u) + !! i.e. dt <= CFL_factor * min(dx / u) [nondim] - real :: n_glen !< Nonlinearity exponent in Glen's Law - real :: eps_glen_min !< Min. strain rate to avoid infinite Glen's law viscosity, [year-1]. - real :: n_basal_fric !< Exponent in sliding law tau_b = C u^(m_slide) + real :: n_glen !< Nonlinearity exponent in Glen's Law [nondim] + real :: eps_glen_min !< Min. strain rate to avoid infinite Glen's law viscosity, [T-1 ~> s-1]. + real :: n_basal_fric !< Exponent in sliding law tau_b = C u^(m_slide) [nondim] real :: density_ocean_avg !< A typical ocean density [R ~> kg m-3]. This does not affect ocean !! circulation or thermodynamics. It is used to estimate the !! gravitational driving force at the shelf front (until we think of @@ -259,9 +259,9 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS) if (active_shelf_dynamics) then allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) - allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0 ) ! [degC] + allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0*US%degC_to_C ) ! [C ~> degC] allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 ) - allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Pa-3s-1] + allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Pa-3 s-1] allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Pa (m-1 s)^n_sliding] allocate( CS%OD_av(isd:ied,jsd:jed), source=0.0 ) @@ -440,7 +440,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! previously allocated for registration for restarts. if (active_shelf_dynamics) then - allocate( CS%t_bdry_val(isd:ied,jsd:jed), source=-15.0) ! [degC] + allocate( CS%t_bdry_val(isd:ied,jsd:jed), source=-15.0*US%degC_to_C) ! [C ~> degC] allocate( CS%thickness_bdry_val(isd:ied,jsd:jed), source=0.0) allocate( CS%u_face_mask(Isdq:Iedq,Jsdq:Jedq), source=0.0) allocate( CS%v_face_mask(Isdq:Iedq,Jsdq:Jedq), source=0.0) @@ -864,7 +864,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i real :: err_max, err_tempu, err_tempv, err_init, max_vel, tempu, tempv real :: rhoi_rhow ! The density of ice divided by a typical water density [nondim] real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian - ! quadrature points surrounding the cell vertices [m-1]. + ! quadrature points surrounding the cell vertices [L-1 ~> m-1]. real, pointer, dimension(:,:,:,:,:,:) :: Phisub => NULL() ! Quadrature structure weights at subgridscale ! locations for finite element calculations [nondim] @@ -1805,7 +1805,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation [Z ~> m]. BASE ! basal elevation of shelf/stream [Z ~> m]. real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian - ! quadrature points surrounding the cell vertices [m-1]. + ! quadrature points surrounding the cell vertices [L-1 ~> m-1]. real :: rho, rhow, rhoi_rhow ! Ice and ocean densities [R ~> kg m-3] @@ -2573,7 +2573,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(inout) :: v_shlf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian - ! quadrature points surrounding the cell vertices [m-1]. + ! quadrature points surrounding the cell vertices [L-1 ~> m-1]. ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve ! also this subroutine updates the nonlinear part of the basal traction @@ -2691,7 +2691,7 @@ subroutine update_OD_ffrac(CS, G, US, ocean_mass, find_avg) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: ocean_mass !< The mass per unit area of the ocean [kg m-2]. + intent(in) :: ocean_mass !< The mass per unit area of the ocean [R Z ~> kg m-2]. logical, intent(in) :: find_avg !< If true, find the average of OD and ffrac, and !! reset the underlying running sums to 0. @@ -3170,16 +3170,16 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) ! The flux overflows are included here. That is because they will be used to advect 3D scalars ! into partial cells - real, dimension(SZDI_(G),SZDJ_(G)) :: th_after_uflux, th_after_vflux, TH + real, dimension(SZDI_(G),SZDJ_(G)) :: th_after_uflux, th_after_vflux, TH ! Integrated temperatures [C Z ~> degC m] integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec - real :: Tsurf ! Surface air temperature. This is hard coded but should be an input argument. + real :: Tsurf ! Surface air temperature [C ~> degC]. This is hard coded but should be an input argument. real :: adot ! A surface heat exchange coefficient divided by the heat capacity of ! ice [R Z T-1 degC-1 ~> kg m-2 s-1 degC-1]. ! For now adot and Tsurf are defined here adot=surf acc 0.1m/yr, Tsurf=-20oC, vary them later adot = (0.1/(365.0*86400.0))*US%m_to_Z*US%T_to_s * CS%density_ice - Tsurf = -20.0 + Tsurf = -20.0*US%degC_to_C isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -3209,7 +3209,7 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) if (ISS%h_shelf(i,j) > 0.0) then CS%t_shelf(i,j) = th_after_vflux(i,j) / ISS%h_shelf(i,j) else - CS%t_shelf(i,j) = -10.0 + CS%t_shelf(i,j) = -10.0*US%degC_to_C endif ! endif @@ -3220,11 +3220,11 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) else ! the ice is about to melt away in this case set thickness, area, and mask to zero ! NOTE: not mass conservative, should maybe scale salt & heat flux for this cell - CS%t_shelf(i,j) = -10.0 + CS%t_shelf(i,j) = -10.0*US%degC_to_C CS%tmask(i,j) = 0.0 endif elseif (ISS%hmask(i,j) == 0) then - CS%t_shelf(i,j) = -10.0 + CS%t_shelf(i,j) = -10.0*US%degC_to_C elseif ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then CS%t_shelf(i,j) = CS%t_bdry_val(i,j) endif @@ -3234,7 +3234,7 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) call pass_var(CS%tmask, G%domain) if (CS%debug) then - call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3) + call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3, scale=US%C_to_degC) endif end subroutine ice_shelf_temp @@ -3248,10 +3248,10 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux) intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h0 !< The initial ice shelf thicknesses [Z ~> m]. + intent(in) :: h0 !< The initial ice shelf thicknesses times temperature [C Z ~> degC m] real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes [Z ~> m]. + intent(inout) :: h_after_uflux !< The ice shelf thicknesses times temperature after + !! the zonal mass fluxes [C Z ~> degC m] ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells ! if there is an input bdry condition, the thickness there will be set in initialization @@ -3259,9 +3259,10 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux) integer :: i, j, is, ie, js, je, isd, ied, jsd, jed integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry - real, dimension(-2:2) :: stencil - real :: u_face ! Zonal velocity at a face, positive if out {L T-1 ~> m s-1] - real :: flux_diff, phi + real, dimension(-2:2) :: stencil ! A copy of the neighboring thicknesses times temperatures [C Z ~> degC m] + real :: u_face ! Zonal velocity at a face, positive if out [L T-1 ~> m s-1] + real :: flux_diff ! The difference in fluxes [C Z ~> degC m] + real :: phi ! A limiting ratio [nondim] is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed i_off = G%idg_offset ; j_off = G%jdg_offset @@ -3270,7 +3271,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux) if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & ((j+j_off) >= G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries - stencil(:) = -1 + stencil(:) = 0.0 ! This is probably unnecessary, as the code is written ! if (i+i_off == G%domain%nihalo+G%domain%nihalo) do i=is,ie @@ -3414,11 +3415,11 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes [Z ~> m]. + intent(in) :: h_after_uflux !< The ice shelf thicknesses times temperature after + !! the zonal mass fluxes [C Z ~> degC m]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_after_vflux !< The ice shelf thicknesses after - !! the meridional mass fluxes [Z ~> m]. + intent(inout) :: h_after_vflux !< The ice shelf thicknesses times temperature after + !! the meridional mass fluxes [C Z ~> degC m] ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells ! if there is an input bdry condition, the thickness there will be set in initialization @@ -3426,9 +3427,10 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft integer :: i, j, is, ie, js, je, isd, ied, jsd, jed integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry - real, dimension(-2:2) :: stencil - real :: v_face ! Pseudo-meridional velocity at a cell face, positive if out {L T-1 ~> m s-1] - real :: flux_diff, phi + real, dimension(-2:2) :: stencil ! A copy of the neighboring thicknesses times temperatures [C Z ~> degC m] + real :: v_face ! Pseudo-meridional velocity at a cell face, positive if out [L T-1 ~> m s-1] + real :: flux_diff ! The difference in fluxes [C Z ~> degC m] + real :: phi is = G%isc ; ie = G%iec ; js = G%jsc-1 ; je = G%jec+1 ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed i_off = G%idg_offset ; j_off = G%jdg_offset @@ -3437,7 +3439,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & ((i+i_off) >= G%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries - stencil(:) = -1 + stencil(:) = 0.0 ! This is probably unnecessary, as the code is written do j=js,je diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 77d1cc8a3a..618f0e66fe 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -484,7 +484,6 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask intent(inout) :: vmask !< A mask for ice shelf velocity [nondim] real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: thickness_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] - !! boundary vertices [L T-1 ~> m s-1]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] real, dimension(SZDI_(G),SZDJ_(G)), & diff --git a/src/ice_shelf/MOM_ice_shelf_state.F90 b/src/ice_shelf/MOM_ice_shelf_state.F90 index ed3b419c9a..32413ad2d8 100644 --- a/src/ice_shelf/MOM_ice_shelf_state.F90 +++ b/src/ice_shelf/MOM_ice_shelf_state.F90 @@ -46,7 +46,7 @@ module MOM_ice_shelf_state !! shelf at the ice-ocean interface [Q R Z T-1 ~> W m-2]. tfreeze => NULL() !< The freezing point potential temperature - !! an the ice-ocean interface [degC]. + !! at the ice-ocean interface [C ~> degC]. end type ice_shelf_state diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index efeb7d7f8e..c384ef7cee 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -94,18 +94,19 @@ end subroutine USER_initialize_shelf_mass subroutine USER_init_ice_thickness(h_shelf, area_shelf_h, hmask, G, US, param_file) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(out) :: h_shelf !< The ice shelf thickness [m]. + intent(out) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(out) :: area_shelf_h !< The area per cell covered by the ice shelf [L2 ~> m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(out) :: 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] type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! This subroutine initializes the ice shelf thickness. Currently it does so ! calling USER_initialize_shelf_mass, but this can be revised as needed. - real, dimension(SZI_(G),SZJ_(G)) :: mass_shelf + real, dimension(SZI_(G),SZJ_(G)) :: mass_shelf ! The ice shelf mass per unit area averaged + ! over the full ocean cell [R Z ~> kg m-2]. type(user_ice_shelf_CS), pointer :: CS => NULL() call USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, US, CS, param_file, .true.) @@ -124,7 +125,7 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. 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] type(user_ice_shelf_CS), pointer :: CS !< A pointer to the user ice shelf control structure type(time_type), intent(in) :: Time !< The current model time logical, intent(in) :: new_sim !< If true, this the start of a new run. From c35da375af674644247adc578f70c51b01d8b16e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 7 May 2022 15:51:41 -0400 Subject: [PATCH 33/68] +Add user-controlled underflow of tracers Added the ability to do software-controlled underflow of user-specified tiny tracer values to 0. This includes the addition of two new runtime parameters, SALINITY_UNDERFLOW and TEMPERATURE_UNDERFLOW, and the addition of the new optional argument underflow_conc to register_tracer. There is new code that optionally underflows tiny values after tracer advection, all three flavors of tracer diffusion, and after tracer remapping via ALE. By default, underflow is handled via the machine as before, but with appropriately set tiny values of SALINITY_UNDERFLOW and TEMPERATURE_UNDERFLOW, of 1e-30 ppt and 1e-30 degC, all existing test cases pass the dimensional consistency rescaling tests for temperature and salinity, but doing so does change answers slightly for some test cases (detectible in the restart files, but not in the ocean.stats files). By default all answers are bitwise identical, but there are two new runtime parameters. --- src/ALE/MOM_ALE.F90 | 6 ++ src/core/MOM.F90 | 15 +++- src/tracer/MOM_lateral_boundary_diffusion.F90 | 1 + src/tracer/MOM_neutral_diffusion.F90 | 1 + src/tracer/MOM_tracer_advect.F90 | 2 + src/tracer/MOM_tracer_hor_diff.F90 | 2 + src/tracer/MOM_tracer_registry.F90 | 69 +++++++++++-------- 7 files changed, 65 insertions(+), 31 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 810f152e4a..5240061c3f 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -882,6 +882,11 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & h_neglect, h_neglect_edge) endif + ! Possibly underflow any very tiny tracer concentrations to 0. Note that this is not conservative! + if (Tr%conc_underflow > 0.0) then ; do k=1,GV%ke + if (abs(tr_column(k)) < Tr%conc_underflow) tr_column(k) = 0.0 + enddo ; endif + ! Intermediate steps for tendency of tracer concentration and tracer content. if (present(dt)) then if (Tr%id_remap_conc > 0) then @@ -895,6 +900,7 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & enddo endif endif + ! update tracer concentration Tr%t(i,j,:) = tr_column(:) endif ; enddo ; enddo diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 82c4692c1e..c1bb11ae80 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1799,6 +1799,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. + real :: salin_underflow ! A tiny value of salinity below which the it is set to 0 [S ~> ppt] + real :: temp_underflow ! A tiny magnitude of temperatures below which they are set to 0 [C ~> degC] real :: conv2watt ! A conversion factor from temperature fluxes to heat ! fluxes [J m-2 H-1 degC-1 ~> J m-3 degC-1 or J kg-1 degC-1] real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] @@ -2022,6 +2024,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call get_param(param_file, "MOM", "MIN_SALINITY", CS%tv%min_salinity, & "The minimum value of salinity when BOUND_SALINITY=True.", & units="PPT", default=0.0, scale=US%ppt_to_S, do_not_log=.not.bound_salinity) + call get_param(param_file, "MOM", "SALINITY_UNDERFLOW", salin_underflow, & + "A tiny value of salinity below which the it is set to 0. For reference, "//& + "one molecule of salt per square meter of ocean is of order 1e-29 ppt.", & + units="PPT", default=0.0, scale=US%ppt_to_S) + call get_param(param_file, "MOM", "TEMPERATURE_UNDERFLOW", temp_underflow, & + "A tiny magnitude of temperatures below which they are set to 0.", & + units="degC", default=0.0, scale=US%degC_to_C) call get_param(param_file, "MOM", "C_P", CS%tv%C_p, & "The heat capacity of sea water, approximated as a "//& "constant. This is only used if ENABLE_THERMODYNAMICS is "//& @@ -2324,12 +2333,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & tr_desc=vd_T, registry_diags=.true., conc_scale=US%C_to_degC, & flux_nameroot='T', flux_units='W', flux_longname='Heat', & flux_scale=conv2watt, convergence_units='W m-2', & - convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2) + convergence_scale=conv2watt, CMOR_tendprefix="opottemp", & + diag_form=2, underflow_conc=temp_underflow) call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, HI, GV, & tr_desc=vd_S, registry_diags=.true., conc_scale=US%S_to_ppt, & flux_nameroot='S', flux_units=S_flux_units, flux_longname='Salt', & flux_scale=conv2salt, convergence_units='kg m-2 s-1', & - convergence_scale=0.001*US%S_to_ppt*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2) + convergence_scale=0.001*US%S_to_ppt*GV%H_to_kg_m2, CMOR_tendprefix="osalt", & + diag_form=2, underflow_conc=salin_underflow) endif endif diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index d587ae5d6a..e68aa11b5c 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -223,6 +223,7 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) if (G%mask2dT(i,j)>0.) then tracer%t(i,j,k) = tracer%t(i,j,k) + (( (uFlx(I-1,j,k)-uFlx(I,j,k)) ) + ( (vFlx(i,J-1,k)-vFlx(i,J,k) ) ))* & G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) + if (abs(tracer%t(i,j,k)) < tracer%conc_underflow) tracer%t(i,j,k) = 0.0 if (tracer%id_lbdxy_conc > 0 .or. tracer%id_lbdxy_cont > 0 .or. tracer%id_lbdxy_cont_2d > 0 ) then tendency(i,j,k) = ((uFlx(I-1,j,k)-uFlx(I,j,k)) + (vFlx(i,J-1,k)-vFlx(i,J,k))) * & diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index a8e08d8cab..cf3fd3fd57 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -640,6 +640,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) do k = 1, GV%ke tracer%t(i,j,k) = tracer%t(i,j,k) + dTracer(k) * & ( G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) + if (abs(tracer%t(i,j,k)) < tracer%conc_underflow) tracer%t(i,j,k) = 0.0 enddo if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 ) then diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index f946fd46c2..84ef54099d 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -650,6 +650,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (Ihnew(i) > 0.0) then Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - & (flux_x(I,j,m) - flux_x(I-1,j,m))) * Ihnew(i) + if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 endif endif enddo @@ -1028,6 +1029,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & do i=is,ie ; if (do_i(i,j)) then Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - & (flux_y(i,m,J) - flux_y(i,m,J-1))) * Ihnew(i) + if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 endif ; enddo ! diagnostics diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 22e41c2c1d..e17d229221 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -507,6 +507,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online enddo ; enddo ; endif do j=js,je ; do i=is,ie Reg%Tr(m)%t(i,j,k) = Reg%Tr(m)%t(i,j,k) + dTr(i,j) + if (abs(Reg%Tr(m)%t(i,j,k)) < Reg%Tr(m)%conc_underflow) Reg%Tr(m)%t(i,j,k) = 0.0 enddo ; enddo enddo @@ -1403,6 +1404,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & if ((G%mask2dT(i,j) > 0.0) .and. (h(i,j,k) > 0.0)) then Tr(m)%t(i,j,k) = Tr(m)%t(i,j,k) + tr_flux_conv(i,j,k) / & (h(i,j,k)*G%areaT(i,j)) + if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 tr_flux_conv(i,j,k) = 0.0 endif enddo ; enddo ; enddo diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 62126801a9..0b7d9f4d04 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -37,6 +37,10 @@ module MOM_tracer_registry !> The tracer type type, public :: tracer_type + ! In the following the scaled units of the tracer concentration are given as [CU] while the + ! unscaled units are given as [conc]. For salinity, [CU ~> conc] is equivalent to [S ~> ppt], + ! while for temperatures it is [C ~> degC]. + real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array [CU ~> conc] ! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows [CU ~> conc] ! real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain @@ -45,47 +49,47 @@ module MOM_tracer_registry ! !! specified in OBCs through v-face of cell real, dimension(:,:,:), pointer :: ad_x => NULL() !< diagnostic array for x-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: ad_y => NULL() !< diagnostic array for y-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: ad2d_x => NULL() !< diagnostic vertical sum x-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: ad2d_y => NULL() !< diagnostic vertical sum y-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: df_x => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: df_y => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: lbd_dfx => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: lbd_dfy => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: lbd_dfx_2d => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: lbd_dfy_2d => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] !### These two arrays may be allocated but are never used. real, dimension(:,:), pointer :: lbd_bulk_df_x => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: lbd_bulk_df_y => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: df2d_x => NULL() !< diagnostic vertical sum x-diffusive flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: df2d_y => NULL() !< diagnostic vertical sum y-diffusive flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] ! real, dimension(:,:), pointer :: df2d_conc_x => NULL() !< diagnostic vertical sum x-diffusive content flux -! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] +! !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] ! real, dimension(:,:), pointer :: df2d_conc_y => NULL() !< diagnostic vertical sum y-diffusive content flux -! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] +! !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes - !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] + !! [CU H T-1 ~> conc m s-1 or conc kg m-2 s-1] ! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] +! !! [CU H T-1 ~> conc m s-1 or conc kg m-2 s-1] ! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes ! !! expressed as a change in concentration -! !! [conc T-1 ~> conc s-1] +! !! [CU T-1 ~> conc s-1] real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous !! timestep used for diagnostics [CU ~> conc] real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array @@ -98,6 +102,8 @@ module MOM_tracer_registry ! type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer logical :: registry_diags = .false. !< If true, use the registry to set up the !! diagnostics associated with this tracer. + real :: conc_underflow = 0.0 !< A magnitude of tracer concentrations below + !! which values should be set to 0. [CU ~> conc] real :: conc_scale = 1.0 !< A scaling factor used to convert the concentrations !! of this tracer to its desired units. character(len=64) :: cmor_name !< CMOR name of this tracer @@ -161,12 +167,12 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, & conc_scale, flux_nameroot, flux_longname, flux_units, flux_scale, & convergence_units, convergence_scale, cmor_tendprefix, diag_form, & - restart_CS, mandatory) + restart_CS, underflow_conc, mandatory) type(hor_index_type), intent(in) :: HI !< horizontal index type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry real, dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), & - target :: tr_ptr !< target or pointer to the tracer array + target :: tr_ptr !< target or pointer to the tracer array [CU ~> conc] type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values character(len=*), optional, intent(in) :: name !< Short tracer name character(len=*), optional, intent(in) :: longname !< The long tracer name @@ -185,21 +191,21 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit ! The following are probably not necessary if registry_diags is present and true. real, dimension(:,:,:), optional, pointer :: ad_x !< diagnostic x-advective flux - !! [conc H L2 T-1 ~> CONC m3 s-1 or CONC kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), optional, pointer :: ad_y !< diagnostic y-advective flux - !! [conc H L2 T-1 ~> CONC m3 s-1 or CONC kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), optional, pointer :: df_x !< diagnostic x-diffusive flux - !! [conc H L2 T-1 ~> CONC m3 s-1 or CONC kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), optional, pointer :: df_y !< diagnostic y-diffusive flux - !! [conc H L2 T-1 ~> CONC m3 s-1 or CONC kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), optional, pointer :: ad_2d_x !< vert sum of diagnostic x-advect flux - !! [conc H L2 T-1 ~> CONC m3 s-1 or CONC kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), optional, pointer :: ad_2d_y !< vert sum of diagnostic y-advect flux - !! [conc H L2 T-1 ~> CONC m3 s-1 or CONC kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), optional, pointer :: df_2d_x !< vert sum of diagnostic x-diffuse flux - !! [conc H L2 T-1 ~> CONC m3 s-1 or CONC kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), optional, pointer :: df_2d_y !< vert sum of diagnostic y-diffuse flux - !! [conc H L2 T-1 ~> CONC m3 s-1 or CONC kg s-1] + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), optional, pointer :: advection_xy !< convergence of lateral advective tracer fluxes logical, optional, intent(in) :: registry_diags !< If present and true, use the registry for @@ -225,6 +231,8 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit type(MOM_restart_CS), optional, intent(inout) :: restart_CS !< MOM restart control struct logical, optional, intent(in) :: mandatory !< If true, this tracer must be read !! from a restart file. + real, optional, intent(in) :: underflow_conc !< A tiny concentration, below which the tracer + !! concentration underflows to 0 [CU ~> conc]. logical :: mand type(tracer_type), pointer :: Tr=>NULL() @@ -274,6 +282,9 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit Tr%conc_scale = 1.0 if (present(conc_scale)) Tr%conc_scale = conc_scale + Tr%conc_underflow = 0.0 + if (present(underflow_conc)) Tr%conc_underflow = underflow_conc + Tr%flux_nameroot = Tr%name if (present(flux_nameroot)) then if (len_trim(flux_nameroot) > 0) Tr%flux_nameroot = flux_nameroot From 4288d418c126a020f20b416a48d24922040879b9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Jun 2022 05:53:19 -0400 Subject: [PATCH 34/68] Move underflow code into separate loops Moved the new user-controlled tracer underflow code into separate loops, in response to the reviews of this initial commit, in the hopes that this will provide better computational performance. All answers are bitwise identical. --- src/tracer/MOM_lateral_boundary_diffusion.F90 | 8 +++++++- src/tracer/MOM_neutral_diffusion.F90 | 7 +++++++ src/tracer/MOM_tracer_advect.F90 | 19 +++++++++++++----- src/tracer/MOM_tracer_hor_diff.F90 | 20 ++++++++++++++++--- 4 files changed, 45 insertions(+), 9 deletions(-) diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index e68aa11b5c..d52e2cde4c 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -223,7 +223,6 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) if (G%mask2dT(i,j)>0.) then tracer%t(i,j,k) = tracer%t(i,j,k) + (( (uFlx(I-1,j,k)-uFlx(I,j,k)) ) + ( (vFlx(i,J-1,k)-vFlx(i,J,k) ) ))* & G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) - if (abs(tracer%t(i,j,k)) < tracer%conc_underflow) tracer%t(i,j,k) = 0.0 if (tracer%id_lbdxy_conc > 0 .or. tracer%id_lbdxy_cont > 0 .or. tracer%id_lbdxy_cont_2d > 0 ) then tendency(i,j,k) = ((uFlx(I-1,j,k)-uFlx(I,j,k)) + (vFlx(i,J-1,k)-vFlx(i,J,k))) * & @@ -232,6 +231,13 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) endif enddo ; enddo ; enddo + ! Do user controlled underflow of the tracer concentrations. + if (tracer%conc_underflow > 0.0) then + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + if (abs(tracer%t(i,j,k)) < tracer%conc_underflow) tracer%t(i,j,k) = 0.0 + enddo ; enddo ; enddo + endif + if (CS%debug) then call hchksum(tracer%t, "after LBD "//tracer%name,G%HI) ! tracer (native grid) integrated tracer amounts before and after LBD diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index cf3fd3fd57..3869610059 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -652,6 +652,13 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) endif enddo ; enddo + ! Do user controlled underflow of the tracer concentrations. + if (tracer%conc_underflow > 0.0) then + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + if (abs(tracer%t(i,j,k)) < tracer%conc_underflow) tracer%t(i,j,k) = 0.0 + enddo ; enddo ; enddo + endif + ! Diagnose vertically summed zonal flux, giving zonal tracer transport from ndiff. ! Note sign corresponds to downgradient flux convention. if (tracer%id_dfx_2d > 0) then diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 84ef54099d..95bef29d68 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -650,7 +650,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (Ihnew(i) > 0.0) then Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - & (flux_x(I,j,m) - flux_x(I-1,j,m))) * Ihnew(i) - if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 endif endif enddo @@ -671,10 +670,14 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo - endif - + endif ; enddo ! End of j-loop. - enddo ! End of j-loop. + ! Do user controlled underflow of the tracer concentrations. + do m=1,ntr ; if (Tr(m)%conc_underflow > 0.0) then + do j=js,je ; do i=is,ie + if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 + enddo ; enddo + endif ; enddo ! compute ad2d_x diagnostic outside above j-loop so as to make the summation ordered when OMP is active. @@ -1029,7 +1032,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & do i=is,ie ; if (do_i(i,j)) then Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - & (flux_y(i,m,J) - flux_y(i,m,J-1))) * Ihnew(i) - if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 endif ; enddo ! diagnostics @@ -1049,6 +1051,13 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & enddo endif ; enddo ! End of j-loop. + ! Do user controlled underflow of the tracer concentrations. + do m=1,ntr ; if (Tr(m)%conc_underflow > 0.0) then + do j=js,je ; do i=is,ie + if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 + enddo ; enddo + endif ; enddo + ! compute ad2d_y diagnostic outside above j-loop so as to make the summation ordered when OMP is active. !$OMP ordered diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index e17d229221..7f8361620d 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -507,12 +507,19 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online enddo ; enddo ; endif do j=js,je ; do i=is,ie Reg%Tr(m)%t(i,j,k) = Reg%Tr(m)%t(i,j,k) + dTr(i,j) - if (abs(Reg%Tr(m)%t(i,j,k)) < Reg%Tr(m)%conc_underflow) Reg%Tr(m)%t(i,j,k) = 0.0 enddo ; enddo enddo enddo ! End of k loop. + ! Do user controlled underflow of the tracer concentrations. + do m=1,ntr ; if (Reg%Tr(m)%conc_underflow > 0.0) then + !$OMP parallel do default(shared) + do k=1,nz ; do j=js,je ; do i=is,ie + if (abs(Reg%Tr(m)%t(i,j,k)) < Reg%Tr(m)%conc_underflow) Reg%Tr(m)%t(i,j,k) = 0.0 + enddo ; enddo ; enddo + endif ; enddo + enddo ! End of "while" loop. endif ! endif for CS%use_neutral_diffusion @@ -1399,16 +1406,23 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & endif enddo endif ; enddo ; enddo -!$OMP parallel do default(none) shared(PEmax_kRho,is,ie,js,je,G,h,Tr,tr_flux_conv,m) + !$OMP parallel do default(shared) do k=1,PEmax_kRho ; do j=js,je ; do i=is,ie if ((G%mask2dT(i,j) > 0.0) .and. (h(i,j,k) > 0.0)) then Tr(m)%t(i,j,k) = Tr(m)%t(i,j,k) + tr_flux_conv(i,j,k) / & (h(i,j,k)*G%areaT(i,j)) - if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 tr_flux_conv(i,j,k) = 0.0 endif enddo ; enddo ; enddo + ! Do user controlled underflow of the tracer concentrations. + if (Tr(m)%conc_underflow > 0.0) then + !$OMP parallel do default(shared) + do k=1,nz ; do j=js,je ; do i=is,ie + if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 + enddo ; enddo ; enddo + endif + enddo ! Loop over tracers enddo ! Loop over iterations From aa86abaa0bc10ebca94ed54c6026f4823965ff82 Mon Sep 17 00:00:00 2001 From: Angus Gibson Date: Wed, 25 May 2022 11:35:52 +1000 Subject: [PATCH 35/68] Put CVMix convective viscosity into shear term In both the legacy and non-legacy diabatic drivers, the viscosity output from CVMix convection went to the `Kv_slow` term. However, this term is only allocated if KPP is being used, leading to a segfault if `USE_KPP = False`. This may have been the intended purpose of `Kv_slow`, but its contribution is already added to the shear term before convection is calculated, so convection can't be accounted using `Kv_slow`. To ensure we don't hit a segfault, and that the enhanced viscosity is actually present, we change convection to go into `Kv_shear` in all cases. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 61c30830a8..831ffa293b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -753,7 +753,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Calculate vertical mixing due to convection (computed via CVMix) if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_slow) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_shear) endif ! This block sets ent_t and ent_s from h and Kd_int. @@ -1307,11 +1307,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! Calculate vertical mixing due to convection (computed via CVMix) if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection - if (CS%useKPP) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_heat, visc%Kv_shear, Kd_aux=Kd_salt) - else - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_heat, visc%Kv_slow, Kd_aux=Kd_salt) - endif + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_heat, visc%Kv_shear, Kd_aux=Kd_salt) endif ! Save fields before boundary forcing is applied for tendency diagnostics From 328c44000956426db47ab86720e626a514d8d5fa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Jun 2022 08:17:45 -0400 Subject: [PATCH 36/68] +Clean up dimensional rescaling in OBC code Use the new scale argument to time_interp_external to standardize where the dimensional rescaling occurs for the OBC code, and to use properly dimensionally rescaled internal variables. This includes the addition of the new function scale_factor_from_name, and there are new verticalGrid_type and unit_scale_type arguments to initialize_segment_data. All answers are bitwise identical and are passing dimensional consistency testing, including in Alex Bozec's Gulf of Mexico regional configuration, but there are new arguments to public interfaces. --- src/core/MOM_open_boundary.F90 | 125 ++++++++++++------ .../MOM_state_initialization.F90 | 2 +- src/user/DOME_initialization.F90 | 5 +- 3 files changed, 88 insertions(+), 44 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 768c234bae..e7720a15fc 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -78,17 +78,19 @@ module MOM_open_boundary type, public :: OBC_segment_data_type integer :: fid !< handle from FMS associated with segment data on disk integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk - character(len=8) :: name !< a name identifier for the segment data + character(len=8) :: name !< a name identifier for the segment data + real :: scale !< A scaling factor for converting input data to + !! the internal units of this field real, allocatable :: buffer_src(:,:,:) !< buffer for segment data located at cell faces !! and on the original vertical grid. The values for tracers should !! have the same units as the field they are being applied to? - integer :: nk_src !< Number of vertical levels in the source data + integer :: nk_src !< Number of vertical levels in the source data real, allocatable :: dz_src(:,:,:) !< vertical grid cell spacing of the incoming segment !! data, set in [Z ~> m] then scaled to [H ~> m or kg m-2] real, allocatable :: buffer_dst(:,:,:) !< buffer src data remapped to the target vertical grid. !! The values for tracers should have the same units as the field !! they are being applied to? - real :: value !< constant value if fid is equal to -1 + real :: value !< constant value if fid is equal to -1 end type OBC_segment_data_type !> Tracer on OBC segment data structure, for putting into a segment tracer registry. @@ -652,10 +654,12 @@ end subroutine open_boundary_config !> Allocate space for reading OBC data from files. It sets up the required vertical !! remapping. In the process, it does funky stuff with the MPI processes. -subroutine initialize_segment_data(G, OBC, PF) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure +subroutine initialize_segment_data(G, GV, US, OBC, PF) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Container for vertical grid information + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: PF !< Parameter file handle + type(param_file_type), intent(in) :: PF !< Parameter file handle integer :: n, m, num_fields character(len=1024) :: segstr @@ -728,8 +732,8 @@ subroutine initialize_segment_data(G, OBC, PF) allocate(segment%field(num_fields)) segment%num_fields = num_fields - segment%temp_segment_data_exists=.false. - segment%salt_segment_data_exists=.false. + segment%temp_segment_data_exists = .false. + segment%salt_segment_data_exists = .false. !! ! CODE HERE FOR OTHER OPTIONS (CLAMPED, NUDGED,..) !! @@ -747,13 +751,14 @@ subroutine initialize_segment_data(G, OBC, PF) OBC%needs_IO_for_data = .true. ! At least one segment is using I/O for OBC data ! segment%values_needed = .true. ! Indicates that i/o will be needed for this segment segment%field(m)%name = trim(fields(m)) + segment%field(m)%scale = scale_factor_from_name(fields(m), GV, US) if (segment%field(m)%name == 'TEMP') then - segment%temp_segment_data_exists=.true. - segment%t_values_needed = .false. + segment%temp_segment_data_exists = .true. + segment%t_values_needed = .false. endif if (segment%field(m)%name == 'SALT') then - segment%salt_segment_data_exists=.true. - segment%s_values_needed = .false. + segment%salt_segment_data_exists = .true. + segment%s_values_needed = .false. endif filename = trim(inputdir)//trim(filename) fieldname = trim(fieldname)//trim(suffix) @@ -861,7 +866,7 @@ subroutine initialize_segment_data(G, OBC, PF) endif endif endif - segment%field(m)%buffer_src(:,:,:)=0.0 + segment%field(m)%buffer_src(:,:,:) = 0.0 segment%field(m)%fid = init_external_field(trim(filename), trim(fieldname), & ignore_axis_atts=.true., threading=SINGLE_FILE) if (siz(3) > 1) then @@ -902,8 +907,12 @@ subroutine initialize_segment_data(G, OBC, PF) endif else segment%field(m)%fid = -1 - segment%field(m)%value = value segment%field(m)%name = trim(fields(m)) + ! The scale factor for tracers is set in register_segment_tracer, and value is + ! rescaled there. scale_factor_from_name returns 1 for tracers. + segment%field(m)%scale = scale_factor_from_name(fields(m), GV, US) + segment%field(m)%value = segment%field(m)%scale * value + ! Check if this is a tidal field. If so, the number ! of expected constituents must be 1. if ((index(segment%field(m)%name, 'phase') > 0) .or. (index(segment%field(m)%name, 'amp') > 0)) then @@ -958,6 +967,28 @@ subroutine initialize_segment_data(G, OBC, PF) end subroutine initialize_segment_data +!> Return an appropriate dimensional scaling factor for input data based on an OBC segment data +!! name, or 1 for tracers or other fields that do not match one of the specified names. +real function scale_factor_from_name(name, GV, US) + character(len=*), intent(in) :: name !< The OBC segment data name to interpret + type(verticalGrid_type), intent(in) :: GV !< Container for vertical grid information + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + + select case (trim(name)) + case ('U') ; scale_factor_from_name = US%m_s_to_L_T + case ('V') ; scale_factor_from_name = US%m_s_to_L_T + case ('Uamp') ; scale_factor_from_name = US%m_s_to_L_T + case ('Vamp') ; scale_factor_from_name = US%m_s_to_L_T + case ('DVDX') ; scale_factor_from_name = US%T_to_s + case ('DUDY') ; scale_factor_from_name = US%T_to_s + case ('SSH') ; scale_factor_from_name = GV%m_to_H + case ('SSHamp') ; scale_factor_from_name = GV%m_to_H + case default ; scale_factor_from_name = 1.0 + end select + +end function scale_factor_from_name + +!> Initize parameters and fields related to the specification of tides at open boundaries. subroutine initialize_obc_tides(OBC, US, param_file) type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -3650,8 +3681,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) real :: net_H_src ! Total thickness of the incoming flow in the source field [H ~> m or kg m-2] real :: net_H_int ! Total thickness of the incoming flow in the model [H ~> m or kg m-2] real :: scl_fac ! A scaling factor to compensate for differences in total thicknesses [nondim] - real :: tidal_vel ! Interpolated tidal velocity at the OBC points [m s-1] - real :: tidal_elev ! Interpolated tidal elevation at the OBC points [m] + real :: tidal_vel ! Interpolated tidal velocity at the OBC points [L T-1 ~> m s-1] + real :: tidal_elev ! Interpolated tidal elevation at the OBC points [H ~> m or kg m-2] real, allocatable :: normal_trans_bt(:,:) ! barotropic transport [H L2 T-1 ~> m3 s-1] integer :: turns ! Number of index quarter turns real :: time_delta ! Time since tidal reference date [T ~> s] @@ -3808,7 +3839,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif ! This is where the data values are actually read in. - call time_interp_external(segment%field(m)%fid, Time, tmp_buffer_in) + call time_interp_external(segment%field(m)%fid, Time, tmp_buffer_in, scale=segment%field(m)%scale) ! NOTE: Rotation of face-points require that we skip the final value if (turns /= 0) then @@ -3877,8 +3908,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (segment%field(m)%nk_src > 1 .and.& (index(segment%field(m)%name, 'phase') <= 0 .and. index(segment%field(m)%name, 'amp') <= 0)) then ! This is where the 2-d tidal data values are actually read in. - call time_interp_external(segment%field(m)%fid_dz, Time, tmp_buffer_in) - tmp_buffer_in(:,:,:) = tmp_buffer_in(:,:,:) * US%m_to_Z + call time_interp_external(segment%field(m)%fid_dz, Time, tmp_buffer_in, scale=US%m_to_Z) if (turns /= 0) then ! TODO: This is hardcoded for 90 degrees, and needs to be generalized. if (segment%is_E_or_W & @@ -4100,7 +4130,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo endif do k=1,GV%ke - segment%normal_vel(I,j,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,j,k) + tidal_vel) + segment%normal_vel(I,j,k) = segment%field(m)%buffer_dst(I,j,k) + tidal_vel segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k)*segment%h(I,j,k) * G%dyCu(I,j) normal_trans_bt(I,j) = normal_trans_bt(I,j) + segment%normal_trans(I,j,k) enddo @@ -4121,7 +4151,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo endif do k=1,GV%ke - segment%normal_vel(i,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(i,J,k) + tidal_vel) + segment%normal_vel(i,J,k) = segment%field(m)%buffer_dst(i,J,k) + tidal_vel segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k)*segment%h(i,J,k) * & G%dxCv(i,J) normal_trans_bt(i,J) = normal_trans_bt(i,J) + segment%normal_trans(i,J,k) @@ -4143,7 +4173,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo endif do k=1,GV%ke - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,J,k) + tidal_vel) + segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + tidal_vel enddo if (allocated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) @@ -4161,7 +4191,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo endif do k=1,GV%ke - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,J,k) + tidal_vel) + segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + tidal_vel enddo if (allocated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) @@ -4172,7 +4202,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) I=is_obc do J=js_obc,je_obc do k=1,GV%ke - segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) + segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) if (allocated(segment%nudged_tangential_grad)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) enddo @@ -4182,7 +4212,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) J=js_obc do I=is_obc,ie_obc do k=1,GV%ke - segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) + segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) if (allocated(segment%nudged_tangential_grad)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) enddo @@ -4220,8 +4250,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) + (OBC%tide_eq_phases(c) + OBC%tide_un(c))) enddo endif - segment%eta(i,j) = GV%m_to_H * OBC%ramp_value & - * (segment%field(m)%buffer_dst(i,j,1) + tidal_elev) + segment%eta(i,j) = OBC%ramp_value * (segment%field(m)%buffer_dst(i,j,1) + tidal_elev) enddo enddo else @@ -4235,7 +4264,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) + (OBC%tide_eq_phases(c) + OBC%tide_un(c))) enddo endif - segment%eta(i,j) = GV%m_to_H * (segment%field(m)%buffer_dst(i,j,1) + tidal_elev) + segment%eta(i,j) = (segment%field(m)%buffer_dst(i,j,1) + tidal_elev) enddo enddo endif @@ -4244,7 +4273,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (trim(segment%field(m)%name) == 'TEMP') then if (allocated(segment%field(m)%buffer_dst)) then do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc - segment%tr_Reg%Tr(1)%t(i,j,k) = segment%tr_Reg%Tr(1)%scale * segment%field(m)%buffer_dst(i,j,k) + segment%tr_Reg%Tr(1)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo if (.not. segment%tr_Reg%Tr(1)%is_initialized) then ! if the tracer reservoir has not yet been initialized, then set to external value. @@ -4259,7 +4288,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) elseif (trim(segment%field(m)%name) == 'SALT') then if (allocated(segment%field(m)%buffer_dst)) then do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc - segment%tr_Reg%Tr(2)%t(i,j,k) = segment%tr_Reg%Tr(2)%scale * segment%field(m)%buffer_dst(i,j,k) + segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo if (.not. segment%tr_Reg%Tr(2)%is_initialized) then !if the tracer reservoir has not yet been initialized, then set to external value. @@ -4338,7 +4367,7 @@ subroutine register_OBC(name, param_file, Reg) if (Reg%nobc>=MAX_FIELDS_) then write(mesg,'("Increase MAX_FIELDS_ in MOM_memory.h to at least ",I3," to allow for & &all the open boundaries being registered via register_OBC.")') Reg%nobc+1 - call MOM_error(FATAL,"MOM register_tracer: "//mesg) + call MOM_error(FATAL,"MOM register_OBC: "//mesg) endif Reg%nobc = Reg%nobc + 1 nobc = Reg%nobc @@ -4451,21 +4480,20 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & !! but it also means that any updates to this !! structure in the calling module will be !! available subsequently to the tracer registry. - type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values + type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values type(OBC_segment_type), intent(inout) :: segment !< current segment data structure - real, optional, intent(in) :: OBC_scalar !< If present, use scalar value for segment tracer + real, optional, intent(in) :: OBC_scalar !< If present, use scalar value for segment tracer !! inflow concentration, including any rescaling to !! put the tracer concentration into its internal units. - logical, optional, intent(in) :: OBC_array !< If true, use array values for segment tracer + logical, optional, intent(in) :: OBC_array !< If true, use array values for segment tracer !! inflow concentration. - real, optional, intent(in) :: scale !< A scaling factor that should be used with any + real, optional, intent(in) :: scale !< A scaling factor that should be used with any !! data that is read in, to convert it to the internal !! units of this tracer. ! Local variables - integer :: ntseg - integer :: isd, ied, jsd, jed - integer :: IsdB, IedB, JsdB, JedB + real :: rescale ! A multiplicative correction to the scaling factor. + integer :: ntseg, m, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB character(len=256) :: mesg ! Message for error messages. call segment_tracer_registry_init(param_file, segment) @@ -4485,7 +4513,24 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & segment%tr_Reg%Tr(ntseg)%Tr => tr_ptr segment%tr_Reg%Tr(ntseg)%name = tr_ptr%name - segment%tr_Reg%Tr(ntseg)%scale = 1.0 ; if (present(scale)) segment%tr_Reg%Tr(ntseg)%scale = scale + + segment%tr_Reg%Tr(ntseg)%scale = 1.0 + if (present(scale)) then + segment%tr_Reg%Tr(ntseg)%scale = scale + do m=1,segment%num_fields + ! Store the scaling factor for fields with exactly matching names, and possibly + ! rescale the previously stonred input values. + if (trim(segment%field(m)%name) == trim(segment%tr_Reg%Tr(ntseg)%name)) then + if (segment%field(m)%fid == -1) then + rescale = scale + if ((segment%field(m)%scale /= 0.0) .and. (segment%field(m)%scale /= 1.0)) & + rescale = scale / segment%field(m)%scale + segment%field(m)%value = rescale * segment%field(m)%value + endif + segment%field(m)%scale = scale + endif + enddo + endif if (segment%tr_Reg%locked) call MOM_error(FATAL, & "MOM register_segment_tracer was called for variable "//trim(segment%tr_Reg%Tr(ntseg)%name)//& @@ -4726,7 +4771,7 @@ subroutine mask_outside_OBCs(G, US, param_file, OBC) fatal_error = .True. write(mesg,'("MOM_open_boundary: problem with OBC segments specification at ",I5,",",I5," during\n", & &"the masking of the outside grid points.")') i, j - call MOM_error(WARNING,"MOM register_tracer: "//mesg, all_print=.true.) + call MOM_error(WARNING,"MOM mask_outside_OBCs: "//mesg, all_print=.true.) endif if (color(i,j) == cout) G%bathyT(i,j) = min_depth enddo ; enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 829368efbc..0757fd887f 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -602,7 +602,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! This controls user code for setting open boundary data if (associated(OBC)) then - call initialize_segment_data(G, OBC, PF) ! call initialize_segment_data(G, OBC, param_file) + call initialize_segment_data(G, GV, US, OBC, PF) ! call open_boundary_config(G, US, PF, OBC) ! Call this once to fill boundary arrays from fixed values if (.not. OBC%needs_IO_for_data) & diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index a78ed3acc4..ceef4a3a93 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -390,9 +390,8 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! Temperature is tracer 1 for the OBCs. allocate(segment%field(1)%buffer_src(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied - ! Because of the challenges in rescaling the data as it is being read in when using certain - ! modes, buffer_src keeps the data in unscaled (mks) units. They will be rescaled later. - segment%field(1)%buffer_src(i,j,k) = US%C_to_degC*T0(k) + ! With the revised OBC code, buffer_src uses the same rescaled units as for tracers. + segment%field(1)%buffer_src(i,j,k) = T0(k) enddo ; enddo ; enddo name = 'temp' call tracer_name_lookup(tr_Reg, tr_ptr, name) From 466ca80f78bcd930cda27154db3700cc377fa1d4 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 8 Jun 2022 15:06:10 -0400 Subject: [PATCH 37/68] Remove Travis CI config MOM6 stopped using the Travis CI many months ago, shortly after migrating to GitHub CI. The Travis CI config was retained in case other groups still preferred to use it. But at this time, no groups appear to be doing so. Also, the presence of this file can trigger runs in older forks which may still keep Travis activated, which generally results in errors due to the greater restrictions imposed by Travis. To keep things running smoothly and avert such problems, this patch simply removes the config file. --- .travis.yml | 86 ----------------------------------------------------- 1 file changed, 86 deletions(-) delete mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index c34089ddf6..0000000000 --- a/.travis.yml +++ /dev/null @@ -1,86 +0,0 @@ -# This Travis-CI file is for testing the state of the MOM6 source code. -# It does NOT test MOM6 solutions. - -# This is a not a c-language project but we use the same environment. -language: c -dist: bionic - -addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - tcsh pkg-config netcdf-bin libnetcdf-dev libnetcdff-dev gfortran - - mpich libmpich-dev - - graphviz flex bison cmake - - python-numpy python-netcdf4 - - python3 python3-dev python3-venv python3-pip python3-sphinx python3-lxml - - bc - - perl - - texlive-binaries texlive-base bibtool tex-common texlive-bibtex-extra - -# Environment variables -env: - global: - - TIMEFORMAT: "\"Time: %lR (user: %lU, sys: %lS)\"" - - FCFLAGS_DEBUG: "\"-g -O0 -Wextra -Wno-compare-reals -fbacktrace -ffpe-trap=invalid,zero,overflow -fcheck=bounds\"" - - FCFLAGS_REPRO: "\"-g -O2 -fbacktrace\"" - - FCFLAGS_INIT: "\"-finit-real=snan -finit-integer=2147483647 -finit-derived\"" - - FCFLAGS_COVERAGE: "\"--coverage\"" - - DO_REPRO_TESTS: true - -jobs: - include: - - env: JOB="Code compliance" - script: - # Whitespace - - ./.testing/trailer.py -e TEOS10 -l 120 src config_src - # API Documentation - - perl -e 'print "perl version $^V" . "\n"' - - cd docs && mkdir _build && make nortd DOXYGEN_RELEASE=Release_1_8_13 UPDATEHTMLEQS=Y - # We can tighten up the warnings here. Math im image captions should only generate - # \f warnings. All other latex math should be double escaped (\\) like (\\Phi) for - # html image captions. - - grep "warning:" _build/doxygen_warn_nortd_log.txt | grep -v 'Illegal command f as part of a \\image' | tee doxy_errors - - test ! -s doxy_errors - - - env: - - JOB="x86 verification testing" - - DO_REGRESSION_TESTS=false - script: - - cd .testing - - echo 'Build executables...' && echo -en 'travis_fold:start:script.1\\r' - - time make all - - echo -en 'travis_fold:end:script.1\\r' - - time make -k -s test - - make test.summary - - # NOTE: Code coverage upload is here to reduce load imbalance - # We do coverage with the regressions if part of a pull request - # otherwise as a separate job. - - if: type = pull_request - env: - - JOB="x86 Regression testing" - - DO_REGRESSION_TESTS=true - - MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} - - MOM_TARGET_LOCAL_BRANCH=${TRAVIS_BRANCH} - script: - - cd .testing - - echo 'Build executables...' && echo -en 'travis_fold:start:script.1\\r' - - time make build.regressions - - echo -en 'travis_fold:end:script.1\\r' - - time make -k -s test.regressions - - make test.summary - - - arch: arm64 - env: - - JOB="ARM64 verification testing" - - DO_REGRESSION_TESTS=false - - DO_REPRO_TESTS=false - script: - - cd .testing - - echo 'Build executables...' && echo -en 'travis_fold:start:script.1\\r' - - time make all - - echo -en 'travis_fold:end:script.1\\r' - - time make -k -s test - - make test.summary From e5580e3b96675aa91a2ef93366190483cdde5c36 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 8 Jun 2022 17:04:37 -0400 Subject: [PATCH 38/68] Re-factored GFDL gitlab pipeline The MOM6 pipeline commands were scripted using make in the file MOM6-examples/tools/MRS/Makefile. This was trying to encapsulate the commands used in the pipeline so they could also be used at the command line (for emulating the pipeline). However, it required emulating the temporary/transient work-spaces provided by gitlab. Also, the Makefile was impenetrable. New approach: - Create a persistent working space for each pipeline, just as you'd work interactively in a single working directory - Use the same commands in .gitlab-ci.yml as we'd use interactively (these still use the tools/MRS Makefile.build and Makefile.run) - The compute stage of tasks is now a bash script (.gitlab/mom6-ci-run-script.sh) which will work/can be submitted from your working directory - The caching of results from each run (gnu/intel/pgi, symmetric/nonsymmetric/layout/etc) is stored locally in the same working directory so we don't have to look elsewhere for the results - Using the "fetch" strategy allows later stages to startup in mere seconds (previously re-cloning the repo took minutes) This does not shorten the turn around significantly but I believe it is a lot easy to follow and emulate. Todo: - split up the run stage to reduce it from 41+ minutes to ~13 minutes. --- .gitlab-ci.yml | 208 ++++++++++++++++++++++++++-------- .gitlab/mom6-ci-run-script.sh | 129 +++++++++++++++++++++ 2 files changed, 289 insertions(+), 48 deletions(-) create mode 100644 .gitlab/mom6-ci-run-script.sh diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index c22bfc4144..ba22339753 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,86 +1,155 @@ stages: + - setup - builds - run - tests - cleanup +# JOB_DIR points to a persistent working space used for most stages in this pipeline but +# it is unique to this pipeline. +# We use the "fetch" strategy to speed up the startup of stages variables: - CACHE_DIR: "/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/cache/" + JOB_DIR: "/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/builds/$CI_PIPELINE_ID" + GIT_STRATEGY: fetch - -# Merges MOM6 with dev/gfdl. Changes directory to test directory, if it exists. -# - set cache location -# - get MOM6-examples/tools/MRS scripts by cloning Gaea-stats and then MOM6-examples -# - set working directory to MOM6-examples -# - pull down latest of dev/gfdl (MOM6-examples might be ahead of Gaea-stats) +# Start all stages in $JOB_DIR/.../MOM6-examples +# Exception: for "setup" stages MOM6-examples has not yet been cloned so the stage starts in $JOB_DIR before_script: - - echo Cache directory set to $CACHE_DIR - - echo -e "\e[0Ksection_start:`date +%s`:before[collapsed=true]\r\e[0KPre-script" - - git clone https://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git tests - - cd tests && git submodule init && git submodule update - - cd MOM6-examples && git checkout dev/gfdl && git pull - - echo -e "\e[0Ksection_end:`date +%s`:before\r\e[0K" - -# Tests that merge with dev/gfdl works. + - echo -e "\e[0Ksection_start:`date +%s`:dir_stuff[collapsed=true]\r\e[0KChanging directories to $JOB_DIR" + - echo Job directory set to $JOB_DIR + - mkdir -p $JOB_DIR + - cd $JOB_DIR + - test -d Gaea-stats-MOM6-examples/MOM6-examples && cd Gaea-stats-MOM6-examples/MOM6-examples + - pwd + - echo -e "\e[0Ksection_end:`date +%s`:dir_stuff\r\e[0K" + +# Test that merge with dev/gfdl works. merge: - stage: builds + stage: setup tags: - ncrc4 script: - cd $CI_PROJECT_DIR - git pull --no-edit https://github.com/NOAA-GFDL/MOM6.git dev/gfdl +# Setup the persistent JOB_DIR for all subsequent stages +clone: + stage: setup + tags: + - ncrc4 + before_script: + - echo -e "\e[0Ksection_start:`date +%s`:dir_stuff[collapsed=true]\r\e[0KChanging directories to $JOB_DIR" + - cd $CI_PROJECT_DIR + - git submodule init ; git submodule update + - echo Job directory set to $JOB_DIR + - mkdir -p $JOB_DIR + - cd $JOB_DIR + - test -d Gaea-stats-MOM6-examples && rm -rf Gaea-stats-MOM6-examples # In case we are re-running this stage + - pwd + - echo -e "\e[0Ksection_end:`date +%s`:dir_stuff\r\e[0K" + script: + - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCloning repository tree" + - git clone https://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git + - cd Gaea-stats-MOM6-examples + - git submodule init + - git submodule update + - cd MOM6-examples + - git checkout dev/gfdl + - git submodule init + - git submodule deinit src/MOM6 # No need to clone the version recorded in MOM6-examples + - git submodule update --recursive + - make -f tools/MRS/Makefile.clone clone_gfdl # Extras and link to datasets + - bash tools/MRS/generate_manifest.sh . tools/MRS/excluded-expts.txt > manifest.mk + - cd src + - rm -rf MOM6 + - cp -rp $CI_PROJECT_DIR MOM6 + - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + # Compiles gnu:repro: stage: builds tags: - ncrc4 script: - - time make -f tools/MRS/Makefile MOM6_SRC=../.. pipeline-build-repro-gnu -s -j - - time make -f tools/MRS/Makefile MOM6_SRC=../.. pipeline-build-static-gnu -s -j + - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_gnu" + - time make -f tools/MRS/Makefile.build repro_gnu -s -j + - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - echo -e "\e[0Ksection_start:`date +%s`:compile2[collapsed=true]\r\e[0KCompiling target static_gnu" + - time make -f tools/MRS/Makefile.build static_gnu -s -j + - echo -e "\e[0Ksection_end:`date +%s`:compile2\r\e[0K" -gnu:ocean-only-nolibs: +gnu:debug: stage: builds tags: - ncrc4 script: - - make -f tools/MRS/Makefile MOM6_SRC=../.. pipeline-build-gnu-oceanonly-nolibs + - echo -e "\e[0Ksection_start:`date +%s`:compile2[collapsed=true]\r\e[0KCompiling target debug_gnu" + - time make -f tools/MRS/Makefile.build debug_gnu -s -j + - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" -gnu:ice-ocean-nolibs: +gnu:ocean-only-nolibs: stage: builds tags: - ncrc4 script: - - make -f tools/MRS/Makefile MOM6_SRC=../.. pipeline-build-gnu-iceocean-nolibs + - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target gnu ocean-only no-libs" + - mkdir -p build-ocean-only-nolibs + - cd build-ocean-only-nolibs + - make -f ../tools/MRS/Makefile.build ./gnu/env BUILD=. -s + - ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/solo_driver,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/FMS1 + - sed -i '/FMS1\/.*\/test_/d' path_names + - ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF" path_names + - (source gnu/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) + - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" -intel:repro: +gnu:ice-ocean-nolibs: stage: builds tags: - ncrc4 script: - - time make -f tools/MRS/Makefile MOM6_SRC=../.. pipeline-build-repro-intel -s -j + - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target gnu ice-ocean-SIS2 no-libs" + - mkdir -p build-ice-ocean-SIS2-nolibs + - cd build-ice-ocean-SIS2-nolibs + - make -f ../tools/MRS/Makefile.build ./gnu/env BUILD=. -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/{FMS1,coupler,icebergs,ice_param,land_null,atmos_null} + - sed -i '/FMS1\/.*\/test_/d' path_names + - ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names + - (source gnu/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) + - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" -pgi:repro: +intel:repro: stage: builds tags: - ncrc4 script: - - time make -f tools/MRS/Makefile MOM6_SRC=../.. pipeline-build-repro-pgi -s -j + - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_intel" + - time make -f tools/MRS/Makefile.build repro_intel -s -j + - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" -gnu:debug: +pgi:repro: stage: builds tags: - ncrc4 script: - - time make -f tools/MRS/Makefile MOM6_SRC=../.. pipeline-build-debug-gnu -s -j + - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_pgi" + - time make -f tools/MRS/Makefile.build repro_pgi -s -j + - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" # Runs +# +# The main "run" stage uses the script .gitlab/mom6-ci-run-script.sh + run: stage: run tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-run + - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_examples_tests --output=log.$CI_PIPELINE_ID --wait src/MOM6/.gitlab/mom6-ci-run-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_PIPELINE_ID ; echo Job returned normally ) || ( cat log.$CI_PIPELINE_ID ; echo Job failed ; exit 911 ) + - test -f .CI-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) + - git checkout . # reset working space so we can use it to compare against + +# These "run" stages replace the "before_script" and so start in the transient work-space provided by gitlab +# We work here to avoid collisions with parallel jobs gnu.testing: stage: run @@ -119,47 +188,65 @@ intel.testing: - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_PIPELINE_ID --wait job.sh && make test || cat log.$CI_PIPELINE_ID # Tests -gnu:non-symmetric: +# +# stats file tests involve comparing the check sums of the generated files against the check sums in the stats-repo +# log file tests involve comparing the check sums of the generated files against the check sums in MOM6-examples + +gnu:symmetric: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-gnu_non_symmetric + - tar --one-top-level -xf gnu_all_sym.tar + - ( cd gnu_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -gnu:symmetric: +gnu:non-symmetric: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-gnu_symmetric + - tar --one-top-level -xf gnu_all_nonsym.tar + - ( cd gnu_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -gnu:memory: +gnu:layout: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-gnu_memory + - tar --one-top-level -xf gnu_all_layout.tar + - ( cd gnu_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) gnu:static: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-gnu_static + - tar --one-top-level -xf gnu_all_static.tar + - ( cd gnu_all_static/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + +gnu:debugx: + stage: tests + tags: + - ncrc4 + script: + - tar --one-top-level -xf gnu_ocean_only_debug.tar + - ( cd gnu_ocean_only_debug/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) gnu:restart: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-gnu_restarts + - tar xf gnu_restarts.tar # NOTE this unpacks in MOM6-examples (not a new directory) + - make -f tools/MRS/Makefile.restart restart_gnu_ocean_only restart_gnu_ice_ocean_SIS2 -s -k gnu:params: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-params_gnu_symmetric + - tar --one-top-level -xf gnu_params.tar + - ( cd gnu_params/ ; md5sum `find * -type f` ) | md5sum -c allow_failure: true intel:symmetric: @@ -167,48 +254,73 @@ intel:symmetric: tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-intel_symmetric + - tar --one-top-level -xf intel_all_sym.tar + - ( cd intel_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) intel:non-symmetric: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-intel_non_symmetric + - tar --one-top-level -xf intel_all_nonsym.tar + - ( cd intel_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -intel:memory: +intel:layout: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-intel_memory + - tar --one-top-level -xf intel_all_layout.tar + - ( cd intel_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + +intel:params: + stage: tests + tags: + - ncrc4 + script: + - tar --one-top-level -xf intel_params.tar + - ( cd intel_params/ ; md5sum `find * -type f` ) | md5sum -c + allow_failure: true pgi:symmetric: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-pgi_symmetric + - tar --one-top-level -xf pgi_all_sym.tar + - ( cd pgi_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) pgi:non-symmetric: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-pgi_non_symmetric + - tar --one-top-level -xf pgi_all_nonsym.tar + - ( cd pgi_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -pgi:memory: +pgi:layout: stage: tests tags: - ncrc4 script: - - make -f tools/MRS/Makefile mom6-pipeline-test-pgi_memory + - tar --one-top-level -xf pgi_all_layout.tar + - ( cd pgi_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + +pgi:params: + stage: tests + tags: + - ncrc4 + script: + - tar --one-top-level -xf pgi_params.tar + - ( cd pgi_params/ ; md5sum `find * -type f` ) | md5sum -c + allow_failure: true +# We cleanup ONLY if the preceding stages were completed successfully cleanup: stage: cleanup tags: - ncrc4 before_script: - - echo Skipping submodule update + - echo Skipping usual preamble script: - - rm $CACHE_DIR/*$CI_PIPELINE_ID.tgz + - rm -rf $JOB_DIR diff --git a/.gitlab/mom6-ci-run-script.sh b/.gitlab/mom6-ci-run-script.sh new file mode 100644 index 0000000000..37e5533622 --- /dev/null +++ b/.gitlab/mom6-ci-run-script.sh @@ -0,0 +1,129 @@ +#!/bin/bash + +sect=none +clean_stats () { # fn to clean up stats files + find [oicl]* -name "*.stats.*[a-z][a-z][a-z]" -delete +} +section_start () { # fn to print fold-able banner in CI + echo -e "\e[0Ksection_start:`date +%s`:$1[collapsed=true]\r\e[0K$2" + sect=$1 +} +section_end () { # fn to close fold-able banner in CI and clean up stats + echo -e "\e[0Ksection_end:`date +%s`:$sect\r\e[0K" + clean_stats +} +check_for_core_files () { + EXIT_CODE=0 + find [oilc]* -name core | grep . && EXIT_CODE=1 + if [[ $EXIT_CODE -gt 0 ]] + then + echo "Error: core files found!" + exit 911 + fi +} + +# Make sure we have a clean start +clean_stats +find [oilc]* -name core -delete +rm -f .CI-BATCH-SUCCESS + +set -e +set -v + +# Run symmetric gnu regressions +section_start gnu_all_sym "Running symmetric gnu" +time make -f tools/MRS/Makefile.run gnu_all -s -j +tar cf gnu_all_sym.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` +tar cf gnu_params.tar `find [oicl]* -name "*_parameter_doc.*"` +check_for_core_files +section_end + +# Run non-symmetric gnu regressions +section_start gnu_all_nonsym "Running nonsymmetric gnu" +time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.gnu -s # work around +time make -f tools/MRS/Makefile.run gnu_all -s -j MEMORY=dynamic_nonsymmetric +tar cf gnu_all_nonsym.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` +check_for_core_files +section_end + +# Run symmetric gnu regressions with alternate layout +section_start gnu_all_layout "Running symmetric gnu with alternate layouts" +time make -f tools/MRS/Makefile.run gnu_all -s -j LAYOUT=alt +tar cf gnu_all_layout.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` +check_for_core_files +section_end + +# Run symmetric gnu regressions with debug executable +section_start gnu_ocean_only_debug "Running symmetric gnu_ocean_only with debug executable" +time make -f tools/MRS/Makefile.run gnu_ocean_only -s -j MODE=debug +tar cf gnu_ocean_only_debug.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` +check_for_core_files +section_end + +# Run symmetric static gnu regressions +section_start gnu_all_static "Running symmetric gnu with static executable" +time make -f tools/MRS/Makefile.run gnu_static_ocean_only MEMORY=static -s -j +tar cf gnu_all_static.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` +check_for_core_files +section_end + +section_start gnu_restarts "Running symmetric gnu restart tests" +time make -f tools/MRS/Makefile.restart gnu_ocean_only -s -j RESTART_STAGE=01 +time make -f tools/MRS/Makefile.restart gnu_ice_ocean_SIS2 -s -j RESTART_STAGE=01 +time make -f tools/MRS/Makefile.restart gnu_ocean_only -s -j RESTART_STAGE=02 +time make -f tools/MRS/Makefile.restart gnu_ice_ocean_SIS2 -s -j RESTART_STAGE=02 +time make -f tools/MRS/Makefile.restart gnu_ocean_only -s -j RESTART_STAGE=12 +time make -f tools/MRS/Makefile.restart gnu_ice_ocean_SIS2 -s -j RESTART_STAGE=12 +tar cf gnu_restarts.tar `find [oilc]*/ -path "*/??.ignore/*" -name "ocean.stats.*[a-z][a-z][a-z]"` +check_for_core_files +find [oilc]* -name "*.ignore" -type d -prune -exec rm -rf {} \; +section_end + +# Run symmetric intel regressions +section_start intel_all_sym "Running symmetric intel" +time make -f tools/MRS/Makefile.run intel_all -s -j +tar cf intel_all_sym.tar `find [a-z]* -name "*.stats.*[a-z][a-z][a-z]"` +tar cf intel_params.tar `find [a-z]* -name "*_parameter_doc.*"` +check_for_core_files +section_end + +# Run non-symmetric intel regressions +section_start intel_all_nonsym "Running nonsymmetric intel" +time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.intel -s # work around +time make -f tools/MRS/Makefile.run intel_all -s -j MEMORY=dynamic_nonsymmetric +tar cf intel_all_nonsym.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` +check_for_core_files +section_end + +# Run symmetric intel regressions with alternate layout +section_start intel_all_layout "Running symmetric intel with alternate layouts" +time make -f tools/MRS/Makefile.run intel_all -s -j LAYOUT=alt +tar cf intel_all_layout.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` +check_for_core_files +section_end + +# Run symmetric pgi regressions +section_start pgi_all_sym "Running symmetric pgi" +time make -f tools/MRS/Makefile.run pgi_all -s -j +tar cf pgi_all_sym.tar `find [a-z]* -name "*.stats.*[a-z][a-z][a-z]"` +tar cf pgi_params.tar `find [a-z]* -name "*_parameter_doc.*"` +check_for_core_files +section_end + +# Run non-symmetric pgi regressions +section_start pgi_all_nonsym "Running nonsymmetric pgi" +time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.pgi -s # work around +time make -f tools/MRS/Makefile.run pgi_all -s -j MEMORY=dynamic_nonsymmetric +tar cf pgi_all_nonsym.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` +check_for_core_files +section_end + +# Run symmetric pgi regressions with alternate layout +section_start pgi_all_layout "Running symmetric pgi with alternate layouts" +time make -f tools/MRS/Makefile.run gnu_all -s -j LAYOUT=alt +tar cf pgi_all_layout.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` +check_for_core_files +section_end + +# Indicate all went well +touch .CI-BATCH-SUCCESS From 546312aede3d4b8963504a173eb62406634d0c51 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 8 Apr 2022 21:23:09 -0400 Subject: [PATCH 39/68] Adds "makedep" script to replace mkmf `mkmf` is an external dependency that that uses a multi-stage approach to building a Makefile with dependencies but fails to yield an optimal link stage (it links everything, including unused modules). `makedep` is a bash script that constructs the link stage for as many programs as found, links only the necessary object files*, and is coded solely in bash thus removing an external dependency. The addition of this script is the bulk of this commit. Code changes: - when more than one program is encountered the executable is given the name following "program". Since all the programs were named "MOM_main" I have had to change them to provide unique names: - MOM_sum_driver.F90, "program MOM_main" has been changed to "MOM_sum_driver" - solo_driver/MOM_driver.F90, "program MOM_main" has been changed to "MOM6" Script changes: - Makefile.in now has a target "depend" to generate dependencies using makedep - configure.ac no longer checks for list_paths and mkmf - configure.ac now invokes "make depend" in place of mkmf - Added target "unit" to .testing/Makefile to build all programs in config_src/drivers/unit_drivers Ugliness: - I had to add a -f option to makedep to handle FMS non-standard macros - To compile FMS, the dependencies Makefile is passed CPPDEFS in addition to CPPFLAGS. - The first version of makedep was consistent with the standard gmake rules which were sufficient to build MOM6. Adding -f "rule command" allows FMS to be built: makemake -f '$(FC) $(FFLAGS) $(CPPFLAGS) $(CPPDEFS) -c $<' -x libFMS.a ../src - .inc suffix is included when searching for include directories - FMS has includes of .inc files which modify the search path passed to /lib/cpp . - Handling of badly formatted comments when searching for modules - FMS fm_util.F90, that generates fm_util_mod.mod, has some odd strings in a comment on the module declaration line. This was causing wierdness in the script. - Not just Fortran dependencies - makedep needs to also generate rules for C files in order to build FMS Todo: [ ] *A work around is used for TEOS10 (gsw_*) functions that are in separate object files even though accessed via a module (WTFortran!!!) --- .testing/Makefile | 19 +- ac/Makefile.in | 10 +- ac/configure.ac | 43 +--- ac/deps/Makefile | 21 +- ac/deps/Makefile.fms.in | 8 +- ac/deps/configure.fms.ac | 36 +-- ac/makedep | 225 ++++++++++++++++++ config_src/drivers/solo_driver/MOM_driver.F90 | 4 +- .../drivers/unit_drivers/MOM_sum_driver.F90 | 4 +- 9 files changed, 262 insertions(+), 108 deletions(-) create mode 100755 ac/makedep diff --git a/.testing/Makefile b/.testing/Makefile index d9feb25f0b..6e61ec8f39 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -119,10 +119,6 @@ DIMS ?= t l h z q r # Dependencies DEPS = deps -# mkmf, list_paths (GFDL build toolchain) -LIST_PATHS := $(DEPS)/bin/list_paths -MKMF := $(DEPS)/bin/mkmf - #--- # Test configuration @@ -295,7 +291,7 @@ build/%/MOM6: build/%/Makefile # Use autoconf to construct the Makefile for each target .PRECIOUS: $(foreach b,$(BUILDS),build/$(b)/Makefile) -build/%/Makefile: ../ac/configure ../ac/Makefile.in $(DEPS)/lib/libFMS.a $(MKMF) $(LIST_PATHS) +build/%/Makefile: ../ac/configure ../ac/Makefile.in $(DEPS)/lib/libFMS.a mkdir -p $(@D) cd $(@D) \ && $(MOM_ENV) ../../../ac/configure $(MOM_ACFLAGS) --with-framework=$(FRAMEWORK) \ @@ -308,7 +304,7 @@ build/%/Makefile: ../ac/configure ../ac/Makefile.in $(DEPS)/lib/libFMS.a $(MKMF) # Fetch the regression target codebase build/target/Makefile build/opt_target/Makefile: \ - $(TARGET_CODEBASE)/ac/configure $(DEPS)/lib/libFMS.a $(MKMF) $(LIST_PATHS) + $(TARGET_CODEBASE)/ac/configure $(DEPS)/lib/libFMS.a mkdir -p $(@D) cd $(@D) \ && $(MOM_ENV) ../../$(TARGET_CODEBASE)/ac/configure $(MOM_ACFLAGS) \ @@ -337,7 +333,7 @@ $(DEPS)/lib/libFMS.a: $(DEPS)/fms/build/libFMS.a $(DEPS)/fms/build/libFMS.a: $(DEPS)/fms/build/Makefile $(MAKE) -C $(DEPS) fms/build/libFMS.a -$(DEPS)/fms/build/Makefile: $(DEPS)/fms/src/configure $(DEPS)/Makefile.fms.in $(MKMF) $(LIST_PATHS) +$(DEPS)/fms/build/Makefile: $(DEPS)/fms/src/configure $(DEPS)/Makefile.fms.in $(FMS_ENV) $(MAKE) -C $(DEPS) fms/build/Makefile $(MAKE) -C $(DEPS) fms/build/Makefile @@ -353,13 +349,6 @@ $(DEPS)/fms/src/configure: ../ac/deps/configure.fms.ac $(DEPS)/Makefile $(FMS_SO $(DEPS)/fms/src: $(DEPS)/Makefile make -C $(DEPS) fms/src -# mkmf -$(MKMF) $(LIST_PATHS): $(DEPS)/mkmf - $(MAKE) -C $(DEPS) bin/$(@F) - -$(DEPS)/mkmf: $(DEPS)/Makefile - $(MAKE) -C $(DEPS) mkmf - # Dependency init $(DEPS)/Makefile: ../ac/deps/Makefile mkdir -p $(@D) @@ -693,7 +682,7 @@ test.summary: .PHONY: unit.cov unit.cov: build/unit/MOM_new_unit_tests.gcov -work/unit/std.out: build/unit/MOM6 +work/unit/std.out: build/unit/MOM_unit_tests if [ $(REPORT_COVERAGE) ]; then \ find build/unit -name *.gcda -exec rm -f '{}' \; ; \ fi diff --git a/ac/Makefile.in b/ac/Makefile.in index 7be6c5bf2b..711fab1f6f 100644 --- a/ac/Makefile.in +++ b/ac/Makefile.in @@ -51,11 +51,16 @@ CPPFLAGS = @CPPFLAGS@ FFLAGS = @FCFLAGS@ LDFLAGS = @LDFLAGS@ @LIBS@ +SRC_DIRS = @SRC_DIRS@ + # Gather modulefiles TMPFILES = $(wildcard *.mod) -include Makefile.mkmf +-include Makefile.dep +.PHONY: depend +depend: + ../../../ac/makedep -o Makefile.dep $(SRC_DIRS) # Delete any files associated with configuration (including the Makefile). .PHONY: distclean @@ -64,9 +69,8 @@ distclean: clean rm -f config.log rm -f config.status rm -f Makefile - # mkmf output rm -f path_names - rm -f Makefile.mkmf + rm -f Makefile.dep # This deletes all files generated by autoconf, including configure. diff --git a/ac/configure.ac b/ac/configure.ac index 00c8917734..02e39c63a0 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -223,46 +223,13 @@ AC_COMPILE_IFELSE( ] ) - -# Search for mkmf build tools -AC_PATH_PROG([LIST_PATHS], [list_paths]) -AS_IF([test -z "$LIST_PATHS"], [ - AC_PATH_PROG([LIST_PATHS], [list_paths], [], ["$PATH:${srcdir}/ac/deps/bin"]) - AS_IF([test -z "$LIST_PATHS"], - [AC_MSG_ERROR([Could not find list_paths.])], - [AC_SUBST(PATH, ["$PATH:${srcdir}/ac/deps/bin"])]) - ] -) - -AC_PATH_PROG([MKMF], [mkmf]) -AS_IF([test -z "$MKMF"], [ - AC_PATH_PROG([MKMF], [mkmf], [], ["$PATH:${srcdir}/ac/deps/bin"]) - AS_IF([test -z "$MKMF"], - [AC_MSG_ERROR([Could not find mkmf.])], - [AC_SUBST(PATH, ["$PATH:${srcdir}/ac/deps/bin"])]) - ] -) - - -# NOTE: MEM_LAYOUT unneeded if we shift to MOM_memory.h.in template -AC_CONFIG_COMMANDS([path_names], - [list_paths -l \ - ${srcdir}/src \ - ${MODEL_FRAMEWORK} \ - ${srcdir}/config_src/ext* \ - ${DRIVER_DIR} \ - ${MEM_LAYOUT}], - [MODEL_FRAMEWORK=$MODEL_FRAMEWORK - MEM_LAYOUT=$MEM_LAYOUT - DRIVER_DIR=$DRIVER_DIR] -) - - -AC_CONFIG_COMMANDS([Makefile.mkmf], - [mkmf -p MOM6 -m Makefile.mkmf path_names]) - +SRC_DIRS="${srcdir}/src ${MODEL_FRAMEWORK} ${srcdir}/config_src/external ${DRIVER_DIR} ${MEM_LAYOUT}" +AC_CONFIG_COMMANDS([Makefile.dep], + [make depend]) # Prepare output AC_SUBST(CPPFLAGS) +AC_SUBST(SRC_DIRS) AC_CONFIG_FILES([Makefile:${srcdir}/ac/Makefile.in]) AC_OUTPUT + diff --git a/ac/deps/Makefile b/ac/deps/Makefile index 0ed4fd19a7..f56b762883 100644 --- a/ac/deps/Makefile +++ b/ac/deps/Makefile @@ -7,10 +7,6 @@ SHELL = bash MAKEFLAGS += -R -# mkmf, list_paths (GFDL build toolchain) -MKMF_URL ?= https://github.com/NOAA-GFDL/mkmf.git -MKMF_COMMIT ?= master - # FMS framework FMS_URL ?= https://github.com/NOAA-GFDL/FMS.git FMS_COMMIT ?= 2019.01.03 @@ -30,19 +26,14 @@ FMS_SOURCE = $(call SOURCE,fms/src) # Rules .PHONY: all -all: bin/mkmf bin/list_paths lib/libFMS.a +all: bin/makedep lib/libFMS.a #--- -# mkmf checkout +# makedep script -bin/mkmf bin/list_paths: mkmf +bin/makedep: ../../ac/makedep mkdir -p $(@D) - cp $^/$@ $@ - -mkmf: - git clone $(MKMF_URL) $@ - git -C $@ checkout $(MKMF_COMMIT) - + cp $^ $@ #--- # FMS build @@ -64,7 +55,7 @@ fms/build/libFMS.a: fms/build/Makefile make -C fms/build libFMS.a -fms/build/Makefile: Makefile.fms.in fms/src/configure bin/mkmf bin/list_paths +fms/build/Makefile: Makefile.fms.in fms/src/configure bin/makedep mkdir -p fms/build cp Makefile.fms.in fms/src/Makefile.in cd $(@D) && ../src/configure --srcdir=../src @@ -87,4 +78,4 @@ clean: .PHONY: distclean distclean: clean - rm -rf fms mkmf + rm -rf fms diff --git a/ac/deps/Makefile.fms.in b/ac/deps/Makefile.fms.in index 0286d94b58..499a1a6a72 100644 --- a/ac/deps/Makefile.fms.in +++ b/ac/deps/Makefile.fms.in @@ -54,7 +54,13 @@ FFLAGS = @FCFLAGS@ LDFLAGS = @LDFLAGS@ ARFLAGS = @ARFLAGS@ +SRC_DIRS = @SRC_DIRS@ + # Gather modulefiles TMPFILES = $(wildcard *.mod) -include Makefile.mkmf +-include Makefile.dep + +.PHONY: depend +depend: + ../../bin/makedep -o Makefile.dep -f '$$(FC) $$(CPPFLAGS) $$(CPPDEFS) $$(FFLAGS) -c $$<' -x libFMS.a -d $(SRC_DIRS) diff --git a/ac/deps/configure.fms.ac b/ac/deps/configure.fms.ac index bf899126cc..4dc1a6614f 100644 --- a/ac/deps/configure.fms.ac +++ b/ac/deps/configure.fms.ac @@ -158,38 +158,6 @@ AX_FC_ALLOW_ARG_MISMATCH FCFLAGS="$FCFLAGS $ALLOW_ARG_MISMATCH_FCFLAGS" -# Search for mkmf build tools -AC_PATH_PROG([LIST_PATHS], [list_paths]) -AS_IF([test -z "$LIST_PATHS"], [ - AC_PATH_PROG([LIST_PATHS], [list_paths], [], ["$PATH:${srcdir}/../../bin"]) - AS_IF([test -z "$LIST_PATHS"], - [AC_MSG_ERROR([Could not find list_paths.])], - [AC_SUBST(PATH, ["$PATH:${srcdir}/../../bin"])]) - ] -) - -AC_PATH_PROG([MKMF], [mkmf]) -AS_IF([test -z "$MKMF"], [ - AC_PATH_PROG([MKMF], [mkmf], [], ["$PATH:${srcdir}/../../bin"]) - AS_IF([test -z "$MKMF"], - [AC_MSG_ERROR([Could not find mkmf.])], - [AC_SUBST(PATH, ["$PATH:${srcdir}/../../bin"])]) - ] -) - - -# MKMF commands -AC_CONFIG_COMMANDS([path_names], - [${LIST_PATHS} -l ${srcdir}], - [LIST_PATHS=${LIST_PATHS}] -) - - -AC_CONFIG_COMMANDS([mkmf], - [${MKMF} -p libFMS.a -m Makefile.mkmf path_names], - [MKMF=${MKMF}] -) - # Autoconf does not configure the archiver (ar), as it is handled by Automake. # TODO: Properly configure this tool. For now, we hard-set this to `ar`. @@ -198,8 +166,12 @@ ARFLAGS=rv AC_SUBST(AR) AC_SUBST(ARFLAGS) +SRC_DIRS="../src" +AC_CONFIG_COMMANDS([Makefile.dep], + [make depend]) # Prepare output AC_SUBST(CPPFLAGS) +AC_SUBST(SRC_DIRS) AC_CONFIG_FILES(Makefile) AC_OUTPUT diff --git a/ac/makedep b/ac/makedep new file mode 100755 index 0000000000..cb0a8896e3 --- /dev/null +++ b/ac/makedep @@ -0,0 +1,225 @@ +#!/bin/bash + +usage() { + echo "Construct Makfile.dep containing dependencies for F90 source code." + echo + echo "Syntax:" $0 "[-h|d] [-o FILE] [-x EXEC] PATH [PATH] [...]" + echo + echo "arguments:" + echo " PATH Directories containing source code. All subdirectories and" + echo " symbolic links are followed." + echo + echo "options:" + echo " -h Print this help message." + echo " -d Annotate the makefile with extra information." + echo " -o FILE Construct dependencies in FILE instead of Makefile.dep ." + echo " -x EXEC Name of executable to build. Fails if more than one" + echo " is found. If EXEC ends in .a then a library is built." + echo " -f CMD String to use in compile rule. Default is:" + echo " '$(FC) $(FFLAGS) $(CPPFLAGS) -c $<'" +} + +# Defaults +makefile=Makefile.dep +debug=0 +executable="" +librarymode=0 +compile_line='$(FC) $(FFLAGS) $(CPPFLAGS) -c $<' + +while getopts dho:x:f: option +do + case "${option}" + in + d)debug=1;; + h)usage; exit;; + o)makefile=${OPTARG};; + x)executable=${OPTARG};; + f)compile_line=${OPTARG};; + esac +done +SRC_DIRS=${@:$OPTIND} + +if [ -z "$SRC_DIRS" ]; then + echo "Error: no search path specified on command line!" + exit 1 +fi + +# Scan everything (Fortran related) (Fortran related) +A=$(find -L ${SRC_DIRS} \( -name "*.F90" -o -name "*.f90" \) ) # all source files +I=`find -L ${SRC_DIRS} \( -name "*.h" -o -name "*.inc" \) | xargs dirname | sort | uniq | sed 's:^:-I:'` # include paths to pass to cpp when checking to see which .h files are used +O=() +externals=() +declare -A o2src o2mod o2use o2H o2head o2inc p2o o2p all_modules +for F in ${A}; do # F is the relative path to source file + f=`basename $F` # file name stripped of path + o=${f/.?90/}.o # object file name + o2src["$o"]=$F + m=`egrep -i "^ *module " $F | sed 's/ *!.*//' | grep -vi procedure | tr '[A-Z]' '[a-z]' | sed 's/.*module *//' | tr -d '\r' | sed 's/$/.mod/' ` # name of module file(s) #### FAILS IF NO MODULE, DOES IT WORK FOR 2+? + u=`sed 's/!.*//' $F | egrep -i "^ *use " | sed 's/\ *[uU][sS][eE]\ *\([a-zA-Z_0-9]*\).*/\1.mod/' | tr '[A-Z]' '[a-z]' | egrep -v "mpi.mod|iso_fortran_env.mod" | sort | uniq ` # list of modules used + if [ ${#m} -ne 0 ]; then + o2mod["$o"]=$m + u=`echo $u | sed s:$m::g` + fi + if [ ${#u} -ne 0 ]; then o2use["$o"]=$u; fi + H=$(/lib/cpp -E -MM $I $F | tr -d '\n' | sed 's:\\::g') # line of form a.o: a.F b.h c.h ... + o2H["$o"]=$H + h=`echo ${H} | cut -d\ -f3- ` # header files + if [ ${#h} -ne 0 ]; then o2head["$o"]=$h; fi + i=`dirname _ignore_/ignore ${h} | grep -v _ignore_ | sort | uniq | sed 's:^:-I:'` # includes for compilation + if [ ${#i} -ne 0 ]; then o2inc["$o"]=$i; fi + p=`egrep -i "^ *program " $F | awk '{print $2}'` # name of program if any + if [ $librarymode -eq 0 ]; then + O+=($o) # List of all objects + if [ ${#p} -ne 0 ]; then p2o["$p"]=$o; o2p["$o"]=$p; fi + else + if [ ${#p} -eq 0 ]; then O+=($o); fi + fi + if [ ${#m} -ne 0 ]; then + for mm in $m; do all_modules["$mm"]=1; done + else + if [ ${#p} -eq 0 ]; then + externals+=($o) + fi + fi +done + +# Augment with C files +A=$(find -L ${SRC_DIRS} -name "*.c" ) # all C source files +declare -A o2c +OC=() +for F in ${A}; do # F is the relative path to source file + f=`basename $F` # file name stripped of path + o=${f/.c/}.o # object file name + o2c["$o"]=$F + H=$(/lib/cpp -E -MM $I $F | tr -d '\n' | sed 's:\\::g') # line of form a.o: a.F b.h c.h ... + o2H["$o"]=$H + h=`echo ${H} | cut -d\ -f3- ` # header files + if [ ${#h} -ne 0 ]; then o2head["$o"]=$h; fi + i=`dirname _ignore_/ignore ${h} | grep -v _ignore_ | sort | uniq | sed 's:^:-I:'` # includes for compilation + if [ ${#i} -ne 0 ]; then o2inc["$o"]=$i; fi + OC+=($o) # List of all objects + #externals+=($o) +done + +if [[ "$executable" == *\.a ]]; then + lib=$executable +else + lib="" + if [ -n "$executable" ]; then + if [ ${#p2o[@]} -eq 0 ]; then + echo 'Error: Option "-p' $executable'"' provided but no programs are present. + exit 1 + elif [ ${#p2o[@]} -eq 1 ]; then # rename executable + p="${o2p[@]}" + o=${p2o[@]} + unset p2o["$p"] + p2o["$executable"]=$o + o2p["$o"]=$executable + else + echo 'Error: Option "-p' $executable'"' cannot be used when multiple programs are present. + exit 1 + fi + fi +fi + +# Write the new makefile +rm -f ${makefile} +echo "#" ${makefile} "created by makedep" >> ${makefile} +echo >> ${makefile} +echo "all:" $lib ${!p2o[@]} >> ${makefile} +echo >> ${makefile} + +echo "# SRC_DIRS is usually set in the parent Makefile but in case is it not we" >> ${makefile} +echo "# record it here from when makedep was previously invoked." >> ${makefile} +echo "SRC_DIRS ?= ${SRC_DIRS}" >> ${makefile} +echo >> ${makefile} + +# Write rule for each object from Fortran +for o in ${O[@]}; do + F=${o2src["$o"]} # source file + m=${o2mod["$o"]} # modules produced with object file + u=${o2use["$o"]} # modules used/needed by object file + H=${o2H["$o"]} # basic C-style rule produced by cpp + i=${o2inc["$o"]} # -I paths needed at compilation + U=() # modules used that are in source tree + NU=() # modules used that were not found in source tree + if [ ${#u} -ne 0 ]; then + for uu in ${u}; do + if [[ ${all_modules["$uu"]} ]]; then + U+=($uu) # source for used module was found + else + NU+=($uu) # did not find source for module + fi + done + fi + if [ $debug -eq 1 ]; then + h=${o2head["$o"]} + p=${o2p["$o"]} + echo "# Source file" $F "produces:" >> ${makefile} + echo "# object:" $o >> ${makefile} + echo "# modules:" $m >> ${makefile} + echo "# uses:" $u >> ${makefile} + echo "# found:" ${U[@]} >> ${makefile} + echo "# missing:" ${NU[@]} >> ${makefile} + echo "# includes:" $h >> ${makefile} + echo "# incpath:" $i >> ${makefile} + echo "# program:" $p >> ${makefile} + fi + + if [ ${#m} -ne 0 ]; then + if [ ${#NU[@]} -ne 0 ]; then + echo "# Note:" $o "uses modules not found the search path:" ${NU[@]} >> ${makefile} + fi + echo $m":" $o >> ${makefile} # a.mod: a.o + fi + echo $H ${U[@]} >> ${makefile} # a.mod a.o: a.F b.mod + echo -e '\t'$compile_line ${i} >> ${makefile} # compile rule +done + +# Write rule for each object from C +for o in ${OC[@]}; do + F=${o2c["$o"]} # source file + H=${o2H["$o"]} # basic C-style rule produced by cpp + i=${o2inc["$o"]} # -I paths needed at compilation + if [ $debug -eq 1 ]; then + h=${o2head["$o"]} + echo "# Source file" $F "produces:" >> ${makefile} + echo "# object:" $o >> ${makefile} + echo "# includes:" $h >> ${makefile} + echo "# incpath:" $i >> ${makefile} + fi + echo $H ${U[@]} >> ${makefile} # a.mod a.o: a.F b.mod + echo -e '\t$(CC) $(CPPDEFS) $(CPPFLAGS) $(CFLAGS) -c $<' ${i} >> ${makefile} # compile rule +done + +if [ ${#lib} -ne 0 ]; then # rule to build library + echo >> ${makefile} + echo $lib: ${O[@]} ${OC[@]} >> ${makefile} + echo -e '\t$(AR) $(ARFLAGS) $@ $^' >> ${makefile} # archive rule +fi + +if [ ${#p2o[@]} -ne 0 ]; then # write rules for linking executables + echo >> ${makefile} + echo "# Note: The following object files are not associated with modules so we assume we should link with them:" ${externals[@]} >> ${makefile} + + echo >> ${makefile} + for p in ${!p2o[@]}; do # p is the executable name + o=${p2o[$p]} + l=$(make -f ${makefile} -B -n -t $o | egrep "\.o$" | sed 's:touch ::' | sort) + echo $p: $l ${externals[@]} >> ${makefile} + echo -e '\t$(LD) -o $@ $^ $(LDFLAGS)' >> ${makefile} # link rule + done +elif [ -z "$lib" ]; then + echo "Warning: no library target specified (with -x) and no programs found!" + echo "Created target 'obj': use 'make obj' to compile object files." + echo >> ${makefile} + echo "obj: ${O[@]}" >> ${makefile} +fi + +echo >> ${makefile} +echo clean: >> ${makefile} + echo -e '\trm -rf' ${!p2o[@]} $lib '*.o *.mod' >> ${makefile} # compile rule + +echo >> ${makefile} +echo "remakedep: # re-invoke makedep" >> ${makefile} +echo -e '\t' $0 -o ${makefile} '$(SRC_DIRS)' >> ${makefile} diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index d6630a0f17..e60240d359 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -1,4 +1,4 @@ -program MOM_main +program MOM6 ! This file is part of MOM6. See LICENSE.md for the license. @@ -692,4 +692,4 @@ subroutine initialize_ocean_only_ensembles() endif end subroutine initialize_ocean_only_ensembles -end program MOM_main +end program MOM6 diff --git a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 index 9f3950ac7f..f962719d93 100644 --- a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 @@ -1,4 +1,4 @@ -program MOM_main +program MOM_sum_driver ! This file is part of MOM6. See LICENSE.md for the license. @@ -215,4 +215,4 @@ subroutine benchmark_init_topog_local(D, G, param_file, max_depth) end subroutine benchmark_init_topog_local -end program MOM_main +end program MOM_sum_driver From 4bcc8490b2e3d477a0847dfe1b94f635a796e0a2 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 14 Jun 2022 16:51:29 -0400 Subject: [PATCH 40/68] Makedep (#1) * Autoconf: Fix makedep path The current path of makedep in the autoconf build assumes a directory tree as in .testing. This patch uses the generalized @srcdir@ to support more general autoconf builds. Other minor changes: * The `depend` rule was split into an explicit Makefile.dep rule and a phony rule to support `make depend` * SRC_DIRS shell assignment is replaced with an Autoconf macro. * A "self-generate" rule was added to `Makefile.in`, so that changes to `Makefile.in` do not trigger a full `./configure` run and regeneration of `.config.status`. This could possibly be extended to support `make depend` but let's first see how this one goes. * Autoconf: makedep uses autoconf var conventions This patch changes the makedep script to use autoconf environment variable conventions rather than mkmf ones: * FCFLAGS in place of FFLAGS * DEFS in place of CPPDEFS * LDFLAGS and LIBS rather than just LDFLAGS (NOTE: This differs from Makefile's LDLFLAGS/LDLIBS) This also allowed us to remove the custom build rule in the FMS build. Note that we now use an autoconf-friendly rule, rather than the default Makefile rule (which was arguably for fixed-format Fortran anyway). The description of autoconf->mkmf translation from the Makefile templates has also been removed, since they're no longer relevant. Some other minor changes in this build: * The `make depend` rule was added to the FMS Makefile template. * @srcdir@ is directly passed to FMS makedep, rather than identically re-defining it in a variable. * Testing: Resolve makedep paths This patch resolves some issues relating to finding the path to makedep in both .testing and more generalized autoconf builds. An explicit autoconf test for makedep has been added, with a default path which includes the `ac` directory relative to `deps`. The .testing directory, which does not lie within `ac`, instead modifies the PATH to allow autoconf to find makedep. The absolute path is determined and substituted into the appropriate Makefile.in template. Some redundant operations in .testing/Makefile have been removed, but I suspect there are even more. Much of the structure required to support mkmf and list_paths is probably no longer needed. --- .testing/Makefile | 3 +- ac/Makefile.in | 65 +++++++++++----------------------------- ac/configure.ac | 17 +++++++---- ac/deps/Makefile | 16 ++++------ ac/deps/Makefile.fms.in | 59 ++++++------------------------------ ac/deps/configure.fms.ac | 22 +++++++++----- ac/makedep | 12 ++++---- 7 files changed, 64 insertions(+), 130 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 6e61ec8f39..972c213032 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -324,7 +324,7 @@ $(TARGET_CODEBASE): # FMS # Set up the FMS build environment variables -FMS_ENV = PATH="${PATH}:../../bin" FCFLAGS="$(FCFLAGS_DEBUG)" +FMS_ENV = PATH="${PATH}:$(realpath ../ac)" FCFLAGS="$(FCFLAGS_DEBUG)" # TODO: *.mod dependencies? $(DEPS)/lib/libFMS.a: $(DEPS)/fms/build/libFMS.a @@ -335,7 +335,6 @@ $(DEPS)/fms/build/libFMS.a: $(DEPS)/fms/build/Makefile $(DEPS)/fms/build/Makefile: $(DEPS)/fms/src/configure $(DEPS)/Makefile.fms.in $(FMS_ENV) $(MAKE) -C $(DEPS) fms/build/Makefile - $(MAKE) -C $(DEPS) fms/build/Makefile $(DEPS)/Makefile.fms.in: ../ac/deps/Makefile.fms.in $(DEPS)/Makefile cp $< $(DEPS) diff --git a/ac/Makefile.in b/ac/Makefile.in index 711fab1f6f..2e482ab0c5 100644 --- a/ac/Makefile.in +++ b/ac/Makefile.in @@ -2,65 +2,34 @@ # # Compiler flags are configured by autoconf's configure script. # -# Source code dependencies are configured by mkmf and list_paths, specified in -# the `Makefile.mkmf` file. -# -# mkmf conventions are close, but not identical, to autoconf. We attempt to -# map the autoconf variables to the mkmf variables. -# -# The following variables are used by Makefiles generated by mkmf. -# -# CC C compiler -# CXX C++ compiler -# FC Fortran compiler (f77 and f90) -# LD Linker -# AR Archiver -# -# CPPDEFS Preprocessor macros -# CPPFLAGS C preprocessing flags -# CXXFLAGS C++ preprocessing flags -# FPPFLAGS Fortran preprocessing flags -# -# CFLAGS C compiler flags -# FFLAGS Fortran compiler flags -# LDFLAGS Linker flags + libraries -# ARFLAGS Archiver flags -# -# OTHERFLAGS Additional flags for all languages (C, C++, Fortran) -# OTHER_CFLAGS Optional C flags -# OTHER_CXXFLAGS Optional C++ flags -# OTHER_FFLAGS Optional Fortran flags -# TMPFILES Placeholder for `make clean` deletion (as `make neat`). -# -# -# NOTES: -# - FPPFLAGS and FFLAGS always appear as a pair, and autoconf does not use -# FPPFLAGS, so FPPFLAGS does not serve much purpose. -# -# - mkmf's FFLAGS does not distinguish between autoconf's fixed-format -# FFLAGS and free-format FCFLAGS. -# -# - LDFLAGS does not distinguish between autoconf's LDFLAGS and LIBS. -# It also places both after the executable rather than just LIBS. +# Source code dependencies are configured by makedep and saved to Makefile.dep. FC = @FC@ LD = @FC@ +MAKEDEP = @MAKEDEP@ -CPPDEFS = @DEFS@ +DEFS = @DEFS@ CPPFLAGS = @CPPFLAGS@ -FFLAGS = @FCFLAGS@ -LDFLAGS = @LDFLAGS@ @LIBS@ - +FCFLAGS = @FCFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ SRC_DIRS = @SRC_DIRS@ -# Gather modulefiles -TMPFILES = $(wildcard *.mod) -include Makefile.dep + +# Generate Makefile from template +Makefile: @srcdir@/ac/Makefile.in config.status + ./config.status + + +# Generate dependencies .PHONY: depend -depend: - ../../../ac/makedep -o Makefile.dep $(SRC_DIRS) +depend: Makefile.dep +Makefile.dep: + $(MAKEDEP) -o Makefile.dep $(SRC_DIRS) + # Delete any files associated with configuration (including the Makefile). .PHONY: distclean diff --git a/ac/configure.ac b/ac/configure.ac index 02e39c63a0..15a14708e0 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -223,13 +223,20 @@ AC_COMPILE_IFELSE( ] ) -SRC_DIRS="${srcdir}/src ${MODEL_FRAMEWORK} ${srcdir}/config_src/external ${DRIVER_DIR} ${MEM_LAYOUT}" -AC_CONFIG_COMMANDS([Makefile.dep], - [make depend]) + +# Verify that makedep is available +AC_PATH_PROG([MAKEDEP], [makedep], [${srcdir}/ac/makedep]) +AC_SUBST([MAKEDEP]) + + +# Generate source list and configure dependency command +AC_SUBST([SRC_DIRS], + ["${srcdir}/src ${MODEL_FRAMEWORK} ${srcdir}/config_src/external ${DRIVER_DIR} ${MEM_LAYOUT}"] +) +AC_CONFIG_COMMANDS([Makefile.dep], [make depend]) # Prepare output -AC_SUBST(CPPFLAGS) -AC_SUBST(SRC_DIRS) +AC_SUBST([CPPFLAGS]) AC_CONFIG_FILES([Makefile:${srcdir}/ac/Makefile.in]) AC_OUTPUT diff --git a/ac/deps/Makefile b/ac/deps/Makefile index f56b762883..af567f6a72 100644 --- a/ac/deps/Makefile +++ b/ac/deps/Makefile @@ -6,7 +6,6 @@ SHELL = bash # Disable implicit variables MAKEFLAGS += -R - # FMS framework FMS_URL ?= https://github.com/NOAA-GFDL/FMS.git FMS_COMMIT ?= 2019.01.03 @@ -26,14 +25,8 @@ FMS_SOURCE = $(call SOURCE,fms/src) # Rules .PHONY: all -all: bin/makedep lib/libFMS.a - -#--- -# makedep script +all: lib/libFMS.a -bin/makedep: ../../ac/makedep - mkdir -p $(@D) - cp $^ $@ #--- # FMS build @@ -45,7 +38,7 @@ bin/makedep: ../../ac/makedep # TODO: track *.mod copy? -lib/libFMS.a: fms/build/libFMS.a fms/build/Makefile +lib/libFMS.a: fms/build/libFMS.a mkdir -p {lib,include} cp fms/build/libFMS.a lib/libFMS.a cp fms/build/*.mod include @@ -55,7 +48,7 @@ fms/build/libFMS.a: fms/build/Makefile make -C fms/build libFMS.a -fms/build/Makefile: Makefile.fms.in fms/src/configure bin/makedep +fms/build/Makefile: Makefile.fms.in fms/src/configure mkdir -p fms/build cp Makefile.fms.in fms/src/Makefile.in cd $(@D) && ../src/configure --srcdir=../src @@ -67,6 +60,7 @@ fms/src/configure: configure.fms.ac $(FMS_SOURCE) | fms/src cp -r m4 $(@D) cd $(@D) && autoreconf -i + fms/src: git clone $(FMS_URL) $@ git -C $@ checkout $(FMS_COMMIT) @@ -74,7 +68,7 @@ fms/src: .PHONY: clean clean: - rm -rf fms/build lib include bin + rm -rf fms/build lib include .PHONY: distclean distclean: clean diff --git a/ac/deps/Makefile.fms.in b/ac/deps/Makefile.fms.in index 499a1a6a72..fc580a8c9e 100644 --- a/ac/deps/Makefile.fms.in +++ b/ac/deps/Makefile.fms.in @@ -1,66 +1,25 @@ -# Makefile template for autoconf builds using mkmf +# Makefile template for FMS # # Compiler flags are configured by autoconf's configure script. # -# Source code dependencies are configured by mkmf and list_paths, specified in -# the `Makefile.mkmf` file. -# -# mkmf conventions are close, but not identical, to autoconf. We attempt to -# map the autoconf variables to the mkmf variables. -# -# The following variables are used by Makefiles generated by mkmf. -# -# CC C compiler -# CXX C++ compiler -# FC Fortran compiler (f77 and f90) -# LD Linker -# AR Archiver -# -# CPPDEFS Preprocessor macros -# CPPFLAGS C preprocessing flags -# CXXFLAGS C++ preprocessing flags -# FPPFLAGS Fortran preprocessing flags -# -# CFLAGS C compiler flags -# FFLAGS Fortran compiler flags -# LDFLAGS Linker flags + libraries -# ARFLAGS Archiver flags -# -# OTHERFLAGS Additional flags for all languages (C, C++, Fortran) -# OTHER_CFLAGS Optional C flags -# OTHER_CXXFLAGS Optional C++ flags -# OTHER_FFLAGS Optional Fortran flags -# TMPFILES Placeholder for `make clean` deletion (as `make neat`). -# -# -# NOTES: -# - FPPFLAGS and FFLAGS always appear as a pair, and autoconf does not use -# FPPFLAGS, so FPPFLAGS does not serve much purpose. -# -# - mkmf's FFLAGS does not distinguish between autoconf's fixed-format -# FFLAGS and free-format FCFLAGS. -# -# - LDFLAGS does not distinguish between autoconf's LDFLAGS and LIBS. -# It also places both after the executable rather than just LIBS. +# Source code dependencies are configured by makedep and saved to Makefile.dep. CC = @CC@ FC = @FC@ LD = @FC@ AR = @AR@ +MAKEDEP = @MAKEDEP@ -CPPDEFS = @DEFS@ +DEFS = @DEFS@ CPPFLAGS = @CPPFLAGS@ -FFLAGS = @FCFLAGS@ +FCFLAGS = @FCFLAGS@ LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ ARFLAGS = @ARFLAGS@ -SRC_DIRS = @SRC_DIRS@ - -# Gather modulefiles -TMPFILES = $(wildcard *.mod) - -include Makefile.dep .PHONY: depend -depend: - ../../bin/makedep -o Makefile.dep -f '$$(FC) $$(CPPFLAGS) $$(CPPDEFS) $$(FFLAGS) -c $$<' -x libFMS.a -d $(SRC_DIRS) +depend: Makefile.dep +Makefile.dep: + $(MAKEDEP) -o Makefile.dep -x libFMS.a @srcdir@ diff --git a/ac/deps/configure.fms.ac b/ac/deps/configure.fms.ac index 4dc1a6614f..4e0c0f1390 100644 --- a/ac/deps/configure.fms.ac +++ b/ac/deps/configure.fms.ac @@ -158,20 +158,26 @@ AX_FC_ALLOW_ARG_MISMATCH FCFLAGS="$FCFLAGS $ALLOW_ARG_MISMATCH_FCFLAGS" +# Verify makedep +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. # TODO: Properly configure this tool. For now, we hard-set this to `ar`. AR=ar ARFLAGS=rv -AC_SUBST(AR) -AC_SUBST(ARFLAGS) +AC_SUBST([AR]) +AC_SUBST([ARFLAGS]) + +AC_CONFIG_COMMANDS([Makefile.dep], [make depend]) -SRC_DIRS="../src" -AC_CONFIG_COMMANDS([Makefile.dep], - [make depend]) +AC_SUBST([CPPFLAGS]) # Prepare output -AC_SUBST(CPPFLAGS) -AC_SUBST(SRC_DIRS) -AC_CONFIG_FILES(Makefile) +AC_CONFIG_FILES([Makefile]) AC_OUTPUT diff --git a/ac/makedep b/ac/makedep index cb0a8896e3..74d9200ce8 100755 --- a/ac/makedep +++ b/ac/makedep @@ -16,7 +16,7 @@ usage() { echo " -x EXEC Name of executable to build. Fails if more than one" echo " is found. If EXEC ends in .a then a library is built." echo " -f CMD String to use in compile rule. Default is:" - echo " '$(FC) $(FFLAGS) $(CPPFLAGS) -c $<'" + echo " '$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<'" } # Defaults @@ -24,7 +24,7 @@ makefile=Makefile.dep debug=0 executable="" librarymode=0 -compile_line='$(FC) $(FFLAGS) $(CPPFLAGS) -c $<' +compile_line='$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<' while getopts dho:x:f: option do @@ -61,7 +61,7 @@ for F in ${A}; do # F is the relative path to source file u=`echo $u | sed s:$m::g` fi if [ ${#u} -ne 0 ]; then o2use["$o"]=$u; fi - H=$(/lib/cpp -E -MM $I $F | tr -d '\n' | sed 's:\\::g') # line of form a.o: a.F b.h c.h ... + H=$(cpp -E -MM $I $F | tr -d '\n' | sed 's:\\::g') # line of form a.o: a.F b.h c.h ... o2H["$o"]=$H h=`echo ${H} | cut -d\ -f3- ` # header files if [ ${#h} -ne 0 ]; then o2head["$o"]=$h; fi @@ -91,7 +91,7 @@ for F in ${A}; do # F is the relative path to source file f=`basename $F` # file name stripped of path o=${f/.c/}.o # object file name o2c["$o"]=$F - H=$(/lib/cpp -E -MM $I $F | tr -d '\n' | sed 's:\\::g') # line of form a.o: a.F b.h c.h ... + H=$(cpp -E -MM $I $F | tr -d '\n' | sed 's:\\::g') # line of form a.o: a.F b.h c.h ... o2H["$o"]=$H h=`echo ${H} | cut -d\ -f3- ` # header files if [ ${#h} -ne 0 ]; then o2head["$o"]=$h; fi @@ -189,7 +189,7 @@ for o in ${OC[@]}; do echo "# incpath:" $i >> ${makefile} fi echo $H ${U[@]} >> ${makefile} # a.mod a.o: a.F b.mod - echo -e '\t$(CC) $(CPPDEFS) $(CPPFLAGS) $(CFLAGS) -c $<' ${i} >> ${makefile} # compile rule + echo -e '\t$(CC) $(DEFS) $(CPPFLAGS) $(CFLAGS) -c $<' ${i} >> ${makefile} # compile rule done if [ ${#lib} -ne 0 ]; then # rule to build library @@ -207,7 +207,7 @@ if [ ${#p2o[@]} -ne 0 ]; then # write rules for linking executables o=${p2o[$p]} l=$(make -f ${makefile} -B -n -t $o | egrep "\.o$" | sed 's:touch ::' | sort) echo $p: $l ${externals[@]} >> ${makefile} - echo -e '\t$(LD) -o $@ $^ $(LDFLAGS)' >> ${makefile} # link rule + echo -e '\t$(LD) $(LDFLAGS) -o $@ $^ $(LIBS)' >> ${makefile} # link rule done elif [ -z "$lib" ]; then echo "Warning: no library target specified (with -x) and no programs found!" From 8c605fef331c45fc5cdfeb62a46ffa1e9b9c0ab6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 4 May 2022 18:14:53 -0400 Subject: [PATCH 41/68] (*)Internal thickness variable unit correction Changed the internal units of several internal thickness variables in ePBL_column and of some temporary diagnostics in MOM_bulk_mixed_layer from [Z] to [H] to reduce the number of rescaling factors that are being applied outside of the conversion factors when diagnostics are registered. All answers and output are bitwise identical in the MOM6-examples test suite, although in some cases where ePBL is used with a non-Boussinesq model, there may be answers at roundoff. I wanted to make this change now before any such models exist. --- .../vertical/MOM_bulk_mixed_layer.F90 | 34 ++++++------- .../vertical/MOM_diapyc_energy_req.F90 | 31 ++++++------ .../vertical/MOM_energetic_PBL.F90 | 50 ++++++++++--------- .../vertical/MOM_kappa_shear.F90 | 4 +- 4 files changed, 61 insertions(+), 58 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 5df132a44d..aa0d05ce79 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -230,7 +230,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C integer, dimension(SZI_(G),SZK_(GV)) :: & ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & - h_miss ! The summed absolute mismatch [Z ~> m]. + h_miss ! The summed absolute mismatch [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a ! time step [Z L2 T-2 ~> m3 s-2]. @@ -299,12 +299,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! adjustment [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) - ! after entrainment but before any buffer layer detrainment [Z ~> m]. + ! after entrainment but before any buffer layer detrainment [H ~> m or kg m-2]. Hsfc_used, & ! The thickness of the surface region after buffer layer - ! detrainment [Z ~> m]. + ! detrainment [H ~> m or kg m-2]. Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the - ! neighboring water columns [Z ~> m]. + ! neighboring water columns [H ~> m or kg m-2]. h_sum, & ! The total thickness of the water column [H ~> m or kg m-2]. hmbl_prev ! The previous thickness of the mixed and buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & @@ -538,7 +538,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C h(i,0) = htot(i) endif ; enddo if (write_diags .and. allocated(CS%ML_depth)) then ; do i=is,ie - CS%ML_depth(i,j) = h(i,0) * GV%H_to_m ! Rescale the diagnostic. + CS%ML_depth(i,j) = h(i,0) ! Store the diagnostic. enddo ; endif if (associated(Hml)) then ; do i=is,ie Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_Z) ! Rescale the diagnostic for output. @@ -573,14 +573,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C hmbl_prev(i,j-1) - dHD*min(h_sum(i,j),h_sum(i,j-1)), & hmbl_prev(i,j+1) - dHD*min(h_sum(i,j),h_sum(i,j+1))) ) - Hsfc_min(i,j) = GV%H_to_Z * max(h(i,0), min(Hsfc(i), H_nbr)) + Hsfc_min(i,j) = max(h(i,0), min(Hsfc(i), H_nbr)) if (CS%limit_det) max_BL_det(i) = max(0.0, Hsfc(i)-H_nbr) enddo endif if (CS%id_Hsfc_max > 0) then ; do i=is,ie - Hsfc_max(i,j) = GV%H_to_Z * Hsfc(i) + Hsfc_max(i,j) = Hsfc(i) enddo ; endif endif @@ -601,9 +601,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C endif if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = GV%H_to_Z * h(i,0) ; enddo + do i=is,ie ; Hsfc_used(i,j) = h(i,0) ; enddo do k=CS%nkml+1,nkmb ; do i=is,ie - Hsfc_used(i,j) = Hsfc_used(i,j) + GV%H_to_Z * h(i,k) + Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k) enddo ; enddo endif @@ -686,15 +686,15 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (CS%id_h_mismatch > 0) then do i=is,ie - h_miss(i,j) = GV%H_to_Z * abs(h_3d(i,j,1) - (h_orig(i,1) + & + h_miss(i,j) = abs(h_3d(i,j,1) - (h_orig(i,1) + & (eaml(i,1) + (ebml(i,1) - eaml(i,1+1))))) enddo do k=2,nz-1 ; do i=is,ie - h_miss(i,j) = h_miss(i,j) + GV%H_to_Z * abs(h_3d(i,j,k) - (h_orig(i,k) + & + h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,k) - (h_orig(i,k) + & ((eaml(i,k) - ebml(i,k-1)) + (ebml(i,k) - eaml(i,k+1))))) enddo ; enddo do i=is,ie - h_miss(i,j) = h_miss(i,j) + GV%H_to_Z * abs(h_3d(i,j,nz) - (h_orig(i,nz) + & + h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,nz) - (h_orig(i,nz) + & ((eaml(i,nz) - ebml(i,nz-1)) + ebml(i,nz)))) enddo endif @@ -3501,7 +3501,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "during mixedlayer convection.", default=.false.) CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & - Time, 'Surface mixed layer depth', 'm') + Time, 'Surface mixed layer depth', 'm', conversion=GV%H_to_m) CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, & Time, 'Wind-stirring source of mixed layer TKE', & 'm3 s-3', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3)) @@ -3533,13 +3533,13 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) Time, 'Spurious source of potential energy from mixed layer only detrainment', & 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & - Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=US%Z_to_m) + Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=GV%H_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm', conversion=US%Z_to_m) + Time, 'Surface region thickness that is used', 'm', conversion=GV%H_to_m) CS%id_Hsfc_max = register_diag_field('ocean_model', 'Hs_max', diag%axesT1, & - Time, 'Maximum surface region thickness', 'm', conversion=US%Z_to_m) + Time, 'Maximum surface region thickness', 'm', conversion=GV%H_to_m) CS%id_Hsfc_min = register_diag_field('ocean_model', 'Hs_min', diag%axesT1, & - Time, 'Minimum surface region thickness', 'm', conversion=US%Z_to_m) + Time, 'Minimum surface region thickness', 'm', conversion=GV%H_to_m) !CS%lim_det_dH_sfc = 0.5 ; CS%lim_det_dH_bathy = 0.2 ! Technically these should not get used if limit_det is false? if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, & diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index c2e05dc930..975a11d909 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -1046,7 +1046,8 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real :: ColHt_core ! The diffusivity-independent core term in the expressions ! for the column height changes [R L2 T-2 ~> J m-3]. real :: ColHt_chg ! The change in the column height [Z ~> m]. - real :: y1 ! A local temporary term, in [H-3] or [H-4] in various contexts. + real :: y1_3 ! A local temporary term in [H-3 ~> m-3 or m6 kg-3]. + real :: y1_4 ! A local temporary term in [H-4 ~> m-4 or m8 kg-4]. ! The expression for the change in potential energy used here is derived ! from the expression for the final estimates of the changes in temperature @@ -1068,37 +1069,37 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & if (present(PE_chg)) then ! Find the change in column potential energy due to the change in the ! diffusivity at this interface by dKddt_h. - y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - PE_chg = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) + PE_chg = PEc_core * y1_3 + ColHt_chg = ColHt_core * y1_3 if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg if (present(ColHt_cor)) ColHt_cor = -pres_Z * min(ColHt_chg, 0.0) elseif (present(ColHt_cor)) then - y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - ColHt_cor = -pres_Z * min(ColHt_core * y1, 0.0) + y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) + ColHt_cor = -pres_Z * min(ColHt_core * y1_3, 0.0) endif if (present(dPEc_dKd)) then ! Find the derivative of the potential energy change with dKddt_h. - y1 = 1.0 / (bdt1 + dKddt_h * hps)**2 - dPEc_dKd = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_4 = 1.0 / (bdt1 + dKddt_h * hps)**2 + dPEc_dKd = PEc_core * y1_4 + ColHt_chg = ColHt_core * y1_4 if (ColHt_chg < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * ColHt_chg endif if (present(dPE_max)) then ! This expression is the limit of PE_chg for infinite dKddt_h. - y1 = 1.0 / (bdt1 * hps) - dPE_max = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_3 = 1.0 / (bdt1 * hps) + dPE_max = PEc_core * y1_3 + ColHt_chg = ColHt_core * y1_3 if (ColHt_chg < 0.0) dPE_max = dPE_max - pres_Z * ColHt_chg endif if (present(dPEc_dKd_0)) then ! This expression is the limit of dPEc_dKd for dKddt_h = 0. - y1 = 1.0 / bdt1**2 - dPEc_dKd_0 = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_4 = 1.0 / bdt1**2 + dPEc_dKd_0 = PEc_core * y1_4 + ColHt_chg = ColHt_core * y1_4 if (ColHt_chg < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z * ColHt_chg endif diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 07fd69d744..bb4b4a2f36 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -76,7 +76,7 @@ module MOM_energetic_PBL !! boundary layer thickness. The default is 0, but a !! value of 0.1 might be better justified by observations. real :: MLD_tol !< A tolerance for determining the boundary layer thickness when - !! Use_MLD_iteration is true [Z ~> m]. + !! Use_MLD_iteration is true [H ~> m or kg m-2]. real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL [Z ~> m]. !! The default (0) does not set a minimum. @@ -634,9 +634,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: dt_h ! The timestep divided by the averages of the thicknesses around ! a layer, times a thickness conversion factor [H T Z-2 ~> s m-1 or kg s m-4]. real :: h_bot ! The distance from the bottom [H ~> m or kg m-2]. - real :: h_rsum ! The running sum of h from the top [Z ~> m]. + real :: h_rsum ! The running sum of h from the top [H ~> m or kg m-2]. real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1]. - real :: I_MLD ! The inverse of the current value of MLD [Z-1 ~> m-1]. + real :: I_MLD ! The inverse of the current value of MLD [H-1 ~> m-1 or m2 kg-1]. real :: h_tt ! The distance from the surface or up to the next interface ! that did not exhibit turbulent mixing from this scheme plus ! a surface mixing roughness length given by h_tt_min [H ~> m or kg m-2]. @@ -648,7 +648,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: vstar ! An in-situ turbulent velocity [Z T-1 ~> m s-1]. real :: mstar_total ! The value of mstar used in ePBL [nondim] real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic) - real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m]. + real :: MLD_output ! The mixed layer depth output from this routine [H ~> m or kg m-2]. real :: LA ! The value of the Langmuir number [nondim] real :: LAmod ! The modified Langmuir number by convection [nondim] real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a @@ -706,8 +706,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth ! - needed to compute new mixing length. - real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [Z ~> m]. - real :: min_MLD ! Iteration bounds [Z ~> m], which are adjusted at each step + real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [H ~> m or kg m-2]. + real :: MLD_guess_Z ! A guessed mixed layer depth, converted to height units [Z ~> m] + real :: min_MLD ! Iteration bounds [H ~> m or kg m-2], which are adjusted at each step real :: max_MLD ! - These are initialized based on surface/bottom ! 1. The iteration guesses a value (possibly from prev step or neighbor). ! 2. The iteration checks if value is converged, too shallow, or too deep. @@ -720,8 +721,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! manner giving a usable guess. When it does fail, it is due to convection ! within the boundary layer. Likely, a new method e.g. surface_disconnect, ! can improve this. - real :: dMLD_min ! The change in diagnosed mixed layer depth when the guess is min_MLD [Z ~> m] - real :: dMLD_max ! The change in diagnosed mixed layer depth when the guess is max_MLD [Z ~> m] + real :: dMLD_min ! The change in diagnosed mixed layer depth when the guess is min_MLD [H ~> m or kg m-2] + real :: dMLD_max ! The change in diagnosed mixed layer depth when the guess is max_MLD [H ~> m or kg m-2] logical :: OBL_converged ! Flag for convergence of MLD integer :: OBL_it ! Iteration counter @@ -754,7 +755,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = (US%Z_to_m**3*US%s_to_T**3) / (dt*GV%Rho0) vstar_unit_scale = US%m_to_Z * US%T_to_s - MLD_guess = MLD_io + MLD_guess = MLD_io*GV%Z_to_H ! Determine the initial mech_TKE and conv_PErel, including the energy required ! to mix surface heating through the topmost cell, the energy released by mixing @@ -787,15 +788,15 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs hb_hs(K) = h_bot * I_hs enddo - MLD_output = h(1)*GV%H_to_Z + MLD_output = h(1) !/The following lines are for the iteration over MLD ! max_MLD will initialized as ocean bottom depth - max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(k)*GV%H_to_Z ; enddo + max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(k) ; enddo ! min_MLD will be initialized to 0. min_MLD = 0.0 ! Set values of the wrong signs to indicate that these changes are not based on valid estimates - dMLD_min = -1.0*US%m_to_Z ; dMLD_max = 1.0*US%m_to_Z + dMLD_min = -1.0*GV%m_to_H ; dMLD_max = 1.0*GV%m_to_H ! If no first guess is provided for MLD, try the middle of the water column if (MLD_guess <= min_MLD) MLD_guess = 0.5 * (min_MLD + max_MLD) @@ -811,18 +812,19 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif ! Reset ML_depth - MLD_output = h(1)*GV%H_to_Z + MLD_output = h(1) sfc_connected = .true. !/ Here we get MStar, which is the ratio of convective TKE driven mixing to UStar**3 + MLD_guess_z = GV%H_to_Z*MLD_guess ! Convert MLD from thickness to height coordinates for these calls if (CS%Use_LT) then - call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, h, Waves, & + call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess_z), u_star_mean, i, j, h, Waves, & U_H=u, V_H=v) - call find_mstar(CS, US, B_flux, u_star, u_star_Mean, MLD_Guess, absf, & + call find_mstar(CS, US, B_flux, u_star, u_star_Mean, MLD_guess_z, absf, & MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& mstar_LT=mstar_LT) else - call find_mstar(CS, US, B_flux, u_star, u_star_mean, MLD_guess, absf, mstar_total) + call find_mstar(CS, US, B_flux, u_star, u_star_mean, MLD_guess_z, absf, mstar_total) endif !/ Apply MStar to get mech_TKE @@ -879,7 +881,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs h_rsum = 0.0 MixLen_shape(1) = 1.0 do K=2,nz+1 - h_rsum = h_rsum + h(k-1)*GV%H_to_Z + h_rsum = h_rsum + h(k-1) if (CS%MixLenExponent==2.0) then MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2 ! CS%MixLenExponent @@ -1076,7 +1078,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%wT_scheme==wT_from_cRoot_TKE) then vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3 elseif (CS%wT_scheme==wT_from_RH18) then - Surface_Scale = max(0.05, 1.0 - htot * GV%H_to_Z / MLD_guess) + Surface_Scale = max(0.05, 1.0 - htot / MLD_guess) vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + & vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3) endif @@ -1125,7 +1127,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%wT_scheme==wT_from_cRoot_TKE) then vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3 elseif (CS%wT_scheme==wT_from_RH18) then - Surface_Scale = max(0.05, 1. - htot * GV%H_to_Z / MLD_guess) + Surface_Scale = max(0.05, 1. - htot / MLD_guess) vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + & vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3) endif @@ -1178,7 +1180,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag endif if (sfc_connected) then - MLD_output = MLD_output + GV%H_to_Z * h(k) + MLD_output = MLD_output + h(k) endif Kddt_h(K) = Kd(K) * dt_h @@ -1202,7 +1204,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs mech_TKE = TKE_reduc*(mech_TKE + MKE_src) conv_PErel = TKE_reduc*conv_PErel if (sfc_connected) then - MLD_output = MLD_output + GV%H_to_Z * h(k) + MLD_output = MLD_output + h(k) endif elseif (tot_TKE == 0.0) then @@ -1303,7 +1305,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs endif if (sfc_connected) MLD_output = MLD_output + & - (PE_chg / (PE_chg_g0)) * GV%H_to_Z * h(k) + (PE_chg / (PE_chg_g0)) * h(k) tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 sfc_disconnect = .true. @@ -1422,7 +1424,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs eCD%LA = 0.0 ; eCD%LAmod = 0.0 ; eCD%mstar = mstar_total ; eCD%mstar_LT = 0.0 endif - MLD_io = MLD_output + MLD_io = GV%H_to_Z*MLD_output end subroutine ePBL_column @@ -2125,7 +2127,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & "The tolerance for the iteratively determined mixed "//& "layer depth. This is only used with USE_MLD_ITERATION.", & - units="meter", default=1.0, scale=US%m_to_Z, do_not_log=.not.CS%Use_MLD_iteration) + units="meter", default=1.0, scale=GV%m_to_H, do_not_log=.not.CS%Use_MLD_iteration) call get_param(param_file, mdl, "EPBL_MLD_BISECTION", CS%MLD_bisection, & "If true, use bisection with the iterative determination of the self-consistent "//& "mixed layer depth. Otherwise use the false position after a maximum and minimum "//& diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index a95edbad52..f7673b347d 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -270,7 +270,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- - do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = 1.0*US%m2_s_to_Z2_T ; enddo call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & @@ -537,7 +537,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! ---------------------------------------------------- ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- - do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = 1.0*US%m2_s_to_Z2_T ; enddo call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & From 79eb80794c21a16872e2d830052d0ad5cd74974f Mon Sep 17 00:00:00 2001 From: sanAkel Date: Mon, 6 Jun 2022 18:30:13 -0400 Subject: [PATCH 42/68] In the case that nonzero_count <=1, a (dummy) value is set for non_unique_scales before returning --- src/framework/MOM_unique_scales.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/framework/MOM_unique_scales.F90 b/src/framework/MOM_unique_scales.F90 index 730d11adb0..6572678c06 100644 --- a/src/framework/MOM_unique_scales.F90 +++ b/src/framework/MOM_unique_scales.F90 @@ -266,6 +266,8 @@ integer function non_unique_scales(scales, list, descs, weights, silent) integer :: ndim ! The number of dimensional scaling factors to work with integer :: i, n, m, ns + non_unique_scales = -9999 ! Set return value to a _dummy_ value + verbose = .true. ; if (present(silent)) verbose = .not.silent ndim = size(scales) From 0a8210adc22872e8601a017da55c2adc405a31f2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 19 Jun 2022 20:09:16 -0400 Subject: [PATCH 43/68] +Add DEBUG_FULL_COLUMN for debugging accelerations Added the runtime debugging option DEBUG_FULL_COLUMN to write out the acceleration diagnostics for the entire water column when there are velocity truncations, rather than just writing out the values for layers with large velocities. Also modified the write_accel code to reflect that the viscous coupling coefficients are discretized at the interfaces, and to reflect the fact that the stresses are optional arguments. All answers are bitwise identical, but there is a new debugging runtime argument, and the debugging output changes when there are velocity truncations. --- src/diagnostics/MOM_PointAccel.F90 | 52 +++++++++++++++++++----------- 1 file changed, 33 insertions(+), 19 deletions(-) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 423ef2b4f9..d53b2e6636 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -39,6 +39,8 @@ module MOM_PointAccel !! written by this PE during the current run. integer :: max_writes !< The maximum number of times any PE can write out !! a column's worth of accelerations during a run. + logical :: full_column !< If true, write out the accelerations in all massive layers, + !! otherwise just document the ones with large velocities. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -80,11 +82,12 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st !! call to PointAccel_init. real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1] real, optional, intent(in) :: str !< The surface wind stress [R L Z T-2 ~> Pa] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc [H ~> m or kg m-2]. + ! Local variables real :: CFL ! The local velocity-based CFL number [nondim] real :: Angstrom ! A negligibly small thickness [H ~> m or kg m-2] @@ -145,6 +148,9 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (ke < ks) then ks = 1; ke = nz; write(file,'("U: Unable to set ks & ke.")') endif + if (CS%full_column) then + ks = 1 ; ke = nz + endif call get_date(CS%Time, yr, mo, day, hr, minute, sec) call get_time((CS%Time - set_date(yr, 1, 1, 0, 0, 0)), sec, yearday) @@ -217,21 +223,23 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st (vel_scale*ADp%du_other(I,j,k)) ; enddo endif if (present(a)) then - write(file,'(/,"a: ")', advance='no') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (US%Z_to_m*a(I,j,k)*dt) ; enddo + write(file,'(/,"a: ",ES10.3," ")', advance='no') US%Z_to_m*a(I,j,ks)*dt + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') (US%Z_to_m*a(I,j,K)*dt) ; enddo endif if (present(hv)) then write(file,'(/,"hvel: ")', advance='no') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hv(I,j,k) ; enddo endif - write(file,'(/,"Stress: ",ES10.3)') vel_scale*US%Z_to_m * (str*dt / GV%Rho0) + if (present(str)) then + write(file,'(/,"Stress: ",ES10.3)', advance='no') vel_scale*US%Z_to_m * (str*dt / GV%Rho0) + endif if (associated(CS%u_accel_bt)) then - write(file,'("dubt: ")', advance='no') + write(file,'(/,"dubt: ")', advance='no') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*dt*CS%u_accel_bt(I,j,k)) ; enddo - write(file,'(/)') endif + write(file,'(/)') write(file,'(/,"h--: ")', advance='no') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (h_scale*hin(i,j-1,k)) ; enddo @@ -249,14 +257,12 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo - write(file,'(/,"e-: ")', advance='no') - write(file,'(ES10.3," ")', advance='no') e(ks) + write(file,'(/,"e-: ",ES10.3," ")', advance='no') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') e(K) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i+1,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i+1,j,k) ; enddo - write(file,'(/,"e+: ")', advance='no') - write(file,'(ES10.3," ")', advance='no') e(ks) + write(file,'(/,"e+: ",ES10.3," ")', advance='no') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') e(K) ; enddo if (associated(CS%T)) then write(file,'(/,"T-: ")', advance='no') @@ -415,11 +421,12 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st !! call to PointAccel_init. real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1] real, optional, intent(in) :: str !< The surface wind stress [R L Z T-2 ~> Pa] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), & optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc [H ~> m or kg m-2]. + ! Local variables real :: CFL ! The local velocity-based CFL number [nondim] real :: Angstrom ! A negligibly small thickness [H ~> m or kg m-2] @@ -479,6 +486,9 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (ke < ks) then ks = 1; ke = nz; write(file,'("V: Unable to set ks & ke.")') endif + if (CS%full_column) then + ks = 1 ; ke = nz + endif call get_date(CS%Time, yr, mo, day, hr, minute, sec) call get_time((CS%Time - set_date(yr, 1, 1, 0, 0, 0)), sec, yearday) @@ -556,21 +566,23 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st (vel_scale*ADp%dv_other(i,J,k)) ; enddo endif if (present(a)) then - write(file,'(/,"a: ")', advance='no') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (US%Z_to_m*a(i,j,k)*dt) ; enddo + write(file,'(/,"a: ",ES10.3," ")', advance='no') US%Z_to_m*a(i,J,ks)*dt + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') (US%Z_to_m*a(i,J,K)*dt) ; enddo endif if (present(hv)) then write(file,'(/,"hvel: ")', advance='no') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hv(i,J,k) ; enddo endif - write(file,'(/,"Stress: ",ES10.3)') vel_scale*US%Z_to_m * (str*dt / GV%Rho0) + if (present(str)) then + write(file,'(/,"Stress: ",ES10.3)', advance='no') vel_scale*US%Z_to_m * (str*dt / GV%Rho0) + endif if (associated(CS%v_accel_bt)) then write(file,'("dvbt: ")', advance='no') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*dt*CS%v_accel_bt(i,J,k)) ; enddo - write(file,'(/)') endif + write(file,'(/)') write(file,'("h--: ")', advance='no') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hin(i-1,j,k) ; enddo @@ -587,14 +599,12 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo - write(file,'(/,"e-: ")', advance='no') - write(file,'(ES10.3," ")', advance='no') e(ks) + write(file,'(/,"e-: ",ES10.3," ")', advance='no') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') e(K) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i,j+1) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j+1,k) ; enddo - write(file,'(/,"e+: ")', advance='no') - write(file,'(ES10.3," ")', advance='no') e(ks) + write(file,'(/,"e+: ",ES10.3," ")', advance='no') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') e(K) ; enddo if (associated(CS%T)) then write(file,'(/,"T-: ")', advance='no') @@ -773,6 +783,10 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) call get_param(param_file, mdl, "MAX_TRUNC_FILE_SIZE_PER_PE", CS%max_writes, & "The maximum number of columns of truncations that any PE "//& "will write out during a run.", default=50, debuggingParam=.true.) + call get_param(param_file, mdl, "DEBUG_FULL_COLUMN", CS%full_column, & + "If true, write out the accelerations in all massive layers; otherwise "//& + "just document the ones with large velocities.", & + default=.false., debuggingParam=.true.) if (len_trim(dirs%output_directory) > 0) then if (len_trim(CS%u_trunc_file) > 0) & From a824f802fa2bcabcb94cef88c102edc838409de0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 19 Jun 2022 20:10:46 -0400 Subject: [PATCH 44/68] +Convert 16 vertvisc_type pointers to allocatables Converted 16 pointers in the vertvisc_type into allocatable arrays. Also added units describing some variables, and used whether the visc%Ray terms are allocated to determine whether there are to be Rayleigh drag terms in the tridiagonal viscosity solver, rather than using a duplicate call to get_param for CHANNEL_DRAG to control this behavior. All answers and output are bitwise identical, but there are changes to the types of some of the elements of a transparent type. --- src/core/MOM.F90 | 4 +- src/core/MOM_variables.F90 | 46 +++---- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 56 +++++---- .../vertical/MOM_set_viscosity.F90 | 116 +++++++++--------- .../vertical/MOM_vert_friction.F90 | 48 ++++---- 6 files changed, 138 insertions(+), 134 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c1bb11ae80..60c4d56098 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -3479,13 +3479,13 @@ subroutine extract_surface_state(CS, sfc_state_in) sfc_state%internal_heat(i,j) = US%C_to_degC*CS%tv%internal_heat(i,j) enddo ; enddo endif - if (allocated(sfc_state%taux_shelf) .and. associated(CS%visc%taux_shelf)) then + if (allocated(sfc_state%taux_shelf) .and. allocated(CS%visc%taux_shelf)) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie sfc_state%taux_shelf(I,j) = CS%visc%taux_shelf(I,j) enddo ; enddo endif - if (allocated(sfc_state%tauy_shelf) .and. associated(CS%visc%tauy_shelf)) then + if (allocated(sfc_state%tauy_shelf) .and. allocated(CS%visc%tauy_shelf)) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie sfc_state%tauy_shelf(i,J) = CS%visc%tauy_shelf(i,J) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index b0d12018f7..11f0f9cd63 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -223,39 +223,39 @@ module MOM_variables type, public :: vertvisc_type real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion !! that is captured in Kd_shear [nondim]. - real, pointer, dimension(:,:) :: & - bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points [Z ~> m]. - bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points [Z ~> m]. - kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points [Z2 T-1 ~> m2 s-1]. - kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points [Z2 T-1 ~> m2 s-1]. - ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z T-1 ~> m s-1]. - real, pointer, dimension(:,:) :: TKE_BBL => NULL() - !< A term related to the bottom boundary layer source of turbulent kinetic - !! energy, currently in [Z3 T-3 ~> m3 s-3], but may at some time be changed - !! to [R Z3 T-3 ~> W m-2]. - real, pointer, dimension(:,:) :: & - taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves [R Z L T-2 ~> Pa]. - tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves [R Z L T-2 ~> Pa]. - real, pointer, dimension(:,:) :: tbl_thick_shelf_u => NULL() + real, allocatable, dimension(:,:) :: & + bbl_thick_u, & !< The bottom boundary layer thickness at the u-points [Z ~> m]. + bbl_thick_v, & !< The bottom boundary layer thickness at the v-points [Z ~> m]. + kv_bbl_u, & !< The bottom boundary layer viscosity at the u-points [Z2 T-1 ~> m2 s-1]. + kv_bbl_v, & !< The bottom boundary layer viscosity at the v-points [Z2 T-1 ~> m2 s-1]. + ustar_BBL, & !< The turbulence velocity in the bottom boundary layer at h points [Z T-1 ~> m s-1]. + TKE_BBL, & !< A term related to the bottom boundary layer source of turbulent kinetic + !! energy, currently in [Z3 T-3 ~> m3 s-3], but may at some time be changed + !! to [R Z3 T-3 ~> W m-2]. + taux_shelf, & !< The zonal stresses on the ocean under shelves [R Z L T-2 ~> Pa]. + tauy_shelf !< The meridional stresses on the ocean under shelves [R Z L T-2 ~> Pa]. + real, allocatable, dimension(:,:) :: tbl_thick_shelf_u !< Thickness of the viscous top boundary layer under ice shelves at u-points [Z ~> m]. - real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() + real, allocatable, dimension(:,:) :: tbl_thick_shelf_v !< Thickness of the viscous top boundary layer under ice shelves at v-points [Z ~> m]. - real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() + real, allocatable, dimension(:,:) :: kv_tbl_shelf_u !< Viscosity in the viscous top boundary layer under ice shelves at u-points [Z2 T-1 ~> m2 s-1]. - real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() + real, allocatable, dimension(:,:) :: kv_tbl_shelf_v !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 T-1 ~> m2 s-1]. - real, pointer, dimension(:,:) :: nkml_visc_u => NULL() + real, allocatable, dimension(:,:) :: nkml_visc_u !< The number of layers in the viscous surface mixed layer at u-points [nondim]. !! This is not an integer because there may be fractional layers, and it is stored in !! terms of layers, not depth, to facilitate the movement of the viscous boundary layer !! with the flow. - real, pointer, dimension(:,:) :: nkml_visc_v => NULL() + real, allocatable, dimension(:,:) :: nkml_visc_v !< The number of layers in the viscous surface mixed layer at v-points [nondim]. + real, allocatable, dimension(:,:,:) :: & + Ray_u, & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z T-1 ~> m s-1]. + Ray_v !< The Rayleigh drag velocity to be applied to each layer at v-points [Z T-1 ~> m s-1]. + + ! The following elements are pointers so they can be used as targets for pointers in the restart registry. real, pointer, dimension(:,:) :: & - MLD => NULL() !< Instantaneous active mixing layer depth [Z ~> m]. - real, pointer, dimension(:,:,:) :: & - Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z T-1 ~> m s-1]. - Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z T-1 ~> m s-1]. + MLD => NULL() !< Instantaneous active mixing layer depth [Z ~> m]. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers !! in tracer columns [Z2 T-1 ~> m2 s-1]. diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 1cd20d3c96..2661251766 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -248,7 +248,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate drag_rate_visc(i,j) which accounts for the model bottom mean flow - if (CS%visc_drag) then + if (CS%visc_drag .and. allocated(visc%Kv_bbl_u) .and. allocated(visc%Kv_bbl_v)) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 20f92af86b..eff9d7ff72 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -588,19 +588,19 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i call hchksum(Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif - if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then + if (allocated(visc%kv_bbl_u) .and. allocated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, & haloshift=0, symmetric=.true., scale=US%Z2_T_to_m2_s, & scalar_pair=.true.) endif - if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then + if (allocated(visc%bbl_thick_u) .and. allocated(visc%bbl_thick_v)) then call uvchksum("BBL bbl_thick_[uv]", visc%bbl_thick_u, visc%bbl_thick_v, & G%HI, haloshift=0, symmetric=.true., scale=US%Z_to_m, & scalar_pair=.true.) endif - if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then + if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) then call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m*US%s_to_T) endif @@ -1198,7 +1198,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & cdrag_sqrt = sqrt(CS%cdrag) TKE_Ray = 0.0 ; Rayleigh_drag = .false. - if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. + if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) Rayleigh_drag = .true. I_Rho0 = 1.0 / (GV%Rho0) R0_g = GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth) @@ -1416,7 +1416,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int ! Determine whether to add Rayleigh drag contribution to TKE Rayleigh_drag = .false. - if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. + if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) Rayleigh_drag = .true. I_Rho0 = 1.0 / (GV%Rho0) cdrag_sqrt = sqrt(CS%cdrag) @@ -1668,7 +1668,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes - type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom + type(vertvisc_type), intent(inout) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properties and related fields. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. @@ -1692,6 +1692,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) v2_bbl ! square of average meridional velocity in BBL [L2 T-2 ~> m2 s-2] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] + real :: I_cdrag_sqrt ! The inverse of the square root of the drag coefficient [nondim] real :: hvel ! thickness at velocity points [Z ~> m]. logical :: domore, do_i(SZI_(G)) @@ -1716,29 +1717,34 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) "Module must be initialized before it is used.") if (.not.CS%bottomdraglaw .or. (CS%BBL_effic<=0.0)) then - if (associated(visc%ustar_BBL)) then + if (allocated(visc%ustar_BBL)) then do j=js,je ; do i=is,ie ; visc%ustar_BBL(i,j) = 0.0 ; enddo ; enddo endif - if (associated(visc%TKE_BBL)) then + if (allocated(visc%TKE_BBL)) then do j=js,je ; do i=is,ie ; visc%TKE_BBL(i,j) = 0.0 ; enddo ; enddo endif return endif cdrag_sqrt = sqrt(CS%cdrag) + I_cdrag_sqrt = 0.0 ; if (cdrag_sqrt > 0.0) I_cdrag_sqrt = 1.0 / cdrag_sqrt !$OMP parallel default(shared) private(do_i,vhtot,htot,domore,hvel,uhtot,ustar,u2_bbl) !$OMP do do J=js-1,je - ! Determine ustar and the square magnitude of the velocity in the - ! bottom boundary layer. Together these give the TKE source and - ! vertical decay scale. - do i=is,ie ; if ((G%mask2dCv(i,J) > 0.0) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then - do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = visc%Kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) - else - do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 - endif ; enddo + ! Determine ustar and the square magnitude of the velocity in the bottom boundary layer. + ! Together these give the TKE source and vertical decay scale. + do i=is,ie + do_i(i) = .false. ; vstar(i,J) = 0.0 ; vhtot(i) = 0.0 ; htot(i) = 0.0 + enddo + if (allocated(visc%Kv_bbl_v)) then + do i=is,ie ; if ((G%mask2dCv(i,J) > 0.0) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then + do_i(i) = .true. + vstar(i,J) = visc%Kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) + endif ; enddo + endif + !### What about terms from visc%Ray? + do k=nz,1,-1 domore = .false. do i=is,ie ; if (do_i(i)) then @@ -1782,12 +1788,16 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) enddo !$OMP do do j=js,je - do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.0) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then - do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = visc%Kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) - else - do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 - endif ; enddo + do I=is-1,ie + do_i(I) = .false. ; ustar(I) = 0.0 ; uhtot(I) = 0.0 ; htot(I) = 0.0 + enddo + if (allocated(visc%bbl_thick_u)) then + do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.0) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then + do_i(I) = .true. + ustar(I) = visc%Kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) + endif ; enddo + endif + do k=nz,1,-1 ; domore = .false. do I=is-1,ie ; if (do_i(I)) then ! Determine if grid point is an OBC diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 7934b6b019..63110a16ea 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -128,7 +128,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields - !! have NULL ptrs.. + !! have NULL ptrs. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous @@ -199,8 +199,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! quadratic bottom drag [L2 T-2 ~> m2 s-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. - real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + real :: hutot ! Running sum of thicknesses times the velocity + ! 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 :: hweight ! The thickness of a layer that is within Hbbl @@ -373,6 +373,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) if (.not.use_BBL_EOS) Rml_vel(:,:) = 0.0 + if (allocated(visc%Ray_u)) visc%Ray_u(:,:,:) = 0.0 + if (allocated(visc%Ray_v)) visc%Ray_v(:,:,:) = 0.0 + !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,US,CS,Rml,nz,nkmb, & !$OMP nkml,Isq,Ieq,Jsq,Jeq,h_neglect,Rho0x400_G,C2pi_3, & !$OMP U_bg_sq,cdrag_sqrt_Z,cdrag_sqrt,K2,use_BBL_EOS, & @@ -528,16 +531,14 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) U_bg_sq = 0.5*( 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)) ) endif - hutot = hutot + hweight * sqrt(u(I,j,k)*u(I,j,k) + & - v_at_u*v_at_u + U_bg_sq) + hutot = hutot + hweight * sqrt(u(I,j,k)*u(I,j,k) + v_at_u*v_at_u + U_bg_sq) else u_at_v = set_u_at_v(u, h, G, GV, i, j, k, mask_u, OBC) if (CS%BBL_use_tidal_bg) then U_bg_sq = 0.5*( 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 - hutot = hutot + hweight * sqrt(v(i,J,k)*v(i,J,k) + & - u_at_v*u_at_v + U_bg_sq) + hutot = hutot + hweight * sqrt(v(i,J,k)*v(i,J,k) + u_at_v*u_at_v + U_bg_sq) endif ; endif if (use_BBL_EOS .and. (hweight >= 0.0)) then @@ -548,7 +549,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! Set u* based on u*^2 = Cdrag u_bbl^2 if (.not.CS%linear_drag .and. (hwtot > 0.0)) then - ustar(i) = cdrag_sqrt_Z*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*hutot / hwtot else ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif @@ -931,14 +932,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) if (m==1) then if (Rayleigh > 0.0) then v_at_u = set_v_at_u(v, h, G, GV, i, j, k, mask_v, OBC) - visc%Ray_u(I,j,k) = Rayleigh*sqrt(u(I,j,k)*u(I,j,k) + & - v_at_u*v_at_u + U_bg_sq) + visc%Ray_u(I,j,k) = Rayleigh * sqrt(u(I,j,k)*u(I,j,k) + v_at_u*v_at_u + U_bg_sq) else ; visc%Ray_u(I,j,k) = 0.0 ; endif else if (Rayleigh > 0.0) then u_at_v = set_u_at_v(u, h, G, GV, i, j, k, mask_u, OBC) - visc%Ray_v(i,J,k) = Rayleigh*sqrt(v(i,J,k)*v(i,J,k) + & - u_at_v*u_at_v + U_bg_sq) + visc%Ray_v(i,J,k) = Rayleigh * sqrt(v(i,J,k)*v(i,J,k) + u_at_v*u_at_v + U_bg_sq) else ; visc%Ray_v(i,J,k) = 0.0 ; endif endif @@ -995,13 +994,14 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) kv_bbl = cdrag_sqrt*ustar(i)*bbl_thick_Z endif endif + kv_bbl = max(CS%Kv_BBL_min, kv_bbl) if (m==1) then - visc%Kv_bbl_u(I,j) = kv_bbl visc%bbl_thick_u(I,j) = bbl_thick_Z + if (allocated(visc%Kv_bbl_u)) visc%Kv_bbl_u(I,j) = kv_bbl else - visc%Kv_bbl_v(i,J) = kv_bbl visc%bbl_thick_v(i,J) = bbl_thick_Z + if (allocated(visc%Kv_bbl_v)) visc%Kv_bbl_v(i,J) = kv_bbl endif endif ; enddo ! end of i loop enddo ; enddo ! end of m & j loops @@ -1025,12 +1025,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) call post_data(CS%id_Ray_v, visc%Ray_v, CS%diag) if (CS%debug) then - if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & + if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) & call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=US%Z_to_m*US%s_to_T) - if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & + if (allocated(visc%kv_bbl_u) .and. allocated(visc%kv_bbl_v)) & call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, & haloshift=0, scale=US%Z2_T_to_m2_s, scalar_pair=.true.) - if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & + if (allocated(visc%bbl_thick_u) .and. allocated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, visc%bbl_thick_v, & G%HI, haloshift=0, scale=US%Z_to_m, scalar_pair=.true.) endif @@ -1193,8 +1193,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. - real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + real :: hutot ! Running sum of thicknesses times the velocity + ! magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. real :: tbl_thick_Z ! The thickness of the top boundary layer [Z ~> m]. @@ -1277,13 +1277,18 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) if (associated(forces%frac_shelf_u)) then ! This configuration has ice shelves, and the appropriate variables need to be ! allocated. If the arrays have already been allocated, these calls do nothing. - call safe_alloc_ptr(visc%tauy_shelf, G%isd, G%ied, G%JsdB, G%JedB) - call safe_alloc_ptr(visc%tbl_thick_shelf_u, G%IsdB, G%IedB, G%jsd, G%jed) - call safe_alloc_ptr(visc%tbl_thick_shelf_v, G%isd, G%ied, G%JsdB, G%JedB) - call safe_alloc_ptr(visc%kv_tbl_shelf_u, G%IsdB, G%IedB, G%jsd, G%jed) - call safe_alloc_ptr(visc%kv_tbl_shelf_v, G%isd, G%ied, G%JsdB, G%JedB) - call safe_alloc_ptr(visc%taux_shelf, G%IsdB, G%IedB, G%jsd, G%jed) - call safe_alloc_ptr(visc%tauy_shelf, G%isd, G%ied, G%JsdB, G%JedB) + if (.not.allocated(visc%taux_shelf)) & + allocate(visc%taux_shelf(G%IsdB:G%IedB, G%jsd:G%jed), source=0.0) + if (.not.allocated(visc%tauy_shelf)) & + allocate(visc%tauy_shelf(G%isd:G%ied, G%JsdB:G%JedB), source=0.0) + if (.not.allocated(visc%tbl_thick_shelf_u)) & + allocate(visc%tbl_thick_shelf_u(G%IsdB:G%IedB, G%jsd:G%jed), source=0.0) + if (.not.allocated(visc%tbl_thick_shelf_v)) & + allocate(visc%tbl_thick_shelf_v(G%isd:G%ied, G%JsdB:G%JedB), source=0.0) + if (.not.allocated(visc%kv_tbl_shelf_u)) & + allocate(visc%kv_tbl_shelf_u(G%IsdB:G%IedB, G%jsd:G%jed), source=0.0) + if (.not.allocated(visc%kv_tbl_shelf_v)) & + allocate(visc%kv_tbl_shelf_v(G%isd:G%ied, G%JsdB:G%JedB), source=0.0) ! With a linear drag law under shelves, the friction velocity is already known. ! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel @@ -1456,8 +1461,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) if (.not.CS%linear_drag) then v_at_u = set_v_at_u(v, h, G, GV, i, j, k, mask_v, OBC) - hutot = hutot + hweight * sqrt(u(I,j,k)**2 + & - v_at_u**2 + U_bg_sq) + hutot = hutot + hweight * sqrt(u(I,j,k)**2 + v_at_u**2 + U_bg_sq) endif if (use_EOS) then Thtot(I) = Thtot(I) + hweight * 0.5 * (tv%T(i,j,k) + tv%T(i+1,j,k)) @@ -1466,7 +1470,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) enddo ; endif if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then - ustar(I) = cdrag_sqrt_Z * hutot/hwtot + ustar(I) = cdrag_sqrt_Z * hutot / hwtot else ustar(I) = cdrag_sqrt_Z * CS%drag_bg_vel endif @@ -1694,8 +1698,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) if (.not.CS%linear_drag) then u_at_v = set_u_at_v(u, h, G, GV, i, J, k, mask_u, OBC) - hutot = hutot + hweight * sqrt(v(i,J,k)**2 + & - u_at_v**2 + U_bg_sq) + hutot = hutot + hweight * sqrt(v(i,J,k)**2 + u_at_v**2 + U_bg_sq) endif if (use_EOS) then Thtot(i) = Thtot(i) + hweight * 0.5 * (tv%T(i,j,k) + tv%T(i,j+1,k)) @@ -1704,7 +1707,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) enddo ; endif if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then - ustar(i) = cdrag_sqrt_Z * hutot/hwtot + ustar(i) = cdrag_sqrt_Z * hutot / hwtot else ustar(i) = cdrag_sqrt_Z * CS%drag_bg_vel endif ; endif @@ -1793,14 +1796,12 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) enddo ! J-loop at v-points if (CS%debug) then - if (associated(visc%nkml_visc_u) .and. associated(visc%nkml_visc_v)) & + if (allocated(visc%nkml_visc_u) .and. allocated(visc%nkml_visc_v)) & call uvchksum("nkml_visc_[uv]", visc%nkml_visc_u, visc%nkml_visc_v, & G%HI, haloshift=0, scalar_pair=.true.) endif - if (CS%id_nkml_visc_u > 0) & - call post_data(CS%id_nkml_visc_u, visc%nkml_visc_u, CS%diag) - if (CS%id_nkml_visc_v > 0) & - call post_data(CS%id_nkml_visc_v, visc%nkml_visc_v, CS%diag) + if (CS%id_nkml_visc_u > 0) call post_data(CS%id_nkml_visc_u, visc%nkml_visc_u, CS%diag) + if (CS%id_nkml_visc_v > 0) call post_data(CS%id_nkml_visc_v, visc%nkml_visc_v, CS%diag) end subroutine set_viscous_ML @@ -2145,8 +2146,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (CS%bottomdraglaw) then allocate(visc%bbl_thick_u(IsdB:IedB,jsd:jed), source=0.0) - allocate(visc%kv_bbl_u(IsdB:IedB,jsd:jed), source=0.0) allocate(visc%bbl_thick_v(isd:ied,JsdB:JedB), source=0.0) + allocate(visc%kv_bbl_u(IsdB:IedB,jsd:jed), source=0.0) allocate(visc%kv_bbl_v(isd:ied,JsdB:JedB), source=0.0) allocate(visc%ustar_bbl(isd:ied,jsd:jed), source=0.0) allocate(visc%TKE_bbl(isd:ied,jsd:jed), source=0.0) @@ -2243,31 +2244,30 @@ subroutine set_visc_end(visc, CS) !! related fields. Elements are deallocated here. type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. - if (CS%bottomdraglaw) then - deallocate(visc%bbl_thick_u) ; deallocate(visc%bbl_thick_v) - deallocate(visc%kv_bbl_u) ; deallocate(visc%kv_bbl_v) - if (allocated(CS%bbl_u)) deallocate(CS%bbl_u) - if (allocated(CS%bbl_v)) deallocate(CS%bbl_v) - endif - if (CS%Channel_drag) then - deallocate(visc%Ray_u) ; deallocate(visc%Ray_v) - endif - if (CS%dynamic_viscous_ML) then - deallocate(visc%nkml_visc_u) ; deallocate(visc%nkml_visc_v) - endif + + if (allocated(visc%bbl_thick_u)) deallocate(visc%bbl_thick_u) + if (allocated(visc%bbl_thick_v)) deallocate(visc%bbl_thick_v) + if (allocated(visc%kv_bbl_u)) deallocate(visc%kv_bbl_u) + if (allocated(visc%kv_bbl_v)) deallocate(visc%kv_bbl_v) + if (allocated(CS%bbl_u)) deallocate(CS%bbl_u) + if (allocated(CS%bbl_v)) deallocate(CS%bbl_v) + if (allocated(visc%Ray_u)) deallocate(visc%Ray_u) + if (allocated(visc%Ray_v)) deallocate(visc%Ray_v) + if (allocated(visc%nkml_visc_u)) deallocate(visc%nkml_visc_u) + if (allocated(visc%nkml_visc_v)) deallocate(visc%nkml_visc_v) if (associated(visc%Kd_shear)) deallocate(visc%Kd_shear) if (associated(visc%Kv_slow)) deallocate(visc%Kv_slow) if (associated(visc%TKE_turb)) deallocate(visc%TKE_turb) if (associated(visc%Kv_shear)) deallocate(visc%Kv_shear) if (associated(visc%Kv_shear_Bu)) deallocate(visc%Kv_shear_Bu) - if (associated(visc%ustar_bbl)) deallocate(visc%ustar_bbl) - if (associated(visc%TKE_bbl)) deallocate(visc%TKE_bbl) - if (associated(visc%taux_shelf)) deallocate(visc%taux_shelf) - if (associated(visc%tauy_shelf)) deallocate(visc%tauy_shelf) - if (associated(visc%tbl_thick_shelf_u)) deallocate(visc%tbl_thick_shelf_u) - if (associated(visc%tbl_thick_shelf_v)) deallocate(visc%tbl_thick_shelf_v) - if (associated(visc%kv_tbl_shelf_u)) deallocate(visc%kv_tbl_shelf_u) - if (associated(visc%kv_tbl_shelf_v)) deallocate(visc%kv_tbl_shelf_v) + if (allocated(visc%ustar_bbl)) deallocate(visc%ustar_bbl) + if (allocated(visc%TKE_bbl)) deallocate(visc%TKE_bbl) + if (allocated(visc%taux_shelf)) deallocate(visc%taux_shelf) + if (allocated(visc%tauy_shelf)) deallocate(visc%tauy_shelf) + if (allocated(visc%tbl_thick_shelf_u)) deallocate(visc%tbl_thick_shelf_u) + if (allocated(visc%tbl_thick_shelf_v)) deallocate(visc%tbl_thick_shelf_v) + if (allocated(visc%kv_tbl_shelf_u)) deallocate(visc%kv_tbl_shelf_u) + if (allocated(visc%kv_tbl_shelf_v)) deallocate(visc%kv_tbl_shelf_v) end subroutine set_visc_end !> \namespace mom_set_visc diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 4067f13757..855d563efc 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -86,9 +86,6 @@ module MOM_vert_friction !! may be an assumed value or it may be based on the !! actual velocity in the bottommost HBBL, depending !! on whether linear_drag is true. - logical :: Channel_drag !< If true, the drag is exerted directly on each - !! layer according to what fraction of the bottom - !! they overlie. logical :: harmonic_visc !< If true, the harmonic mean thicknesses are used !! to calculate the viscous coupling between layers !! except near the bottom. Otherwise the arithmetic @@ -280,7 +277,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & zDS = 0.0 stress = dt_Rho0 * forces%taux(I,j) do k=1,nz - h_a = 0.5 * (h(I,j,k) + h(I+1,j,k)) + h_neglect + h_a = 0.5 * (h(i,j,k) + h(i+1,j,k)) + h_neglect hfr = 1.0 ; if ((zDS+h_a) > Hmix) hfr = (Hmix - zDS) / h_a u(I,j,k) = u(I,j,k) + I_Hmix * hfr * stress if (associated(ADp%du_dt_str)) ADp%du_dt_str(i,J,k) = (I_Hmix * hfr * stress) * Idt @@ -291,7 +288,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & surface_stress(I) = dt_Rho0 * (G%mask2dCu(I,j)*forces%taux(I,j)) enddo ; endif ! direct_stress - if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq + if (allocated(visc%Ray_u)) then ; do k=1,nz ; do I=Isq,Ieq Ray(I,k) = visc%Ray_u(I,j,k) enddo ; enddo ; endif @@ -309,7 +306,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! calculate c'_k = - c_k / (b_k + a_k c'_(k-1)) ! and d'_k = (d_k - a_k d'_(k-1)) / (b_k + a_k c'_(k-1)) ! where c'_1 = c_1/b_1 and d'_1 = d_1/b_1 - ! (see Thomas' tridiagonal matrix algorithm) + ! + ! This form is mathematically equivalent to Thomas' tridiagonal matrix algorithm, but it + ! does not suffer from the acute sensitivity to truncation errors of the Thomas algorithm + ! because it involves no subtraction, as discussed by Schopf & Loughe, MWR, 1995. ! ! b1 is the denominator term 1 / (b_k + a_k c'_(k-1)) ! b_denom_1 is (b_k + a_k + c_k) - a_k(1 - c'_(k-1)) @@ -357,7 +357,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (abs(ADp%du_dt_visc(I,j,k)) < accel_underflow) ADp%du_dt_visc(I,j,k) = 0.0 enddo ; enddo ; endif - if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq + if (allocated(visc%taux_shelf)) then ; do I=Isq,Ieq visc%taux_shelf(I,j) = -GV%Rho0*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? enddo ; endif @@ -365,7 +365,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & do I=Isq,Ieq taux_bot(I,j) = GV%Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) enddo - if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq + if (allocated(visc%Ray_u)) then ; do k=1,nz ; do I=Isq,Ieq taux_bot(I,j) = taux_bot(I,j) + GV%Rho0 * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif @@ -418,7 +418,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & surface_stress(i) = dt_Rho0 * (G%mask2dCv(i,J)*forces%tauy(i,J)) enddo ; endif ! direct_stress - if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie + if (allocated(visc%Ray_v)) then ; do k=1,nz ; do i=is,ie Ray(i,k) = visc%Ray_v(i,J,k) enddo ; enddo ; endif @@ -457,7 +457,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (abs(ADp%dv_dt_visc(i,J,k)) < accel_underflow) ADp%dv_dt_visc(i,J,k) = 0.0 enddo ; enddo ; endif - if (associated(visc%tauy_shelf)) then ; do i=is,ie + if (allocated(visc%tauy_shelf)) then ; do i=is,ie visc%tauy_shelf(i,J) = -GV%Rho0*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? enddo ; endif @@ -465,7 +465,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & do i=is,ie tauy_bot(i,J) = GV%Rho0 * (v(i,J,nz)*CS%a_v(i,J,nz+1)) enddo - if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie + if (allocated(visc%Ray_v)) then ; do k=1,nz ; do i=is,ie tauy_bot(i,J) = tauy_bot(i,J) + GV%Rho0 * (Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif @@ -595,7 +595,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) do j=G%jsc,G%jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0.0) ; enddo - if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq + if (allocated(visc%Ray_u)) then ; do k=1,nz ; do I=Isq,Ieq Ray(I,k) = visc%Ray_u(I,j,k) enddo ; enddo ; endif @@ -624,7 +624,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0.0) ; enddo - if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie + if (allocated(visc%Ray_v)) then ; do k=1,nz ; do i=is,ie Ray(i,k) = visc%Ray_v(i,J,k) enddo ; enddo ; endif @@ -753,11 +753,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (CS%debug .or. (CS%id_hML_u > 0)) allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) if (CS%debug .or. (CS%id_hML_v > 0)) allocate(hML_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - if ((associated(visc%taux_shelf) .or. associated(forces%frac_shelf_u)) .and. & + if ((allocated(visc%taux_shelf) .or. associated(forces%frac_shelf_u)) .and. & .not.associated(CS%a1_shelf_u)) then allocate(CS%a1_shelf_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) endif - if ((associated(visc%tauy_shelf) .or. associated(forces%frac_shelf_v)) .and. & + if ((allocated(visc%tauy_shelf) .or. associated(forces%frac_shelf_v)) .and. & .not.associated(CS%a1_shelf_v)) then allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) endif @@ -1420,8 +1420,8 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS real :: maxvel ! Velocities components greater than maxvel real :: truncvel ! are truncated to truncvel, both [L T-1 ~> m s-1]. - real :: CFL ! The local CFL number. - real :: H_report ! A thickness below which not to report truncations. + real :: CFL ! The local CFL number [nondim] + real :: H_report ! A thickness below which not to report truncations [H ~> m or kg m-2] real :: vel_report(SZIB_(G),SZJB_(G)) ! The velocity to report [L T-1 ~> m s-1] real :: u_old(SZIB_(G),SZJ_(G),SZK_(GV)) ! The previous u-velocity [L T-1 ~> m s-1] real :: v_old(SZI_(G),SZJB_(G),SZK_(GV)) ! The previous v-velocity [L T-1 ~> m s-1] @@ -1512,10 +1512,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (len_trim(CS%u_trunc_file) > 0) then do j=js,je ; do I=Isq,Ieq ; if (dowrite(I,j)) then -! Here the diagnostic reporting subroutines are called if -! unphysically large values were found. + ! Call a diagnostic reporting subroutines are called if unphysically large values are found. call write_u_accel(I, j, u_old, h, ADp, CDp, dt, G, GV, US, CS%PointAccel_CSp, & - vel_report(I,j), forces%taux(I,j), a=CS%a_u, hv=CS%h_u) + vel_report(I,j), forces%taux(I,j), a=CS%a_u, hv=CS%h_u) endif ; enddo ; enddo endif @@ -1597,10 +1596,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (len_trim(CS%v_trunc_file) > 0) then do J=Jsq,Jeq ; do i=is,ie ; if (dowrite(i,J)) then -! Here the diagnostic reporting subroutines are called if -! unphysically large values were found. + ! Call a diagnostic reporting subroutines are called if unphysically large values are found. call write_v_accel(i, J, v_old, h, ADp, CDp, dt, G, GV, US, CS%PointAccel_CSp, & - vel_report(i,J), forces%tauy(i,J), a=CS%a_v, hv=CS%h_v) + vel_report(i,J), forces%tauy(i,J), a=CS%a_v, hv=CS%h_v) endif ; enddo ; enddo endif @@ -1668,10 +1666,6 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "may be an assumed value or it may be based on the "//& "actual velocity in the bottommost HBBL, depending on "//& "LINEAR_DRAG.", default=.true.) - 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.) call get_param(param_file, mdl, "DIRECT_STRESS", CS%direct_stress, & "If true, the wind stress is distributed over the "//& "topmost HMIX_STRESS of fluid (like in HYCOM), and KVML "//& From 48adab7883484c0277881aa94b3e67796559eaaa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 19 Jun 2022 20:31:04 -0400 Subject: [PATCH 45/68] +Add option to apply bottom drag as a body force Added the option to apply bottom drag as a body force, implemented via the Rayleigh drag terms. This option is enabled with the new runtime argument DRAG_AS_BODY_FORCE. By default, all answers are bitwise identical, but there is a new runtime parameter. --- .../vertical/MOM_set_viscosity.F90 | 44 +++++++++++++++++-- 1 file changed, 41 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 63110a16ea..22d65110be 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -67,6 +67,9 @@ module MOM_set_visc !! actual velocity in the bottommost `HBBL`, depending !! on whether linear_drag is true. !! Runtime parameter `BOTTOMDRAGLAW`. + 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. logical :: BBL_use_EOS !< If true, use the equation of state in determining !! the properties of the bottom boundary layer. logical :: linear_drag !< If true, the drag law is cdrag*`DRAG_BG_VEL`*u. @@ -146,7 +149,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! layer with temperature [R C-1 ~> kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density in the bottom boundary ! layer with salinity [R S-1 ~> kg m-3 ppt-1]. - press ! The pressure at which dR_dT and dR_dS are evaluated [R L2 T-2 ~> Pa]. + press, & ! The pressure at which dR_dT and dR_dS are evaluated [R L2 T-2 ~> Pa]. + umag_avg, & ! The average magnitude of velocities in the bottom boundary layer [L T-1 ~> m s-1]. + h_bbl_drag ! The thickness over which to apply drag as a body force [H ~> m or kg m-2]. real :: htot ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. @@ -199,6 +204,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! quadratic bottom drag [L2 T-2 ~> m2 s-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. + real :: I_hwtot ! The Adcroft reciprocal of hwtot [H-1 ~> m-1 or m2 kg-1]. real :: hutot ! Running sum of thicknesses times the velocity ! 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]. @@ -265,6 +271,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! viscous bottom boundary layer [nondim]. real :: BBL_visc_frac ! The fraction of all the drag that is expressed as ! a viscous bottom boundary layer [nondim]. + 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, parameter :: C1_3 = 1.0/3.0, C1_6 = 1.0/6.0, C1_12 = 1.0/12.0 real :: C2pi_3 ! An irrational constant, 2/3 pi. real :: tmp ! A temporary variable. @@ -508,7 +517,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) endif endif ; endif - if (use_BBL_EOS .or. .not.CS%linear_drag) then + if (use_BBL_EOS .or. CS%body_force_drag .or. .not.CS%linear_drag) then ! Calculate the mean velocity magnitude over the bottommost CS%Hbbl of ! the water column for determining the quadratic bottom drag. ! Used in ustar(i) @@ -554,6 +563,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif + ! Find the Adcroft reciprocal of the total thickness weights + I_hwtot = 0.0 ; if (hwtot > 0.0) I_hwtot = 1.0 / hwtot + + umag_avg(i) = hutot * I_hwtot + h_bbl_drag(i) = hwtot + if (use_BBL_EOS) then ; if (hwtot > 0.0) then T_EOS(i) = Thtot/hwtot ; S_EOS(i) = Shtot/hwtot else @@ -995,6 +1010,24 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) endif endif + if (CS%body_force_drag .and. (h_bbl_drag(i) > 0.0)) then + ! Increment the Rayleigh drag as a way introduce the bottom drag as a body force. + h_sum = 0.0 + I_hwtot = 1.0 / h_bbl_drag(i) + do k=nz,1,-1 + h_bbl_fr = min(h_bbl_drag(i) - h_sum, h_at_vel(i,k)) * I_hwtot + if (m==1) then + visc%Ray_u(I,j,k) = visc%Ray_u(I,j,k) + (CS%cdrag*US%L_to_Z*umag_avg(I)) * h_bbl_fr + else + visc%Ray_v(i,J,k) = visc%Ray_v(i,J,k) + (CS%cdrag*US%L_to_Z*umag_avg(i)) * h_bbl_fr + endif + h_sum = h_sum + h_at_vel(i,k) + if (h_sum >= bbl_thick) exit ! The top of this layer is above the drag zone. + enddo + ! Do not enhance the near-bottom viscosity in this case. + Kv_bbl = CS%Kv_BBL_min + endif + kv_bbl = max(CS%Kv_BBL_min, kv_bbl) if (m==1) then visc%bbl_thick_u(I,j) = bbl_thick_Z @@ -1967,6 +2000,11 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "may be an assumed value or it may be based on the "//& "actual velocity in the bottommost HBBL, depending on "//& "LINEAR_DRAG.", default=.true.) + call get_param(param_file, mdl, "DRAG_AS_BODY_FORCE", CS%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", & + 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 "//& @@ -2178,7 +2216,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call pass_var(CS%tideamp,G%domain) endif endif - if (CS%Channel_drag) then + if (CS%Channel_drag .or. CS%body_force_drag) then allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz), source=0.0) allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz), source=0.0) CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, & From 371c8bb2699f8af8e0a6441904bea13ad589cfc5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Jun 2022 06:24:24 -0400 Subject: [PATCH 46/68] +Eliminated 3 unused elements of the surface type Eliminated the salt_deficit, TempxPmE and internal heat elements of the surface type. None of these particular elements are used outside of MOM6, and they are not used again after they are set, and appear not to have been used in many years. All answers are bitwise identical. --- src/core/MOM.F90 | 19 ------------ src/core/MOM_checksum_packages.F90 | 2 -- src/core/MOM_forcing_type.F90 | 48 ++++++++++-------------------- src/core/MOM_variables.F90 | 14 +-------- 4 files changed, 17 insertions(+), 66 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c1bb11ae80..97d9ddd758 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -3460,25 +3460,6 @@ subroutine extract_surface_state(CS, sfc_state_in) enddo ! end of j loop endif ! melt_potential - if (allocated(sfc_state%salt_deficit) .and. associated(CS%tv%salt_deficit)) then - !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie - ! Convert from gSalt to kgSalt - sfc_state%salt_deficit(i,j) = 0.001 * US%S_to_ppt*CS%tv%salt_deficit(i,j) - enddo ; enddo - endif - if (allocated(sfc_state%TempxPmE) .and. associated(CS%tv%TempxPmE)) then - !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie - sfc_state%TempxPmE(i,j) = US%C_to_degC*CS%tv%TempxPmE(i,j) - enddo ; enddo - endif - if (allocated(sfc_state%internal_heat) .and. associated(CS%tv%internal_heat)) then - !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie - sfc_state%internal_heat(i,j) = US%C_to_degC*CS%tv%internal_heat(i,j) - enddo ; enddo - endif if (allocated(sfc_state%taux_shelf) .and. associated(CS%visc%taux_shelf)) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index bc6f206b33..2f091cae08 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -162,8 +162,6 @@ subroutine MOM_surface_chksum(mesg, sfc_state, G, US, haloshift, symmetric) if (allocated(sfc_state%u) .and. allocated(sfc_state%v)) & call uvchksum(mesg//" SSU", sfc_state%u, sfc_state%v, G%HI, haloshift=hs, symmetric=sym, & scale=US%L_T_to_m_s) -! if (allocated(sfc_state%salt_deficit)) & -! call hchksum(sfc_state%salt_deficit, mesg//" salt deficit", G%HI, haloshift=hs, scale=US%RZ_to_kg_m2) if (allocated(sfc_state%frazil)) call hchksum(sfc_state%frazil, mesg//" frazil", G%HI, & haloshift=hs, scale=US%Q_to_J_kg*US%RZ_to_kg_m2) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index b8e5fe6c49..e5f4206c9f 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2642,26 +2642,14 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%sw(i,j) if (associated(fluxes%seaice_melt_heat)) res(i,j) = res(i,j) + fluxes%seaice_melt_heat(i,j) if (allocated(sfc_state%frazil)) res(i,j) = res(i,j) + sfc_state%frazil(i,j) * I_dt - !if (associated(sfc_state%TempXpme)) then - ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt - !else - if (associated(fluxes%heat_content_lrunoff)) & - res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) - if (associated(fluxes%heat_content_frunoff)) & - res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) - if (associated(fluxes%heat_content_lprec)) & - res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if (associated(fluxes%heat_content_fprec)) & - res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if (associated(fluxes%heat_content_icemelt)) & - res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j) - if (associated(fluxes%heat_content_vprec)) & - res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) - if (associated(fluxes%heat_content_cond)) & - res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) - if (associated(fluxes%heat_content_massout)) & - res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) - !endif + if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if (associated(fluxes%heat_content_icemelt)) res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j) + if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) + if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) if (associated(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j) enddo ; enddo if (handles%id_net_heat_surface > 0) call post_data(handles%id_net_heat_surface, res, diag) @@ -2679,18 +2667,14 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h if (handles%id_heat_content_surfwater > 0 .or. handles%id_total_heat_content_surfwater > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - ! if (associated(sfc_state%TempXpme)) then - ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt - ! else - if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) - if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) - if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if (associated(fluxes%heat_content_icemelt)) res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j) - if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) - if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) - if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) - ! endif + if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (associated(fluxes%heat_content_icemelt)) res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j) + if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) + if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) enddo ; enddo if (handles%id_heat_content_surfwater > 0) call post_data(handles%id_heat_content_surfwater, res, diag) if (handles%id_total_heat_content_surfwater > 0) then diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index b0d12018f7..8ba2463e43 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -58,13 +58,7 @@ module MOM_variables ocean_heat, & !< The total heat content of the ocean in [degC R Z ~> degC kg m-2]. ocean_salt, & !< The total salt content of the ocean in [kgSalt kg-1 R Z ~> kgSalt m-2]. taux_shelf, & !< The zonal stresses on the ocean under shelves [R L Z T-2 ~> Pa]. - tauy_shelf, & !< The meridional stresses on the ocean under shelves [R L Z T-2 ~> Pa]. - TempxPmE, & !< The net inflow of water into the ocean times the temperature at which this - !! inflow occurs during the call to step_MOM [degC R Z ~> degC kg m-2]. - salt_deficit, & !< The salt needed to maintain the ocean column above a minimum - !! salinity over the call to step_MOM [kgSalt kg-1 R Z ~> kgSalt m-2]. - internal_heat !< Any internal or geothermal heat sources that are applied to the ocean - !! integrated over the call to step_MOM [degC R Z ~> degC kg m-2]. + tauy_shelf !< The meridional stresses on the ocean under shelves [R L Z T-2 ~> Pa]. logical :: T_is_conT = .false. !< If true, the temperature variable SST is actually the !! conservative temperature in [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable SSS is actually the @@ -394,9 +388,6 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & if (use_temp) then allocate(sfc_state%ocean_heat(isd:ied,jsd:jed), source=0.0) allocate(sfc_state%ocean_salt(isd:ied,jsd:jed), source=0.0) - allocate(sfc_state%TempxPmE(isd:ied,jsd:jed), source=0.0) - allocate(sfc_state%salt_deficit(isd:ied,jsd:jed), source=0.0) - allocate(sfc_state%internal_heat(isd:ied,jsd:jed), source=0.0) endif endif @@ -430,7 +421,6 @@ subroutine deallocate_surface_state(sfc_state) if (allocated(sfc_state%ocean_mass)) deallocate(sfc_state%ocean_mass) if (allocated(sfc_state%ocean_heat)) deallocate(sfc_state%ocean_heat) if (allocated(sfc_state%ocean_salt)) deallocate(sfc_state%ocean_salt) - if (allocated(sfc_state%salt_deficit)) deallocate(sfc_state%salt_deficit) if (allocated(sfc_state%sfc_cfc11)) deallocate(sfc_state%sfc_cfc11) if (allocated(sfc_state%sfc_cfc12)) deallocate(sfc_state%sfc_cfc12) call coupler_type_destructor(sfc_state%tr_fields) @@ -488,8 +478,6 @@ subroutine rotate_surface_state(sfc_state_in, sfc_state, G, turns) call rotate_array(sfc_state_in%ocean_heat, turns, sfc_state%ocean_heat) call rotate_array(sfc_state_in%ocean_salt, turns, sfc_state%ocean_salt) call rotate_array(sfc_state_in%SSS, turns, sfc_state%SSS) - call rotate_array(sfc_state_in%salt_deficit, turns, sfc_state%salt_deficit) - call rotate_array(sfc_state_in%internal_heat, turns, sfc_state%internal_heat) endif endif From 835b1661c0204b0f91e51e8593555eed1f6577e2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Jun 2022 14:04:06 -0400 Subject: [PATCH 47/68] (*)Use visc%Kv_shear in calculate_CVMix_conv call Use visc%Kv_shear in the calculate_CVMix_conv call in layered_diabatic, to avoid segmentation faults when USE_REGRIDDING=True and USE_CVMix_CONVECTION=True but USE_KPP=False. This bug was identified when evaluating the changes in https://github.com/NOAA-GFDL/MOM6/pull/129, and a correction was requested, but the correction was omitted from that PR. Answers could change, but it is likely that any cases that would change would previously have encountered a segmentation fault, so I suspect that no such cases exist. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 831ffa293b..c8584cf9ab 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1890,7 +1890,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Add vertical diff./visc. due to convection (computed via CVMix) if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_slow) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_shear) endif if (CS%useKPP) then From 1e9febecf91832fa8fa447f25bcff1637e0cf5ff Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 15 Jun 2022 09:48:39 -0400 Subject: [PATCH 48/68] Fix PGI warnings about intent for restart_CS - The PGI compiler was complaining about some `intent(in) :: CS` in MOM_restart.F90. This was because of a line that changes the state of data pointed to from within `CS`, but not `CS` itself: CS%restart_field(n)%initialized = .true. The strict interpretation is that `CS` is not modified because `CS%restart_field` is a pointer to memory elsewhere. However, the `intent(in)` indicates to the user/programmer that nothing changes and since all arguments to the functions are `intent(in)` most entities, including the PGI compiler, should be surprised that something changed as a result of a passive "query" function. This strict interpretation allows a devious hidden-change-of-state to occur. - Changing the intent to `intent(inout)` has the consequence that the new intent has to be propagated upwards through the code. And why should a type be `intent(out)` for query functions? - This commit removes offending lines that change the state. Apparently we didn't need them!? --- src/framework/MOM_restart.F90 | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 2687b6f8c6..9df5d39818 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -592,8 +592,6 @@ function query_initialized_name(name, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. if ((n==CS%novars+1) .and. (is_root_pe())) & call MOM_error(NOTE,"MOM_restart: Unknown restart variable "//name// & " queried for initialization.") @@ -625,8 +623,6 @@ function query_initialized_0d(f_ptr, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. end function query_initialized_0d @@ -651,8 +647,6 @@ function query_initialized_1d(f_ptr, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. end function query_initialized_1d @@ -678,8 +672,6 @@ function query_initialized_2d(f_ptr, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. end function query_initialized_2d @@ -705,8 +697,6 @@ function query_initialized_3d(f_ptr, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. end function query_initialized_3d @@ -732,8 +722,6 @@ function query_initialized_4d(f_ptr, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. end function query_initialized_4d @@ -760,8 +748,6 @@ function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. if (n==CS%novars+1) then if (is_root_pe()) & call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//& @@ -795,8 +781,6 @@ function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. if (n==CS%novars+1) then if (is_root_pe()) & call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//& @@ -830,8 +814,6 @@ function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. if (n==CS%novars+1) then if (is_root_pe()) & call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//& @@ -865,8 +847,6 @@ function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. if (n==CS%novars+1) then if (is_root_pe()) & call MOM_error(NOTE, "MOM_restart: Unable to find "//name//" queried by pointer, "//& @@ -900,8 +880,6 @@ function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) n = m ; exit endif enddo - ! Assume that you are going to initialize it now, so set flag to initialized if queried again. - if (n<=CS%novars) CS%restart_field(n)%initialized = .true. if (n==CS%novars+1) then if (is_root_pe()) & call MOM_error(NOTE, "MOM_restart: Unable to find "//name//" queried by pointer, "//& From 12f2e55f5023170f8e2ef0cd24b39528b0e16134 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 10 Jun 2022 12:29:18 -0400 Subject: [PATCH 49/68] gitlab-ci: add concurrent jobs in run stage - This commit splits the run stage (~40 mins) into four smaller jobs. - Prior to this commit, typical turn around for a pipeline ~1 hour but two consecutive tests of this re-factoring finished in 23 minutes - The old run stage used all executables in one run script and so could not start until the pgi executable was ready, even though the gnu executable was ready 10 minutes earlier - Breaking the run stage into tests grouped by compiler allows some "tetris" to be played to minimize wait time between jobs - Implemented by making four copies of MOM6-examples to allow concurrency across the three compilers (gnu, intel, pgi), and a fourth for restart tests (gnu only) - The results are copied into sub-directories under results/ for later comparison, no longer using tar files for caching output - Added "needs:" so jobs can start when their dependency is ready - Re-ordered jobs in the .gitlab-ci.yml files so that the slowest compilation starts first (pgi) Considerations: - We can't run two tests in the same directory at the same time because of colliding output. Therefore, the old CI would launch tests of all experiments/configurations concurrently but would cycle through each group of tests (compilers, layout, etc.) sequentially, copying the output and reusing the same work space. Making copies of the work space is slow, and running more concurrent jobs requires more nodes to be available at once, so the "four" has been found to be optimal for gaea and current work load. - We only have six runners (on the six compilation nodes) which limits the pipeline to six jobs at once. Allowing multiple jobs per runner could remove this limitation but would impact the system more. - The restart testing is the slowest section of the run stage (even though for a subset of experiments). Separating restarts out allows more concurrency. Doing restart tests for more experiments and all compilers would be very expensive. --- .gitlab-ci.yml | 273 +++++++++++++++------ .gitlab/mom6-ci-run-gnu-restarts-script.sh | 47 ++++ .gitlab/mom6-ci-run-gnu-script.sh | 71 ++++++ .gitlab/mom6-ci-run-intel-script.sh | 57 +++++ .gitlab/mom6-ci-run-pgi-script.sh | 57 +++++ .gitlab/mom6-ci-run-script.sh | 129 ---------- 6 files changed, 427 insertions(+), 207 deletions(-) create mode 100644 .gitlab/mom6-ci-run-gnu-restarts-script.sh create mode 100644 .gitlab/mom6-ci-run-gnu-script.sh create mode 100644 .gitlab/mom6-ci-run-intel-script.sh create mode 100644 .gitlab/mom6-ci-run-pgi-script.sh delete mode 100644 .gitlab/mom6-ci-run-script.sh diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ba22339753..496a578c91 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -33,6 +33,9 @@ merge: - git pull --no-edit https://github.com/NOAA-GFDL/MOM6.git dev/gfdl # Setup the persistent JOB_DIR for all subsequent stages +# +# This basically setups up a complete tree much as a user would work +# EXCEPT that src/MOM6 is cloned from a file system clone: stage: setup tags: @@ -51,23 +54,105 @@ clone: - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCloning repository tree" - git clone https://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git - cd Gaea-stats-MOM6-examples - - git submodule init - - git submodule update + - git submodule update --init - cd MOM6-examples - git checkout dev/gfdl - git submodule init - - git submodule deinit src/MOM6 # No need to clone the version recorded in MOM6-examples - - git submodule update --recursive - - make -f tools/MRS/Makefile.clone clone_gfdl # Extras and link to datasets + - git submodule set-url src/MOM6 $CI_PROJECT_DIR/.git # Easiest way to get MOM6 source to be tested + - git submodule update --recursive --jobs 8 + - (cd src/MOM6 ; git checkout $CI_COMMIT_SHA ; git submodule update --recursive --init) # Get commit to be tested + - make -f tools/MRS/Makefile.clone clone_gfdl -j # Extras and link to datasets - bash tools/MRS/generate_manifest.sh . tools/MRS/excluded-expts.txt > manifest.mk - - cd src - - rm -rf MOM6 - - cp -rp $CI_PROJECT_DIR MOM6 + - mkdir -p results + - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + +# Make work spaces for running simultaneously in parallel jobs +# +# Each work space is a clone of MOM6-examples with symbolic links for the build and data directories +# so they can share executables which can run simultaneously without interfering with each other + +work-space:pgi: + stage: setup + tags: + - ncrc4 + needs: ["clone"] + script: + - echo 911 + - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" + - git clone -s .git tmp-pgi-MOM6-examples + - cd tmp-pgi-MOM6-examples + - ln -s ../{build,results,.datasets} . + - cp ../manifest.mk . + - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + +work-space:intel: + stage: setup + tags: + - ncrc4 + needs: ["clone"] + script: + - echo 911 + - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" + - git clone -s .git tmp-intel-MOM6-examples + - cd tmp-intel-MOM6-examples + - ln -s ../{build,results,.datasets} . + - cp ../manifest.mk . + - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + +work-space:gnu: + stage: setup + tags: + - ncrc4 + needs: ["clone"] + script: + - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" + - git clone -s .git tmp-gnu-MOM6-examples + - cd tmp-gnu-MOM6-examples + - ln -s ../{build,results,.datasets} . + - cp ../manifest.mk . + - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + +work-space:gnu-restarts: + stage: setup + tags: + - ncrc4 + needs: ["clone"] + script: + - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" + - git clone -s .git tmp-gnu-restarts-MOM6-examples + - cd tmp-gnu-restarts-MOM6-examples + - ln -s ../{build,results,.datasets} . + - cp ../manifest.mk . - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" -# Compiles -gnu:repro: +# Compile executables +# +# gnu:repro, gnu:debug, intel:repro and pgi:repro are used by their respective run:* jobs +# gnu:ice-only-nolib and gnu:ocean-only-nolibs are not used but simply test that the model compiles without libraries + +compile:pgi:repro: + stage: builds + needs: ["clone"] + tags: + - ncrc4 + script: + - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_pgi" + - time make -f tools/MRS/Makefile.build repro_pgi -s -j + - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + +compile:intel:repro: stage: builds + needs: ["clone"] + tags: + - ncrc4 + script: + - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_intel" + - time make -f tools/MRS/Makefile.build repro_intel -s -j + - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + +compile:gnu:repro: + stage: builds + needs: ["clone"] tags: - ncrc4 script: @@ -78,8 +163,9 @@ gnu:repro: - time make -f tools/MRS/Makefile.build static_gnu -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile2\r\e[0K" -gnu:debug: +compile:gnu:debug: stage: builds + needs: ["clone"] tags: - ncrc4 script: @@ -87,11 +173,13 @@ gnu:debug: - time make -f tools/MRS/Makefile.build debug_gnu -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" -gnu:ocean-only-nolibs: +compile:gnu:ocean-only-nolibs: stage: builds + needs: ["clone"] tags: - ncrc4 script: + - echo 911 - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target gnu ocean-only no-libs" - mkdir -p build-ocean-only-nolibs - cd build-ocean-only-nolibs @@ -102,11 +190,13 @@ gnu:ocean-only-nolibs: - (source gnu/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" -gnu:ice-ocean-nolibs: +compile:gnu:ice-ocean-nolibs: stage: builds + needs: ["clone"] tags: - ncrc4 script: + - echo 911 - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target gnu ice-ocean-SIS2 no-libs" - mkdir -p build-ice-ocean-SIS2-nolibs - cd build-ice-ocean-SIS2-nolibs @@ -117,35 +207,58 @@ gnu:ice-ocean-nolibs: - (source gnu/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" -intel:repro: - stage: builds +# Runs +# +# The main "run" stage uses the script .gitlab/mom6-ci-run-script.sh + +run:pgi: + stage: run + needs: ["work-space:pgi","compile:pgi:repro"] tags: - ncrc4 script: - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_intel" - - time make -f tools/MRS/Makefile.build repro_intel -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - cd tmp-pgi-MOM6-examples + - cp ../src/MOM6/.gitlab/mom6-ci-run-pgi-script.sh . + - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_pgi_tests --output=log.$CI_JOB_ID --wait mom6-ci-run-pgi-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f .CI-PGI-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) + - git checkout . # reset working space so we can use it to compare against -pgi:repro: - stage: builds +run:intel: + stage: run + needs: ["work-space:intel","compile:intel:repro"] tags: - ncrc4 script: - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_pgi" - - time make -f tools/MRS/Makefile.build repro_pgi -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - echo 911 + - cd tmp-intel-MOM6-examples + - cp ../src/MOM6/.gitlab/mom6-ci-run-intel-script.sh . + - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_intel_tests --output=log.$CI_JOB_ID --wait mom6-ci-run-intel-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f .CI-INTEL-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) + - git checkout . # reset working space so we can use it to compare against -# Runs -# -# The main "run" stage uses the script .gitlab/mom6-ci-run-script.sh +run:gnu: + stage: run + needs: ["work-space:gnu","compile:gnu:repro","compile:gnu:debug"] + tags: + - ncrc4 + script: + - cd tmp-gnu-MOM6-examples + - cp ../src/MOM6/.gitlab/mom6-ci-run-gnu-script.sh . + - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_tests --output=log.$CI_JOB_ID --wait mom6-ci-run-gnu-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f .CI-GNU-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) + - git checkout . # reset working space so we can use it to compare against -run: +run:gnu-restarts: stage: run + needs: ["work-space:gnu","compile:gnu:repro"] tags: - ncrc4 script: - - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_examples_tests --output=log.$CI_PIPELINE_ID --wait src/MOM6/.gitlab/mom6-ci-run-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_PIPELINE_ID ; echo Job returned normally ) || ( cat log.$CI_PIPELINE_ID ; echo Job failed ; exit 911 ) - - test -f .CI-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) + - echo 911 + - cd tmp-gnu-restarts-MOM6-examples + - cp ../src/MOM6/.gitlab/mom6-ci-run-gnu-restarts-script.sh . + - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_restarts --output=log.$CI_JOB_ID --wait mom6-ci-run-gnu-restarts-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f .CI-GNU-RESTARTS-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) - git checkout . # reset working space so we can use it to compare against # These "run" stages replace the "before_script" and so start in the transient work-space provided by gitlab @@ -153,6 +266,7 @@ run: gnu.testing: stage: run + needs: [] tags: - ncrc4 before_script: @@ -167,10 +281,11 @@ gnu.testing: - make -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - (echo '#!/bin/bash';echo '. ./work/local-env/bin/activate';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_PIPELINE_ID --wait job.sh && make test || cat log.$CI_PIPELINE_ID + - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh && make test || cat log.$CI_JOB_ID intel.testing: stage: run + needs: [] tags: - ncrc4 before_script: @@ -185,134 +300,136 @@ intel.testing: - make -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - (echo '#!/bin/bash';echo '. ./work/local-env/bin/activate';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_PIPELINE_ID --wait job.sh && make test || cat log.$CI_PIPELINE_ID + - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh && make test || cat log.$CI_JOB_ID # Tests # # stats file tests involve comparing the check sums of the generated files against the check sums in the stats-repo # log file tests involve comparing the check sums of the generated files against the check sums in MOM6-examples -gnu:symmetric: +t:pgi:symmetric: stage: tests + needs: ["run:pgi"] tags: - ncrc4 script: - - tar --one-top-level -xf gnu_all_sym.tar - - ( cd gnu_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - ( cd results/pgi_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -gnu:non-symmetric: +t:pgi:non-symmetric: stage: tests + needs: ["run:pgi"] tags: - ncrc4 script: - - tar --one-top-level -xf gnu_all_nonsym.tar - - ( cd gnu_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - ( cd results/pgi_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -gnu:layout: +t:pgi:layout: stage: tests + needs: ["run:pgi"] tags: - ncrc4 script: - - tar --one-top-level -xf gnu_all_layout.tar - - ( cd gnu_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - ( cd results/pgi_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -gnu:static: +t:pgi:params: stage: tests + needs: ["run:pgi"] tags: - ncrc4 script: - - tar --one-top-level -xf gnu_all_static.tar - - ( cd gnu_all_static/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - ( cd results/pgi_params/ ; md5sum `find * -type f` ) | md5sum -c + allow_failure: true -gnu:debugx: +t:intel:symmetric: stage: tests + needs: ["run:intel"] tags: - ncrc4 script: - - tar --one-top-level -xf gnu_ocean_only_debug.tar - - ( cd gnu_ocean_only_debug/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - ( cd results/intel_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -gnu:restart: +t:intel:non-symmetric: stage: tests + needs: ["run:intel"] tags: - ncrc4 script: - - tar xf gnu_restarts.tar # NOTE this unpacks in MOM6-examples (not a new directory) - - make -f tools/MRS/Makefile.restart restart_gnu_ocean_only restart_gnu_ice_ocean_SIS2 -s -k + - ( cd results/intel_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -gnu:params: +t:intel:layout: stage: tests + needs: ["run:intel"] tags: - ncrc4 script: - - tar --one-top-level -xf gnu_params.tar - - ( cd gnu_params/ ; md5sum `find * -type f` ) | md5sum -c - allow_failure: true + - ( cd results/intel_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -intel:symmetric: +t:intel:params: stage: tests + needs: ["run:intel"] tags: - ncrc4 script: - - tar --one-top-level -xf intel_all_sym.tar - - ( cd intel_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - ( cd results/intel_params/ ; md5sum `find * -type f` ) | md5sum -c + allow_failure: true -intel:non-symmetric: +t:gnu:symmetric: stage: tests + needs: ["run:gnu"] tags: - ncrc4 script: - - tar --one-top-level -xf intel_all_nonsym.tar - - ( cd intel_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - ( cd results/gnu_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -intel:layout: +t:gnu:non-symmetric: stage: tests + needs: ["run:gnu"] tags: - ncrc4 script: - - tar --one-top-level -xf intel_all_layout.tar - - ( cd intel_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - ( cd results/gnu_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -intel:params: +t:gnu:layout: stage: tests + needs: ["run:gnu"] tags: - ncrc4 script: - - tar --one-top-level -xf intel_params.tar - - ( cd intel_params/ ; md5sum `find * -type f` ) | md5sum -c - allow_failure: true + - ( cd results/gnu_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -pgi:symmetric: +t:gnu:static: stage: tests + needs: ["run:gnu"] tags: - ncrc4 script: - - tar --one-top-level -xf pgi_all_sym.tar - - ( cd pgi_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - ( cd results/gnu_all_static/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -pgi:non-symmetric: +t:gnu:symmetric-debug: stage: tests + needs: ["run:gnu"] tags: - ncrc4 script: - - tar --one-top-level -xf pgi_all_nonsym.tar - - ( cd pgi_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - ( cd results/gnu_ocean_only_debug/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) -pgi:layout: +t:gnu:restart: stage: tests + needs: ["run:gnu-restarts"] tags: - ncrc4 script: - - tar --one-top-level -xf pgi_all_layout.tar - - ( cd pgi_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - cd tmp-gnu-restarts-MOM6-examples + - ( cd ../results/gnu_restarts ; tar cf - * ) | tar xf - # NOTE this unpacks in tmp-gnu-restarts-MOM6-examples (not a new directory) + - make -f tools/MRS/Makefile.restart restart_gnu_ocean_only restart_gnu_ice_ocean_SIS2 -s -k -pgi:params: +t:gnu:params: stage: tests + needs: ["run:gnu"] tags: - ncrc4 script: - - tar --one-top-level -xf pgi_params.tar - - ( cd pgi_params/ ; md5sum `find * -type f` ) | md5sum -c + - ( cd results/gnu_params/ ; md5sum `find * -type f` ) | md5sum -c allow_failure: true # We cleanup ONLY if the preceding stages were completed successfully diff --git a/.gitlab/mom6-ci-run-gnu-restarts-script.sh b/.gitlab/mom6-ci-run-gnu-restarts-script.sh new file mode 100644 index 0000000000..02af3460b4 --- /dev/null +++ b/.gitlab/mom6-ci-run-gnu-restarts-script.sh @@ -0,0 +1,47 @@ +#!/bin/bash + +sect=none +clean_stats () { # fn to clean up stats files + find [oicl]* -name "*.stats.*[a-z][a-z][a-z]" -delete +} +section_start () { # fn to print fold-able banner in CI + echo -e "\e[0Ksection_start:`date +%s`:$1[collapsed=true]\r\e[0K$2" + sect=$1 +} +section_end () { # fn to close fold-able banner in CI and clean up stats + echo -e "\e[0Ksection_end:`date +%s`:$sect\r\e[0K" + clean_stats +} +check_for_core_files () { + EXIT_CODE=0 + find [oilc]* -name core | grep . && EXIT_CODE=1 + if [[ $EXIT_CODE -gt 0 ]] + then + echo "Error: core files found!" + exit 911 + fi +} + +# Make sure we have a clean start +clean_stats +find [oilc]* -name core -delete +rm -f .CI-GNU-RESTARTS-BATCH-SUCCESS + +set -e +set -v + +# Run symmetric gnu restart tests +section_start gnu_restarts "Running symmetric gnu restart tests" +time make -f tools/MRS/Makefile.restart gnu_ocean_only -s -j RESTART_STAGE=01 +time make -f tools/MRS/Makefile.restart gnu_ice_ocean_SIS2 -s -j RESTART_STAGE=01 +time make -f tools/MRS/Makefile.restart gnu_ocean_only -s -j RESTART_STAGE=02 +time make -f tools/MRS/Makefile.restart gnu_ice_ocean_SIS2 -s -j RESTART_STAGE=02 +time make -f tools/MRS/Makefile.restart gnu_ocean_only -s -j RESTART_STAGE=12 +time make -f tools/MRS/Makefile.restart gnu_ice_ocean_SIS2 -s -j RESTART_STAGE=12 +tar cf - `find [oilc]*/ -path "*/??.ignore/*" -name "ocean.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/gnu_restarts -xf - +check_for_core_files +find [oilc]* -name "*.ignore" -type d -prune -exec rm -rf {} \; +section_end + +# Indicate all went well +touch .CI-GNU-RESTARTS-BATCH-SUCCESS diff --git a/.gitlab/mom6-ci-run-gnu-script.sh b/.gitlab/mom6-ci-run-gnu-script.sh new file mode 100644 index 0000000000..82e37abc5e --- /dev/null +++ b/.gitlab/mom6-ci-run-gnu-script.sh @@ -0,0 +1,71 @@ +#!/bin/bash + +sect=none +clean_stats () { # fn to clean up stats files + find [oicl]* -name "*.stats.*[a-z][a-z][a-z]" -delete +} +section_start () { # fn to print fold-able banner in CI + echo -e "\e[0Ksection_start:`date +%s`:$1[collapsed=true]\r\e[0K$2" + sect=$1 +} +section_end () { # fn to close fold-able banner in CI and clean up stats + echo -e "\e[0Ksection_end:`date +%s`:$sect\r\e[0K" + clean_stats +} +check_for_core_files () { + EXIT_CODE=0 + find [oilc]* -name core | grep . && EXIT_CODE=1 + if [[ $EXIT_CODE -gt 0 ]] + then + echo "Error: core files found!" + exit 911 + fi +} + +# Make sure we have a clean start +clean_stats +find [oilc]* -name core -delete +rm -f .CI-GNU-BATCH-SUCCESS + +set -e +set -v + +# Run symmetric gnu regressions +section_start gnu_all_sym "Running symmetric gnu" +time make -f tools/MRS/Makefile.run gnu_all -s -j +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/gnu_all_sym -xf - +tar cf - `find [oicl]* -name "*_parameter_doc.*"` | tar --one-top-level=results/gnu_params -xf - +check_for_core_files +section_end + +# Run non-symmetric gnu regressions +section_start gnu_all_nonsym "Running nonsymmetric gnu" +time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.gnu +time make -f tools/MRS/Makefile.run gnu_all -s -j MEMORY=dynamic_nonsymmetric +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/gnu_all_nonsym -xf - +check_for_core_files +section_end + +# Run symmetric gnu regressions with alternate layout +section_start gnu_all_layout "Running symmetric gnu with alternate layouts" +time make -f tools/MRS/Makefile.run gnu_all -s -j LAYOUT=alt +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/gnu_all_layout -xf - +check_for_core_files +section_end + +# Run symmetric gnu regressions with debug executable +section_start gnu_ocean_only_debug "Running symmetric gnu_ocean_only with debug executable" +time make -f tools/MRS/Makefile.run gnu_ocean_only -s -j MODE=debug +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/gnu_ocean_only_debug -xf - +check_for_core_files +section_end + +# Run symmetric static gnu regressions +section_start gnu_all_static "Running symmetric gnu with static executable" +time make -f tools/MRS/Makefile.run gnu_static_ocean_only MEMORY=static -s -j +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/gnu_all_static -xf - +check_for_core_files +section_end + +# Indicate all went well +touch .CI-GNU-BATCH-SUCCESS diff --git a/.gitlab/mom6-ci-run-intel-script.sh b/.gitlab/mom6-ci-run-intel-script.sh new file mode 100644 index 0000000000..c5a361a202 --- /dev/null +++ b/.gitlab/mom6-ci-run-intel-script.sh @@ -0,0 +1,57 @@ +#!/bin/bash + +sect=none +clean_stats () { # fn to clean up stats files + find [oicl]* -name "*.stats.*[a-z][a-z][a-z]" -delete +} +section_start () { # fn to print fold-able banner in CI + echo -e "\e[0Ksection_start:`date +%s`:$1[collapsed=true]\r\e[0K$2" + sect=$1 +} +section_end () { # fn to close fold-able banner in CI and clean up stats + echo -e "\e[0Ksection_end:`date +%s`:$sect\r\e[0K" + clean_stats +} +check_for_core_files () { + EXIT_CODE=0 + find [oilc]* -name core | grep . && EXIT_CODE=1 + if [[ $EXIT_CODE -gt 0 ]] + then + echo "Error: core files found!" + exit 911 + fi +} + +# Make sure we have a clean start +clean_stats +find [oilc]* -name core -delete +rm -f .CI-INTEL-BATCH-SUCCESS + +set -e +set -v + +# Run symmetric intel regressions +section_start intel_all_sym "Running symmetric intel" +time make -f tools/MRS/Makefile.run intel_all -s -j +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/intel_all_sym -xf - +tar cf - `find [oicl]* -name "*_parameter_doc.*"` | tar --one-top-level=results/intel_params -xf - +check_for_core_files +section_end + +# Run non-symmetric intel regressions +section_start intel_all_nonsym "Running nonsymmetric intel" +time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.intel -s +time make -f tools/MRS/Makefile.run intel_all -s -j MEMORY=dynamic_nonsymmetric +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/intel_all_nonsym -xf - +check_for_core_files +section_end + +# Run symmetric intel regressions with alternate layout +section_start intel_all_layout "Running symmetric intel with alternate layouts" +time make -f tools/MRS/Makefile.run intel_all -s -j LAYOUT=alt +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/intel_all_layout -xf - +check_for_core_files +section_end + +# Indicate all went well +touch .CI-INTEL-BATCH-SUCCESS diff --git a/.gitlab/mom6-ci-run-pgi-script.sh b/.gitlab/mom6-ci-run-pgi-script.sh new file mode 100644 index 0000000000..98ba9a08c3 --- /dev/null +++ b/.gitlab/mom6-ci-run-pgi-script.sh @@ -0,0 +1,57 @@ +#!/bin/bash + +sect=none +clean_stats () { # fn to clean up stats files + find [oicl]* -name "*.stats.*[a-z][a-z][a-z]" -delete +} +section_start () { # fn to print fold-able banner in CI + echo -e "\e[0Ksection_start:`date +%s`:$1[collapsed=true]\r\e[0K$2" + sect=$1 +} +section_end () { # fn to close fold-able banner in CI and clean up stats + echo -e "\e[0Ksection_end:`date +%s`:$sect\r\e[0K" + clean_stats +} +check_for_core_files () { + EXIT_CODE=0 + find [oilc]* -name core | grep . && EXIT_CODE=1 + if [[ $EXIT_CODE -gt 0 ]] + then + echo "Error: core files found!" + exit 911 + fi +} + +# Make sure we have a clean start +clean_stats +find [oilc]* -name core -delete +rm -f .CI-PGI-BATCH-SUCCESS + +set -e +set -v + +# Run symmetric pgi regressions +section_start pgi_all_sym "Running symmetric pgi" +time make -f tools/MRS/Makefile.run pgi_all -s -j +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/pgi_all_sym -xf - +tar cf - `find [oicl]* -name "*_parameter_doc.*"` | tar --one-top-level=results/pgi_params -xf - +check_for_core_files +section_end + +# Run non-symmetric pgi regressions +section_start pgi_all_nonsym "Running nonsymmetric pgi" +time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.pgi -s +time make -f tools/MRS/Makefile.run pgi_all -s -j MEMORY=dynamic_nonsymmetric +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/pgi_all_nonsym -xf - +check_for_core_files +section_end + +# Run symmetric pgi regressions with alternate layout +section_start pgi_all_layout "Running symmetric pgi with alternate layouts" +time make -f tools/MRS/Makefile.run gnu_all -s -j LAYOUT=alt +tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/pgi_all_layout -xf - +check_for_core_files +section_end + +# Indicate all went well +touch .CI-PGI-BATCH-SUCCESS diff --git a/.gitlab/mom6-ci-run-script.sh b/.gitlab/mom6-ci-run-script.sh deleted file mode 100644 index 37e5533622..0000000000 --- a/.gitlab/mom6-ci-run-script.sh +++ /dev/null @@ -1,129 +0,0 @@ -#!/bin/bash - -sect=none -clean_stats () { # fn to clean up stats files - find [oicl]* -name "*.stats.*[a-z][a-z][a-z]" -delete -} -section_start () { # fn to print fold-able banner in CI - echo -e "\e[0Ksection_start:`date +%s`:$1[collapsed=true]\r\e[0K$2" - sect=$1 -} -section_end () { # fn to close fold-able banner in CI and clean up stats - echo -e "\e[0Ksection_end:`date +%s`:$sect\r\e[0K" - clean_stats -} -check_for_core_files () { - EXIT_CODE=0 - find [oilc]* -name core | grep . && EXIT_CODE=1 - if [[ $EXIT_CODE -gt 0 ]] - then - echo "Error: core files found!" - exit 911 - fi -} - -# Make sure we have a clean start -clean_stats -find [oilc]* -name core -delete -rm -f .CI-BATCH-SUCCESS - -set -e -set -v - -# Run symmetric gnu regressions -section_start gnu_all_sym "Running symmetric gnu" -time make -f tools/MRS/Makefile.run gnu_all -s -j -tar cf gnu_all_sym.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` -tar cf gnu_params.tar `find [oicl]* -name "*_parameter_doc.*"` -check_for_core_files -section_end - -# Run non-symmetric gnu regressions -section_start gnu_all_nonsym "Running nonsymmetric gnu" -time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.gnu -s # work around -time make -f tools/MRS/Makefile.run gnu_all -s -j MEMORY=dynamic_nonsymmetric -tar cf gnu_all_nonsym.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` -check_for_core_files -section_end - -# Run symmetric gnu regressions with alternate layout -section_start gnu_all_layout "Running symmetric gnu with alternate layouts" -time make -f tools/MRS/Makefile.run gnu_all -s -j LAYOUT=alt -tar cf gnu_all_layout.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` -check_for_core_files -section_end - -# Run symmetric gnu regressions with debug executable -section_start gnu_ocean_only_debug "Running symmetric gnu_ocean_only with debug executable" -time make -f tools/MRS/Makefile.run gnu_ocean_only -s -j MODE=debug -tar cf gnu_ocean_only_debug.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` -check_for_core_files -section_end - -# Run symmetric static gnu regressions -section_start gnu_all_static "Running symmetric gnu with static executable" -time make -f tools/MRS/Makefile.run gnu_static_ocean_only MEMORY=static -s -j -tar cf gnu_all_static.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` -check_for_core_files -section_end - -section_start gnu_restarts "Running symmetric gnu restart tests" -time make -f tools/MRS/Makefile.restart gnu_ocean_only -s -j RESTART_STAGE=01 -time make -f tools/MRS/Makefile.restart gnu_ice_ocean_SIS2 -s -j RESTART_STAGE=01 -time make -f tools/MRS/Makefile.restart gnu_ocean_only -s -j RESTART_STAGE=02 -time make -f tools/MRS/Makefile.restart gnu_ice_ocean_SIS2 -s -j RESTART_STAGE=02 -time make -f tools/MRS/Makefile.restart gnu_ocean_only -s -j RESTART_STAGE=12 -time make -f tools/MRS/Makefile.restart gnu_ice_ocean_SIS2 -s -j RESTART_STAGE=12 -tar cf gnu_restarts.tar `find [oilc]*/ -path "*/??.ignore/*" -name "ocean.stats.*[a-z][a-z][a-z]"` -check_for_core_files -find [oilc]* -name "*.ignore" -type d -prune -exec rm -rf {} \; -section_end - -# Run symmetric intel regressions -section_start intel_all_sym "Running symmetric intel" -time make -f tools/MRS/Makefile.run intel_all -s -j -tar cf intel_all_sym.tar `find [a-z]* -name "*.stats.*[a-z][a-z][a-z]"` -tar cf intel_params.tar `find [a-z]* -name "*_parameter_doc.*"` -check_for_core_files -section_end - -# Run non-symmetric intel regressions -section_start intel_all_nonsym "Running nonsymmetric intel" -time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.intel -s # work around -time make -f tools/MRS/Makefile.run intel_all -s -j MEMORY=dynamic_nonsymmetric -tar cf intel_all_nonsym.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` -check_for_core_files -section_end - -# Run symmetric intel regressions with alternate layout -section_start intel_all_layout "Running symmetric intel with alternate layouts" -time make -f tools/MRS/Makefile.run intel_all -s -j LAYOUT=alt -tar cf intel_all_layout.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` -check_for_core_files -section_end - -# Run symmetric pgi regressions -section_start pgi_all_sym "Running symmetric pgi" -time make -f tools/MRS/Makefile.run pgi_all -s -j -tar cf pgi_all_sym.tar `find [a-z]* -name "*.stats.*[a-z][a-z][a-z]"` -tar cf pgi_params.tar `find [a-z]* -name "*_parameter_doc.*"` -check_for_core_files -section_end - -# Run non-symmetric pgi regressions -section_start pgi_all_nonsym "Running nonsymmetric pgi" -time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.pgi -s # work around -time make -f tools/MRS/Makefile.run pgi_all -s -j MEMORY=dynamic_nonsymmetric -tar cf pgi_all_nonsym.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` -check_for_core_files -section_end - -# Run symmetric pgi regressions with alternate layout -section_start pgi_all_layout "Running symmetric pgi with alternate layouts" -time make -f tools/MRS/Makefile.run gnu_all -s -j LAYOUT=alt -tar cf pgi_all_layout.tar `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` -check_for_core_files -section_end - -# Indicate all went well -touch .CI-BATCH-SUCCESS From 1c0e1f873b248d421eb488c9766fdf9f70fd617a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 20 Jun 2022 11:12:21 -0400 Subject: [PATCH 50/68] +Add set_initialized Added the overloaded interface set_initialized() to the MOM_restart module, to record that fields have been initialized, despite not appearing in a restart file. This will allow for a second call to set_initialized() after a call to query_initialized() to replicate the existing behavior of query_initialized() after MOM6 PR #149 (https://github.com/NOAA-GFDL/MOM6/pull/149) has been accepted. All answers are bitwise identical, but there is a new public interface. --- src/framework/MOM_restart.F90 | 174 +++++++++++++++++++++++++++++++--- 1 file changed, 163 insertions(+), 11 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 9df5d39818..7081bbd0fb 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -136,6 +136,13 @@ module MOM_restart module procedure query_initialized_4d, query_initialized_4d_name end interface +!> Specify that a field has been initialized, even if it was not read from a restart file +interface set_initialized + module procedure set_initialized_name, set_initialized_0d_name + module procedure set_initialized_1d_name, set_initialized_2d_name + module procedure set_initialized_3d_name, set_initialized_4d_name +end interface + contains !> Register a restart field as obsolete @@ -571,7 +578,7 @@ end subroutine register_restart_field_0d !> query_initialized_name determines whether a named field has been successfully -!! read from a restart file yet. +!! read from a restart file or has otherwise been recored as being initialzed. function query_initialized_name(name, CS) result(query_initialized) character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct @@ -725,10 +732,10 @@ function query_initialized_4d(f_ptr, CS) result(query_initialized) end function query_initialized_4d -!> Indicate whether the field pointed to by f_ptr or with the specified variable +!> Indicate whether the field stored in f_ptr or with the specified variable !! name has been initialized from a restart file. function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) - real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried + real, target, intent(in) :: f_ptr !< The field that is being queried character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -757,11 +764,11 @@ function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_0d_name -!> Indicate whether the field pointed to by f_ptr or with the specified variable +!> Indicate whether the field stored in f_ptr or with the specified variable !! name has been initialized from a restart file. function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:), & - target, intent(in) :: f_ptr !< A pointer to the field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -790,11 +797,11 @@ function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_1d_name -!> Indicate whether the field pointed to by f_ptr or with the specified variable +!> Indicate whether the field stored in f_ptr or with the specified variable !! name has been initialized from a restart file. function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:), & - target, intent(in) :: f_ptr !< A pointer to the field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -823,11 +830,11 @@ function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_2d_name -!> Indicate whether the field pointed to by f_ptr or with the specified variable +!> Indicate whether the field stored in f_ptr or with the specified variable !! name has been initialized from a restart file. function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:), & - target, intent(in) :: f_ptr !< A pointer to the field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -856,11 +863,11 @@ function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_3d_name -!> Indicate whether the field pointed to by f_ptr or with the specified variable +!> Indicate whether the field stored in f_ptr or with the specified variable !! name has been initialized from a restart file. function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:,:), & - target, intent(in) :: f_ptr !< A pointer to the field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -889,6 +896,151 @@ function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_4d_name +!> set_initialized_name records that a named field has been initialized. +subroutine set_initialized_name(name, CS) + character(len=*), intent(in) :: name !< The name of the field that is being set + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct + + integer :: m + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "set_initialized: Module must be initialized before it is used.") + + do m=1,CS%novars ; if (trim(name) == trim(CS%restart_field(m)%var_name)) then + CS%restart_field(m)%initialized = .true. ; exit + endif ; enddo + + if ((m==CS%novars+1) .and. (is_root_pe())) & + call MOM_error(NOTE,"MOM_restart: Unknown restart variable "//name// & + " used in set_initialized call.") + +end subroutine set_initialized_name + +!> Record that the array in f_ptr with the given name has been initialized. +subroutine set_initialized_0d_name(f_ptr, name, CS) + real, target, intent(in) :: f_ptr !< The variable that has been initialized + character(len=*), intent(in) :: name !< The name of the field that has been initialized + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct + + integer :: m + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "set_initialized: Module must be initialized before it is used.") + + do m=1,CS%novars ; if (associated(CS%var_ptr0d(m)%p,f_ptr)) then + CS%restart_field(m)%initialized = .true. ; exit + endif ; enddo + + if (m==CS%novars+1) then + if (is_root_pe()) & + call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//& + "probably because of the suspect comparison of pointers by ASSOCIATED.") + call set_initialized_name(name, CS) + endif + +end subroutine set_initialized_0d_name + +!> Record that the array in f_ptr with the given name has been initialized. +subroutine set_initialized_1d_name(f_ptr, name, CS) + real, dimension(:), & + target, intent(in) :: f_ptr !< The array that has been initialized + character(len=*), intent(in) :: name !< The name of the field that has been initialized + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct + + integer :: m + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "set_initialized: Module must be initialized before it is used.") + + do m=1,CS%novars ; if (associated(CS%var_ptr1d(m)%p,f_ptr)) then + CS%restart_field(m)%initialized = .true. ; exit + endif ; enddo + + if (m==CS%novars+1) then + if (is_root_pe()) & + call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//& + "probably because of the suspect comparison of pointers by ASSOCIATED.") + call set_initialized_name(name, CS) + endif + +end subroutine set_initialized_1d_name + +!> Record that the array in f_ptr with the given name has been initialized. +subroutine set_initialized_2d_name(f_ptr, name, CS) + real, dimension(:,:), & + target, intent(in) :: f_ptr !< The array that has been initialized + character(len=*), intent(in) :: name !< The name of the field that has been initialized + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct + + integer :: m + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "set_initialized: Module must be initialized before it is used.") + + do m=1,CS%novars ; if (associated(CS%var_ptr2d(m)%p,f_ptr)) then + CS%restart_field(m)%initialized = .true. ; exit + endif ; enddo + + if (m==CS%novars+1) then + if (is_root_pe()) & + call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//& + "probably because of the suspect comparison of pointers by ASSOCIATED.") + call set_initialized_name(name, CS) + endif + +end subroutine set_initialized_2d_name + +!> Record that the array in f_ptr with the given name has been initialized. +subroutine set_initialized_3d_name(f_ptr, name, CS) + real, dimension(:,:,:), & + target, intent(in) :: f_ptr !< The array that has been initialized + character(len=*), intent(in) :: name !< The name of the field that has been initialized + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct + + integer :: m + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "set_initialized: Module must be initialized before it is used.") + + do m=1,CS%novars ; if (associated(CS%var_ptr3d(m)%p,f_ptr)) then + CS%restart_field(m)%initialized = .true. ; exit + endif ; enddo + + if (m==CS%novars+1) then + if (is_root_pe()) & + call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//& + "probably because of the suspect comparison of pointers by ASSOCIATED.") + call set_initialized_name(name, CS) + endif + +end subroutine set_initialized_3d_name + +!> Record that the array in f_ptr with the given name has been initialized. +subroutine set_initialized_4d_name(f_ptr, name, CS) + real, dimension(:,:,:,:), & + target, intent(in) :: f_ptr !< The array that has been initialized + character(len=*), intent(in) :: name !< The name of the field that has been initialized + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct + + integer :: m + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "set_initialized: Module must be initialized before it is used.") + + do m=1,CS%novars ; if (associated(CS%var_ptr4d(m)%p,f_ptr)) then + CS%restart_field(m)%initialized = .true. ; exit + endif ; enddo + + if (m==CS%novars+1) then + if (is_root_pe()) & + call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//& + "probably because of the suspect comparison of pointers by ASSOCIATED.") + call set_initialized_name(name, CS) + endif + +end subroutine set_initialized_4d_name + + !> save_restart saves all registered variables to restart files. subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_rest_files, write_IC) character(len=*), intent(in) :: directory !< The directory where the restart files From cde444a85242cff9b38dd29d03d2ea983293ac11 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Sat, 2 Jul 2022 18:54:32 -0400 Subject: [PATCH 51/68] Re-developed makedep in python - Works with system python (2.7) and later (tested with 3.9) - Processes #include without invoking cpp - Currently naive regex without honoring/interpretting CPP macros - Calculates link dependencies directly rather than invoking "make" to infer the link list Changes relative to the bash version of makedep: - No longer adding/using a macro "SRC_DIRS" since it was only used to record the arguments for regenerating the makefile. Now we record the command line to achieve the same re-run ability. - Adds new option "-e" to link all externals. - This was the default before but I think in time we can make this approach more intelligent and figure out which functions/subroutines are used elsewhere. - Processes F90 `include` to build dependencies - Currently not tested with nested `include`s Comments: - As usual, the bizarre self-referencing in drifters.F90 needed some special handling. The self-referencing is associated with code in CPP block to generate local test programs. Now, we filter out circular self-references rather than complain like make does. A large-separation circular dependence will not be caught and lead to unpreditable behavior. Such circular dependence is not something that makes sense to support or allow. - Using only native python featues, no packages, to avoid the "package dependence" we are trying to avoid with makedep. - This python version appears to be of orders of magnitude faster than the bash version. Should have started here ... Todo: [ ] Improve some list/dictionary comprehensions. We use list comprehensions quite a lot but a few "clunky" functions remain when the first attempt at a comprehension failed. I never figrued out a working dictionary comprehension. [ ] Add a solution for the need to always link "externals". --- ac/Makefile.in | 2 +- ac/deps/Makefile.fms.in | 2 +- ac/makedep | 534 +++++++++++++++++++++++----------------- 3 files changed, 311 insertions(+), 227 deletions(-) diff --git a/ac/Makefile.in b/ac/Makefile.in index 2e482ab0c5..599381a35b 100644 --- a/ac/Makefile.in +++ b/ac/Makefile.in @@ -28,7 +28,7 @@ Makefile: @srcdir@/ac/Makefile.in config.status .PHONY: depend depend: Makefile.dep Makefile.dep: - $(MAKEDEP) -o Makefile.dep $(SRC_DIRS) + $(MAKEDEP) -o Makefile.dep -e $(SRC_DIRS) # Delete any files associated with configuration (including the Makefile). diff --git a/ac/deps/Makefile.fms.in b/ac/deps/Makefile.fms.in index fc580a8c9e..e2581cf817 100644 --- a/ac/deps/Makefile.fms.in +++ b/ac/deps/Makefile.fms.in @@ -22,4 +22,4 @@ ARFLAGS = @ARFLAGS@ .PHONY: depend depend: Makefile.dep Makefile.dep: - $(MAKEDEP) -o Makefile.dep -x libFMS.a @srcdir@ + $(MAKEDEP) -o Makefile.dep -e -x libFMS.a @srcdir@ diff --git a/ac/makedep b/ac/makedep index 74d9200ce8..f580d522e1 100755 --- a/ac/makedep +++ b/ac/makedep @@ -1,225 +1,309 @@ -#!/bin/bash - -usage() { - echo "Construct Makfile.dep containing dependencies for F90 source code." - echo - echo "Syntax:" $0 "[-h|d] [-o FILE] [-x EXEC] PATH [PATH] [...]" - echo - echo "arguments:" - echo " PATH Directories containing source code. All subdirectories and" - echo " symbolic links are followed." - echo - echo "options:" - echo " -h Print this help message." - echo " -d Annotate the makefile with extra information." - echo " -o FILE Construct dependencies in FILE instead of Makefile.dep ." - echo " -x EXEC Name of executable to build. Fails if more than one" - echo " is found. If EXEC ends in .a then a library is built." - echo " -f CMD String to use in compile rule. Default is:" - echo " '$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<'" -} - -# Defaults -makefile=Makefile.dep -debug=0 -executable="" -librarymode=0 -compile_line='$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<' - -while getopts dho:x:f: option -do - case "${option}" - in - d)debug=1;; - h)usage; exit;; - o)makefile=${OPTARG};; - x)executable=${OPTARG};; - f)compile_line=${OPTARG};; - esac -done -SRC_DIRS=${@:$OPTIND} - -if [ -z "$SRC_DIRS" ]; then - echo "Error: no search path specified on command line!" - exit 1 -fi - -# Scan everything (Fortran related) (Fortran related) -A=$(find -L ${SRC_DIRS} \( -name "*.F90" -o -name "*.f90" \) ) # all source files -I=`find -L ${SRC_DIRS} \( -name "*.h" -o -name "*.inc" \) | xargs dirname | sort | uniq | sed 's:^:-I:'` # include paths to pass to cpp when checking to see which .h files are used -O=() -externals=() -declare -A o2src o2mod o2use o2H o2head o2inc p2o o2p all_modules -for F in ${A}; do # F is the relative path to source file - f=`basename $F` # file name stripped of path - o=${f/.?90/}.o # object file name - o2src["$o"]=$F - m=`egrep -i "^ *module " $F | sed 's/ *!.*//' | grep -vi procedure | tr '[A-Z]' '[a-z]' | sed 's/.*module *//' | tr -d '\r' | sed 's/$/.mod/' ` # name of module file(s) #### FAILS IF NO MODULE, DOES IT WORK FOR 2+? - u=`sed 's/!.*//' $F | egrep -i "^ *use " | sed 's/\ *[uU][sS][eE]\ *\([a-zA-Z_0-9]*\).*/\1.mod/' | tr '[A-Z]' '[a-z]' | egrep -v "mpi.mod|iso_fortran_env.mod" | sort | uniq ` # list of modules used - if [ ${#m} -ne 0 ]; then - o2mod["$o"]=$m - u=`echo $u | sed s:$m::g` - fi - if [ ${#u} -ne 0 ]; then o2use["$o"]=$u; fi - H=$(cpp -E -MM $I $F | tr -d '\n' | sed 's:\\::g') # line of form a.o: a.F b.h c.h ... - o2H["$o"]=$H - h=`echo ${H} | cut -d\ -f3- ` # header files - if [ ${#h} -ne 0 ]; then o2head["$o"]=$h; fi - i=`dirname _ignore_/ignore ${h} | grep -v _ignore_ | sort | uniq | sed 's:^:-I:'` # includes for compilation - if [ ${#i} -ne 0 ]; then o2inc["$o"]=$i; fi - p=`egrep -i "^ *program " $F | awk '{print $2}'` # name of program if any - if [ $librarymode -eq 0 ]; then - O+=($o) # List of all objects - if [ ${#p} -ne 0 ]; then p2o["$p"]=$o; o2p["$o"]=$p; fi - else - if [ ${#p} -eq 0 ]; then O+=($o); fi - fi - if [ ${#m} -ne 0 ]; then - for mm in $m; do all_modules["$mm"]=1; done - else - if [ ${#p} -eq 0 ]; then - externals+=($o) - fi - fi -done - -# Augment with C files -A=$(find -L ${SRC_DIRS} -name "*.c" ) # all C source files -declare -A o2c -OC=() -for F in ${A}; do # F is the relative path to source file - f=`basename $F` # file name stripped of path - o=${f/.c/}.o # object file name - o2c["$o"]=$F - H=$(cpp -E -MM $I $F | tr -d '\n' | sed 's:\\::g') # line of form a.o: a.F b.h c.h ... - o2H["$o"]=$H - h=`echo ${H} | cut -d\ -f3- ` # header files - if [ ${#h} -ne 0 ]; then o2head["$o"]=$h; fi - i=`dirname _ignore_/ignore ${h} | grep -v _ignore_ | sort | uniq | sed 's:^:-I:'` # includes for compilation - if [ ${#i} -ne 0 ]; then o2inc["$o"]=$i; fi - OC+=($o) # List of all objects - #externals+=($o) -done - -if [[ "$executable" == *\.a ]]; then - lib=$executable -else - lib="" - if [ -n "$executable" ]; then - if [ ${#p2o[@]} -eq 0 ]; then - echo 'Error: Option "-p' $executable'"' provided but no programs are present. - exit 1 - elif [ ${#p2o[@]} -eq 1 ]; then # rename executable - p="${o2p[@]}" - o=${p2o[@]} - unset p2o["$p"] - p2o["$executable"]=$o - o2p["$o"]=$executable - else - echo 'Error: Option "-p' $executable'"' cannot be used when multiple programs are present. - exit 1 - fi - fi -fi - -# Write the new makefile -rm -f ${makefile} -echo "#" ${makefile} "created by makedep" >> ${makefile} -echo >> ${makefile} -echo "all:" $lib ${!p2o[@]} >> ${makefile} -echo >> ${makefile} - -echo "# SRC_DIRS is usually set in the parent Makefile but in case is it not we" >> ${makefile} -echo "# record it here from when makedep was previously invoked." >> ${makefile} -echo "SRC_DIRS ?= ${SRC_DIRS}" >> ${makefile} -echo >> ${makefile} - -# Write rule for each object from Fortran -for o in ${O[@]}; do - F=${o2src["$o"]} # source file - m=${o2mod["$o"]} # modules produced with object file - u=${o2use["$o"]} # modules used/needed by object file - H=${o2H["$o"]} # basic C-style rule produced by cpp - i=${o2inc["$o"]} # -I paths needed at compilation - U=() # modules used that are in source tree - NU=() # modules used that were not found in source tree - if [ ${#u} -ne 0 ]; then - for uu in ${u}; do - if [[ ${all_modules["$uu"]} ]]; then - U+=($uu) # source for used module was found - else - NU+=($uu) # did not find source for module - fi - done - fi - if [ $debug -eq 1 ]; then - h=${o2head["$o"]} - p=${o2p["$o"]} - echo "# Source file" $F "produces:" >> ${makefile} - echo "# object:" $o >> ${makefile} - echo "# modules:" $m >> ${makefile} - echo "# uses:" $u >> ${makefile} - echo "# found:" ${U[@]} >> ${makefile} - echo "# missing:" ${NU[@]} >> ${makefile} - echo "# includes:" $h >> ${makefile} - echo "# incpath:" $i >> ${makefile} - echo "# program:" $p >> ${makefile} - fi - - if [ ${#m} -ne 0 ]; then - if [ ${#NU[@]} -ne 0 ]; then - echo "# Note:" $o "uses modules not found the search path:" ${NU[@]} >> ${makefile} - fi - echo $m":" $o >> ${makefile} # a.mod: a.o - fi - echo $H ${U[@]} >> ${makefile} # a.mod a.o: a.F b.mod - echo -e '\t'$compile_line ${i} >> ${makefile} # compile rule -done - -# Write rule for each object from C -for o in ${OC[@]}; do - F=${o2c["$o"]} # source file - H=${o2H["$o"]} # basic C-style rule produced by cpp - i=${o2inc["$o"]} # -I paths needed at compilation - if [ $debug -eq 1 ]; then - h=${o2head["$o"]} - echo "# Source file" $F "produces:" >> ${makefile} - echo "# object:" $o >> ${makefile} - echo "# includes:" $h >> ${makefile} - echo "# incpath:" $i >> ${makefile} - fi - echo $H ${U[@]} >> ${makefile} # a.mod a.o: a.F b.mod - echo -e '\t$(CC) $(DEFS) $(CPPFLAGS) $(CFLAGS) -c $<' ${i} >> ${makefile} # compile rule -done - -if [ ${#lib} -ne 0 ]; then # rule to build library - echo >> ${makefile} - echo $lib: ${O[@]} ${OC[@]} >> ${makefile} - echo -e '\t$(AR) $(ARFLAGS) $@ $^' >> ${makefile} # archive rule -fi - -if [ ${#p2o[@]} -ne 0 ]; then # write rules for linking executables - echo >> ${makefile} - echo "# Note: The following object files are not associated with modules so we assume we should link with them:" ${externals[@]} >> ${makefile} - - echo >> ${makefile} - for p in ${!p2o[@]}; do # p is the executable name - o=${p2o[$p]} - l=$(make -f ${makefile} -B -n -t $o | egrep "\.o$" | sed 's:touch ::' | sort) - echo $p: $l ${externals[@]} >> ${makefile} - echo -e '\t$(LD) $(LDFLAGS) -o $@ $^ $(LIBS)' >> ${makefile} # link rule - done -elif [ -z "$lib" ]; then - echo "Warning: no library target specified (with -x) and no programs found!" - echo "Created target 'obj': use 'make obj' to compile object files." - echo >> ${makefile} - echo "obj: ${O[@]}" >> ${makefile} -fi - -echo >> ${makefile} -echo clean: >> ${makefile} - echo -e '\trm -rf' ${!p2o[@]} $lib '*.o *.mod' >> ${makefile} # compile rule - -echo >> ${makefile} -echo "remakedep: # re-invoke makedep" >> ${makefile} -echo -e '\t' $0 -o ${makefile} '$(SRC_DIRS)' >> ${makefile} +#!/usr/bin/env python + +from __future__ import print_function + +import argparse +import glob +import os +import re +import sys # used only to get path to current script + +# Pre-compile re searches +re_module = re.compile(r"^ *module +([a-z_0-9]+)") +re_use = re.compile(r"^ *use +([a-z_0-9]+)") +re_cpp_include = re.compile(r"^ *# *include *[<\"']([a-zA-Z_0-9\.]+)[>\"']") +re_f90_include = re.compile(r"^ *include +[\"']([a-zA-Z_0-9\.]+)[\"']") +re_program = re.compile(r"^ *[pP][rR][oO][gG][rR][aA][mM] +([a-zA-Z_0-9]+)") + +def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, script_path): + """Create "makefile" after scanning "src_dis".""" + + # Scan everything Fortran related + all_files = find_files(src_dirs) + + # Lists of things + # ... all F90 source + F90_files = [f for f in all_files if f.endswith('.f90') or f.endswith('.F90')] + # ... all C source + c_files = [f for f in all_files if f.endswith('.c')] + + # Dictionaries for associating files to files + # maps basename of file to full path to file + f2F = dict( zip( [os.path.basename(f) for f in all_files], all_files ) ) + # maps basename of file to directory + f2dir = dict( zip( [os.path.basename(f) for f in all_files], [os.path.dirname(f) for f in all_files] ) ) + + # Check for duplicate files in search path + if not len(f2F) == len(all_files): + a = [] + for f in all_files: + if os.path.basename(f) in a: + raise ValueError('File %s was found twice!'%(os.path.basename(f))) + a.append( os.path.basename(f) ) + + # maps object file to F90 source + o2F90 = dict( zip( [ object_file(f) for f in F90_files ], F90_files ) ) + # maps object file to C source + o2c = dict( zip( [ object_file(f) for f in c_files ], c_files ) ) + + o2mods, o2uses, o2h, o2inc, o2prg, prg2o, mod2o = {}, {}, {}, {}, {}, {}, {} + externals, all_modules = [], [] + for f in F90_files: + mods, used, cpp, inc, prg = scan_fortran_file( f ) + # maps object file to modules produced + o2mods[ object_file(f) ] = mods + # maps module produced to object file + for m in mods: + mod2o[ m ] = object_file(f) + # maps object file to modules used + o2uses[ object_file(f) ] = used + # maps object file to .h files included + o2h[ object_file(f) ] = cpp + # maps object file to .inc files included + o2inc[ object_file(f) ] = inc + # maps object file to executables produced + o2prg[ object_file(f) ] = prg + if prg: + for p in prg: + if p in prg2o.keys(): + #raise ValueError("Files %s and %s both create the same program '%s'"%( + # f,o2F90[prg2o[p]],p)) + print("Warning: Files %s and %s both create the same program '%s'"%( + f,o2F90[prg2o[p]],p)) + o = prg2o[ p ] + del prg2o[ p ] + #del o2prg[ o ] - need to keep so modifying instead + o2prg[ o ] = [ '[ignored %s]'%(p) ] + else: + prg2o[ p ] = object_file(f) + if not mods and not prg: + externals.append( object_file(f) ) + all_modules += mods + + for f in c_files: + _, _, cpp, inc, _ = scan_fortran_file( f ) + # maps object file to .h files included + o2h[ object_file(f) ] = cpp + + # Are we building a library, single or multiple executables? + targ_libs = [] + if exec_target: + if exec_target.endswith('.a'): + targ_libs.append( exec_target ) + else: + if len(prg2o.keys()) == 1: + o = prg2o.values()[0] + del prg2o[ o2prg[o][0] ] + prg2o[ exec_target ] = o + o2prg[ o ] = exec_target + else: + raise ValueError("Option -x specified an executable name but none or multiple programs were found") + targets = [ exec_target ] + else: + if len(prg2o.keys()) == 0: + print("Warning: No programs were found and -x did not specify a library to build") + targets = prg2o.keys() + + # Create new makefile + with open(makefile, 'w') as file: + print("# %s created by makedep"%(makefile), file=file) + print("", file=file) + print("# Invoked as", file=file) + print('# '+' '.join(sys.argv), file=file) + print("", file=file) + print("all:", " ".join( targets ), file=file) + print("", file=file) + + #print("# SRC_DIRS is usually set in the parent Makefile but in case is it not we", file=file) + #print("# record it here from when makedep was previously invoked.", file=file) + #print("SRC_DIRS ?= ${SRC_DIRS}", file=file) + #print("", file=file) + + #print("# all_files:", ' '.join(all_files), file=file) + #print("", file=file) + + # Write rule for each object from Fortran + for o in sorted( o2F90.keys() ): + found_mods = [m for m in o2uses[o] if m in all_modules] + missing_mods = [m for m in o2uses[o] if m not in all_modules] + incs = nested_h( o2h[o], f2F ) + incdeps = includes_in_path(incs, f2F, f2dir, all_files, o2F90[o]) + incargs = sorted( set( [ '-I'+os.path.dirname(f) for f in incdeps ] ) ) + if debug: + print("# Source file %s produces:"%(o2F90[o]), file=file) + print("# object:", o, file=file) + print("# modules:", ' '.join(o2mods[o]), file=file) + print("# uses:", ' '.join(o2uses[o]), file=file) + print("# found:", ' '.join(found_mods), file=file) + print("# missing:", ' '.join(missing_mods), file=file) + print("# includes_all:", ' '.join(incs), file=file) + print("# includes_pth:", ' '.join(incdeps), file=file) + print("# incargs:", ' '.join(incargs), file=file) + print("# program:", ' '.join(o2prg[o]), file=file) + if o2mods[o]: + print(' '.join(o2mods[o])+':',o, file=file) + print(o+':', o2F90[o], ' '.join(incdeps+found_mods), file=file) + print('\t'+fc_rule, ' '.join(incargs), file=file) + + # Write rule for each object from C + for o in sorted( o2c.keys() ): + incdeps = includes_in_path(o2h[o], f2F, f2dir, all_files, o2c[o]) + incargs = sorted( set( [ '-I'+os.path.dirname(f) for f in incdeps ] ) ) + if debug: + print("# Source file %s produces:"%(o2c[o]), file=file) + print("# object:", o, file=file) + print("# includes_all:", ' '.join(o2h[o]), file=file) + print("# includes_pth:", ' '.join(incdeps), file=file) + print("# incargs:", ' '.join(incargs), file=file) + print(o+':', o2c[o], ' '.join(incdeps), file=file) + print('\t$(CC) $(DEFS) $(CPPFLAGS) $(CFLAGS) -c $<', ' '.join(incargs), file=file) + + # Externals (so called) + if link_externals: + print("", file=file) + print("# Note: The following object files are not associated with modules so we assume we should link with them:", file=file) + print("# ", ' '.join(externals), file=file) + o2x = None + else: + externals = [] + + # Write rules for linking executables + for p in sorted( prg2o.keys() ): + o = prg2o[p] + print("", file=file) + print(p+':',' '.join( link_obj(o, o2uses, mod2o, all_modules) + externals ), file=file ) + print('\t$(LD) $(LDFLAGS) -o $@ $^ $(LIBS)', file=file) + + # Write rules for building libraries + for l in sorted( targ_libs ): + print("", file=file) + print(l+':',' '.join( list(o2F90.keys()) + list(o2c.keys()) ), file=file ) + print('\t$(AR) $(ARFLAGS) $@ $^', file=file) + + # Write cleanup rules + print("", file=file) + print("clean:", file=file) + print('\trm -f *.mod *.o', ' '.join(list(prg2o.keys()) + targ_libs), file=file) + + # Write re-generation rules + print("", file=file) + print("remakedep:", file=file) + print('\t'+' '.join(sys.argv), file=file) + +def link_obj(obj, o2uses, mod2o, all_modules): + """List of all objects needed to link "obj",""" + def recur(obj, depth=0): + if obj not in olst: + olst.append( obj) + else: + return + uses = [m for m in o2uses[obj] if m in all_modules] + if len(uses)>0: + ouses = [mod2o[m] for m in uses] + for m in uses: + o = mod2o[m] + recur(o, depth=depth+1) + #if o not in olst: + # recur(o, depth=depth+1) + # olst.append( o ) + return + return + olst = [] + recur(obj) + return sorted( set( olst) ) + +def nested_h(hfiles, f2F): + """List of all headers included by "hfiles",""" + def recur(hfile): + if hfile not in f2F.keys(): + return + _, _, cpp, inc, _ = scan_fortran_file( f2F[hfile] ) + if len(cpp)+len(inc)>0: + for h in cpp+inc: + if h not in hlst and h in f2F.keys(): + recur(h) + hlst.append( h ) + return + return + hlst = [] + for h in hfiles: + recur(h) + return hfiles + sorted( set( hlst ) ) + +def scan_fortran_file(src_file): + """Scan the Fortran file "src_file" and return lists of module defined, module used, and files included.""" + module_decl, used_modules, cpp_includes, f90_includes, programs = [], [], [], [], [] + with open(src_file, 'r') as file: + lines = file.readlines() + for line in lines: + match = re_module.match( line.lower() ) + if match: + if match.group(1) not in 'procedure': # avoid "module procedure" statements + module_decl.append( match.group(1) ) + match = re_use.match( line.lower() ) + if match: + used_modules.append( match.group(1) ) + match = re_cpp_include.match( line ) + if match: + cpp_includes.append( match.group(1) ) + match = re_f90_include.match( line ) + if match: + f90_includes.append( match.group(1) ) + match = re_program.match( line ) + if match: + programs.append( match.group(1) ) + used_modules = [m for m in sorted(set(used_modules)) if m not in module_decl] + return add_suff(module_decl, '.mod'), add_suff( used_modules, '.mod'), cpp_includes, f90_includes, programs + #return add_suff(module_decl, '.mod'), add_suff( sorted(set(used_modules)), '.mod'), cpp_includes, f90_includes, programs + +def object_file(src_file): + """Return the name of an object file that results from compiling src_file.""" + return os.path.splitext( os.path.basename( src_file ) )[0] + '.o' + + +def find_files(src_dirs): + """Return sorted list of all source files starting from each directory in the list "src_dirs".""" + files = [] + for path in src_dirs: + if not os.path.isdir(path): + raise ValueError("Directory '%s' was not found"%(path)) + for p, d, f in os.walk( os.path.normpath(path), followlinks=True): + for file in f: + if file.endswith('.F90') or file.endswith('.f90') or file.endswith('.h') or file.endswith('.inc') or file.endswith('.c'): + files.append(p+'/'+file) + return sorted( set( files ) ) + +def add_suff(lst, suff): + """Add "suff" to each item in the list""" + return [ f+suff for f in lst ] + +def includes_in_path(inc_files, f2F, f2dir, all_files, this_src): + """Return full path list of files in inc_files that can be found.""" + incs = [] + for i in inc_files: + if i in f2F: + incs.append( f2F[i] ) + return sorted( set(incs) ) + +# Parse arguments +parser = argparse.ArgumentParser( + description="Generate make dependencies for F90 source code.") +parser.add_argument('path', nargs='+', + help="Directories to search for source code.") +parser.add_argument('-o', '--makefile', default='Makefile.dep', + help="Name of Makefile to put dependencies in to. Default is Makefile.dep.") +parser.add_argument('-f', '--fc_rule', default="$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<", + help="""String to use in the compilation rule. Default is: + '$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<'""") +parser.add_argument('-x', '--exec_target', + help="""Name of executable to build. + Fails if more than one program is found. + If EXEC ends in .a then a library is built.""") +parser.add_argument('-e', '--link_externals', action='store_true', + help="Always compile and link any files that do not produce modules (externals).") +parser.add_argument('-d', '--debug', action='store_true', + help="Annotate the makefile with extra information.") +args = parser.parse_args() + +# Do the thing +create_deps(args.path, args.makefile, args.debug, args.exec_target, args.fc_rule, args.link_externals, sys.argv[0]) From 5121534cf7c8051de0468aef784487a48c568e57 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 6 Jul 2022 10:29:02 -0400 Subject: [PATCH 52/68] makedep: fix for F90 includes - @marshallward suggested this fix to recursively follow F90 includes when building the list of dependencies. - Renamed the function from nested_h() to nested_inc() to be better describe function Co-authored-by: Marshall Ward --- ac/makedep | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ac/makedep b/ac/makedep index f580d522e1..b9aab41553 100755 --- a/ac/makedep +++ b/ac/makedep @@ -126,7 +126,7 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, for o in sorted( o2F90.keys() ): found_mods = [m for m in o2uses[o] if m in all_modules] missing_mods = [m for m in o2uses[o] if m not in all_modules] - incs = nested_h( o2h[o], f2F ) + incs = nested_inc( o2h[o] + o2inc[o], f2F ) incdeps = includes_in_path(incs, f2F, f2dir, all_files, o2F90[o]) incargs = sorted( set( [ '-I'+os.path.dirname(f) for f in incdeps ] ) ) if debug: @@ -212,8 +212,8 @@ def link_obj(obj, o2uses, mod2o, all_modules): recur(obj) return sorted( set( olst) ) -def nested_h(hfiles, f2F): - """List of all headers included by "hfiles",""" +def nested_inc(inc_files, f2F): + """List of all files included by "inc_files", either by #include or F90 include.""" def recur(hfile): if hfile not in f2F.keys(): return @@ -226,9 +226,9 @@ def nested_h(hfiles, f2F): return return hlst = [] - for h in hfiles: + for h in inc_files: recur(h) - return hfiles + sorted( set( hlst ) ) + return inc_files + sorted( set( hlst ) ) def scan_fortran_file(src_file): """Scan the Fortran file "src_file" and return lists of module defined, module used, and files included.""" From 258111803ed4317a96276283734e19832d0ea813 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 6 Jul 2022 10:35:13 -0400 Subject: [PATCH 53/68] makedep: replaced includes_in_path() with list comprehension - The function includes_in_path() had many unused arguments and was left over from development. It turned out to be easy and clean to replace with a list comprehension. --- ac/makedep | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/ac/makedep b/ac/makedep index b9aab41553..bc8fd81056 100755 --- a/ac/makedep +++ b/ac/makedep @@ -127,7 +127,7 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, found_mods = [m for m in o2uses[o] if m in all_modules] missing_mods = [m for m in o2uses[o] if m not in all_modules] incs = nested_inc( o2h[o] + o2inc[o], f2F ) - incdeps = includes_in_path(incs, f2F, f2dir, all_files, o2F90[o]) + incdeps = sorted( set( [ f2F[f] for f in incs if f in f2F ] ) ) incargs = sorted( set( [ '-I'+os.path.dirname(f) for f in incdeps ] ) ) if debug: print("# Source file %s produces:"%(o2F90[o]), file=file) @@ -147,7 +147,7 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, # Write rule for each object from C for o in sorted( o2c.keys() ): - incdeps = includes_in_path(o2h[o], f2F, f2dir, all_files, o2c[o]) + incdeps = sorted( set( [ f2F[h] for h in o2h[o] if h in f2F ] ) ) incargs = sorted( set( [ '-I'+os.path.dirname(f) for f in incdeps ] ) ) if debug: print("# Source file %s produces:"%(o2c[o]), file=file) @@ -277,14 +277,6 @@ def add_suff(lst, suff): """Add "suff" to each item in the list""" return [ f+suff for f in lst ] -def includes_in_path(inc_files, f2F, f2dir, all_files, this_src): - """Return full path list of files in inc_files that can be found.""" - incs = [] - for i in inc_files: - if i in f2F: - incs.append( f2F[i] ) - return sorted( set(incs) ) - # Parse arguments parser = argparse.ArgumentParser( description="Generate make dependencies for F90 source code.") From 9ecf1a6c7c49718bc54bd041833b27dbdc063237 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 6 Jul 2022 11:27:39 -0400 Subject: [PATCH 54/68] makedep: Allow two versions of same file - @marshallward reported that FMS2 has multiple versions of the same file int he search path. To avoid fatal errors, we are now allowing an ambiguous outcome and simple throwing out a warning that two files of the same name were encountered. Co-authored-by: Marshall Ward --- ac/makedep | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ac/makedep b/ac/makedep index bc8fd81056..443371a79f 100755 --- a/ac/makedep +++ b/ac/makedep @@ -38,7 +38,7 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, a = [] for f in all_files: if os.path.basename(f) in a: - raise ValueError('File %s was found twice!'%(os.path.basename(f))) + print('Warning: File %s was found twice! One is being ignored but which is undefined.'%(os.path.basename(f))) a.append( os.path.basename(f) ) # maps object file to F90 source From 1f64bf1ab409808d967e0592f52b42b0fe5a5979 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Mon, 20 Jun 2022 14:11:44 -0800 Subject: [PATCH 55/68] +Tiny fix to SIMPLE Northern OBC --- src/core/MOM_open_boundary.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index e7720a15fc..a5382910b8 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1991,7 +1991,7 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) if (segment%direction == OBC_DIRECTION_S) then areaCv(i,J) = G%areaT(i,j+1) ! Both of these are in [L2 ~> m2] else ! North - areaCu(i,J) = G%areaT(i,j) ! Both of these are in [L2 ~> m2] + areaCv(i,J) = G%areaT(i,j) ! Both of these are in [L2 ~> m2] endif enddo endif @@ -3814,13 +3814,13 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (OBC%brushcutter_mode) then allocate(tmp_buffer(1,nj_seg*2-1,segment%field(m)%nk_src)) ! segment data is currently on supergrid else - allocate(tmp_buffer(1,nj_seg,segment%field(m)%nk_src)) ! segment data is currently on supergrid + allocate(tmp_buffer(1,nj_seg,segment%field(m)%nk_src)) ! segment data is currently on native grid endif else if (OBC%brushcutter_mode) then allocate(tmp_buffer(ni_seg*2-1,1,segment%field(m)%nk_src)) ! segment data is currently on supergrid else - allocate(tmp_buffer(ni_seg,1,segment%field(m)%nk_src)) ! segment data is currently on supergrid + allocate(tmp_buffer(ni_seg,1,segment%field(m)%nk_src)) ! segment data is currently on native grid endif endif From c9dd80404504102e320e6a5ec23ce554eae31a6b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 22 Jun 2022 13:55:41 -0400 Subject: [PATCH 56/68] MacOS support This patch makes several changes to to provide better support for MacOS and BSD-like systems. Autoconf now includes macros to determine the following: * The name of sigsetjmp: `sigsetjmp` (BSD) or `__sigsetjmp` (Linux) * The size of `jmp_buf` and `sigjmp_buf`. Also renamed to `SIZEOF_*` to align with autoconf macro name conventions. The Linux defaults are retained in `posix.h`, but autoconf will now override these values. Two CI tests for MacOS have also been added, replicating the "stencil" and "regression" tests. The testing-setup has also been restructured to account for multiple platforms. Currently only Ubuntu and MacOS are tested. --- .github/actions/macos-setup/action.yml | 17 ++++++++++++ .github/actions/testing-setup/action.yml | 9 ------- .github/actions/ubuntu-setup/action.yml | 19 +++++++++++++ .github/workflows/coupled-api.yml | 2 ++ .github/workflows/coverage.yml | 2 ++ .github/workflows/expression.yml | 2 ++ .github/workflows/macos-regression.yml | 34 ++++++++++++++++++++++++ .github/workflows/macos-stencil.yml | 34 ++++++++++++++++++++++++ .github/workflows/other.yml | 2 ++ .github/workflows/perfmon.yml | 2 ++ .github/workflows/regression.yml | 2 ++ .github/workflows/stencil.yml | 2 ++ ac/configure.ac | 32 ++++++++++++++++++---- src/framework/posix.F90 | 4 +-- src/framework/posix.h | 10 +++---- 15 files changed, 151 insertions(+), 22 deletions(-) create mode 100644 .github/actions/macos-setup/action.yml create mode 100644 .github/actions/ubuntu-setup/action.yml create mode 100644 .github/workflows/macos-regression.yml create mode 100644 .github/workflows/macos-stencil.yml diff --git a/.github/actions/macos-setup/action.yml b/.github/actions/macos-setup/action.yml new file mode 100644 index 0000000000..645a51b619 --- /dev/null +++ b/.github/actions/macos-setup/action.yml @@ -0,0 +1,17 @@ +name: 'install-macos-prerequisites' + +description: 'Install prerequisites for Mac OS compilation' + +runs: + using: 'composite' + + steps: + - name: Install macOS packages + shell: bash + run: | + echo "::group::Install packages" + brew update + brew install automake + brew install netcdf + brew install mpich + echo "::endgroup::" diff --git a/.github/actions/testing-setup/action.yml b/.github/actions/testing-setup/action.yml index e95145c1a1..a21ee949db 100644 --- a/.github/actions/testing-setup/action.yml +++ b/.github/actions/testing-setup/action.yml @@ -27,15 +27,6 @@ runs: env echo "::endgroup::" - - name: Install needed packages for compiling - shell: bash - run: | - echo "::group::Install linux packages" - sudo apt-get update - sudo apt-get install netcdf-bin libnetcdf-dev libnetcdff-dev mpich libmpich-dev - sudo apt-get install linux-tools-common - echo "::endgroup::" - - name: Compile FMS library shell: bash run: | diff --git a/.github/actions/ubuntu-setup/action.yml b/.github/actions/ubuntu-setup/action.yml new file mode 100644 index 0000000000..3fd2ea13cf --- /dev/null +++ b/.github/actions/ubuntu-setup/action.yml @@ -0,0 +1,19 @@ +name: 'install-ubuntu-prerequisites' + +description: 'Install prerequisites for Ubuntu Linux compilation' + +runs: + using: 'composite' + steps: + - name: Install Ubuntu Linux packages + shell: bash + run: | + echo "::group::Install linux packages" + sudo apt-get update + sudo apt-get install netcdf-bin + sudo apt-get install libnetcdf-dev + sudo apt-get install libnetcdff-dev + sudo apt-get install mpich + sudo apt-get install libmpich-dev + sudo apt-get install linux-tools-common + echo "::endgroup::" diff --git a/.github/workflows/coupled-api.yml b/.github/workflows/coupled-api.yml index 86d7262548..443755c7f4 100644 --- a/.github/workflows/coupled-api.yml +++ b/.github/workflows/coupled-api.yml @@ -15,6 +15,8 @@ jobs: with: submodules: recursive + - uses: ./.github/actions/ubuntu-setup + - uses: ./.github/actions/testing-setup with: build_symmetric: 'false' diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index 84fc4c75ff..1fc95e9127 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -18,6 +18,8 @@ jobs: with: submodules: recursive + - uses: ./.github/actions/ubuntu-setup + - uses: ./.github/actions/testing-setup - name: Compile unit testing diff --git a/.github/workflows/expression.yml b/.github/workflows/expression.yml index 020d656aee..adedf630b9 100644 --- a/.github/workflows/expression.yml +++ b/.github/workflows/expression.yml @@ -15,6 +15,8 @@ jobs: with: submodules: recursive + - uses: ./.github/actions/ubuntu-setup + - uses: ./.github/actions/testing-setup - name: Compile MOM6 using repro optimization diff --git a/.github/workflows/macos-regression.yml b/.github/workflows/macos-regression.yml new file mode 100644 index 0000000000..d975854e0c --- /dev/null +++ b/.github/workflows/macos-regression.yml @@ -0,0 +1,34 @@ +name: MacOS regression + +on: [pull_request] + +jobs: + test-macos-regression: + + runs-on: macOS-latest + + env: + CC: gcc-11 + FC: gfortran-11 + + defaults: + run: + working-directory: .testing + + steps: + - uses: actions/checkout@v2 + with: + submodules: recursive + + - uses: ./.github/actions/macos-setup + + - uses: ./.github/actions/testing-setup + + - name: Compile reference model + run: make build.regressions MOM_TARGET_SLUG=$GITHUB_REPOSITORY MOM_TARGET_LOCAL_BRANCH=$GITHUB_BASE_REF DO_REGRESSION_TESTS=true -j + + - name: Create validation data + run: make run.symmetric -k -s + + - name: Regression test + run: make test.regression DO_REGRESSION_TESTS=true -k -s diff --git a/.github/workflows/macos-stencil.yml b/.github/workflows/macos-stencil.yml new file mode 100644 index 0000000000..33436c221f --- /dev/null +++ b/.github/workflows/macos-stencil.yml @@ -0,0 +1,34 @@ +name: MacOS stencil tests + +on: [push, pull_request] + +jobs: + test-macos-stencil: + + runs-on: macOS-latest + + env: + CC: gcc-11 + FC: gfortran-11 + + defaults: + run: + working-directory: .testing + + steps: + - uses: actions/checkout@v2 + with: + submodules: recursive + + - uses: ./.github/actions/macos-setup + + - uses: ./.github/actions/testing-setup + + - name: Compile MOM6 in asymmetric memory mode + run: make build/asymmetric/MOM6 -j + + - name: Create validation data + run: make run.symmetric -k -s + + - name: Run tests + run: make test.grid test.layout test.rotate -k -s diff --git a/.github/workflows/other.yml b/.github/workflows/other.yml index 34239b0b7c..c992c8c6ec 100644 --- a/.github/workflows/other.yml +++ b/.github/workflows/other.yml @@ -15,6 +15,8 @@ jobs: with: submodules: recursive + - uses: ./.github/actions/ubuntu-setup + - uses: ./.github/actions/testing-setup - name: Compile with openMP diff --git a/.github/workflows/perfmon.yml b/.github/workflows/perfmon.yml index 00e645c4fd..896b9d51d8 100644 --- a/.github/workflows/perfmon.yml +++ b/.github/workflows/perfmon.yml @@ -15,6 +15,8 @@ jobs: with: submodules: recursive + - uses: ./.github/actions/ubuntu-setup + - uses: ./.github/actions/testing-setup - name: Compile optimized models diff --git a/.github/workflows/regression.yml b/.github/workflows/regression.yml index acc42e4720..15dcdbceb2 100644 --- a/.github/workflows/regression.yml +++ b/.github/workflows/regression.yml @@ -15,6 +15,8 @@ jobs: with: submodules: recursive + - uses: ./.github/actions/ubuntu-setup + - uses: ./.github/actions/testing-setup - name: Compile reference model diff --git a/.github/workflows/stencil.yml b/.github/workflows/stencil.yml index 51a0611fc4..6f4a7b1790 100644 --- a/.github/workflows/stencil.yml +++ b/.github/workflows/stencil.yml @@ -15,6 +15,8 @@ jobs: with: submodules: recursive + - uses: ./.github/actions/ubuntu-setup + - uses: ./.github/actions/testing-setup - name: Compile MOM6 in asymmetric memory mode diff --git a/ac/configure.ac b/ac/configure.ac index 15a14708e0..bf1cf11776 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -137,9 +137,7 @@ AC_LANG_POP([C]) # NOTE: We test for nf_create, rather than nf90_create, because AX_FC_CHECK_LIB # is currently not yet able to properly probe inside modules. -# Testing of the nf90_* functions will require a macro update. -# NOTE: nf-config does not have a --libdir flag, so we use --prefix and assume -# that libraries are in the $prefix/lib directory. +# NOTE: nf-config does not have --libdir, so we use the first term of flibs. # Link to Fortran netCDF library, netcdff AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ @@ -147,9 +145,9 @@ AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ AC_PATH_PROG([NF_CONFIG], [nf-config]) AS_IF([test -n "$NF_CONFIG"], [ AC_SUBST([LDFLAGS], - ["$LDFLAGS -L$($NF_CONFIG --prefix)/lib"] + ["$LDFLAGS $($NF_CONFIG --flibs | cut -f1 -d" ")"] ) - ], [AC_MSG_ERROR([Could not find nf-config.])] + ], [AC_MSG_ERROR([Could not find nf_create.])] ) AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ AC_MSG_ERROR([Could not find libnetcdff.]) @@ -235,6 +233,30 @@ AC_SUBST([SRC_DIRS], ) AC_CONFIG_COMMANDS([Makefile.dep], [make depend]) + +# setjmp verification +AC_LANG_PUSH([C]) + +# Verify that either sigsetjmp (POSIX) or __sigsetjmp (glibc) are available. +AC_CHECK_FUNC([sigsetjmp]) +AS_IF([test "$ac_cv_func_sigsetjmp" == "yes"], [ + SIGSETJMP_NAME="sigsetjmp" +], [ + AC_CHECK_FUNC([__sigsetjmp], [ + SIGSETJMP_NAME="__sigsetjmp" + ], [ + AC_MSG_ERROR([Could not find a symbol for sigsetjmp.]) + ]) +]) +AC_DEFINE_UNQUOTED([SIGSETJMP_NAME], ["$SIGSETJMP_NAME"]) + +# Determine the size of jmp_buf and sigjmp_buf +AC_CHECK_SIZEOF([jmp_buf], [], [#include ]) +AC_CHECK_SIZEOF([sigjmp_buf], [], [#include ]) + +AC_LANG_POP([C]) + + # Prepare output AC_SUBST([CPPFLAGS]) AC_CONFIG_FILES([Makefile:${srcdir}/ac/Makefile.in]) diff --git a/src/framework/posix.F90 b/src/framework/posix.F90 index 0a534db6c0..522024071e 100644 --- a/src/framework/posix.F90 +++ b/src/framework/posix.F90 @@ -19,7 +19,7 @@ module posix !! and any information required to restore the process state. type, bind(c) :: jmp_buf private - character(kind=c_char) :: state(JMP_BUF_SIZE) + character(kind=c_char) :: state(SIZEOF_JMP_BUF) !< Unstructured array of bytes used to store the process state end type jmp_buf @@ -28,7 +28,7 @@ module posix !! In addition to the content stored by `jmp_buf`, it also stores signal state. type, bind(c) :: sigjmp_buf private - character(kind=c_char) :: state(SIGJMP_BUF_SIZE) + character(kind=c_char) :: state(SIZEOF_SIGJMP_BUF) !< Unstructured array of bytes used to store the process state end type sigjmp_buf diff --git a/src/framework/posix.h b/src/framework/posix.h index 6d6012c5e7..d60a868a91 100644 --- a/src/framework/posix.h +++ b/src/framework/posix.h @@ -3,18 +3,16 @@ ! JMP_BUF_SIZE should be set to sizeof(jmp_buf). ! If unset, then use a typical glibc value (25 long ints) -#ifndef JMP_BUF_SIZE -#define JMP_BUF_SIZE 200 +#ifndef SIZEOF_JMP_BUF +#define SIZEOF_JMP_BUF 200 #endif ! If unset, assume jmp_buf and sigjmp_buf are equivalent (as in glibc). -#ifndef SIGJMP_BUF_SIZE -#define SIGJMP_BUF_SIZE JMP_BUF_SIZE +#ifndef SIZEOF_SIGJMP_BUF +#define SIZEOF_SIGJMP_BUF SIZEOF_JMP_BUF #endif ! glibc defines sigsetjmp as __sigsetjmp via macro readable from . -! Perhaps autoconf can configure this one... -! TODO: Need a solution here! #ifndef SIGSETJMP_NAME #define SIGSETJMP_NAME "__sigsetjmp" #endif From 58d704bc1c883531995fd6571c68dba64f4bb1ab Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Tue, 21 Jun 2022 11:36:24 -0400 Subject: [PATCH 57/68] fix call to tridiagonal solver --- src/diagnostics/MOM_wave_structure.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index c6b582a72d..d11a7af5ec 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -464,8 +464,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !call tridiag_solver(a_diag(1:kc-1),b_diag(1:kc-1),c_diag(1:kc-1), & ! -lam_z(1:kc-1),e_guess(1:kc-1),"TDMA_T",e_itt) - call solve_diag_dominant_tridiag( a_diag(1:kc-1), -lam_z(1:kc-1), & - c_diag(1:kc-1), e_guess(1:kc-1), & + call solve_diag_dominant_tridiag( c_diag(1:kc-1), b_diag(1:kc-1) - (a_diag(1:kc-1)+c_diag(1:kc-1)), & + a_diag(1:kc-1), e_guess(1:kc-1), & e_itt, kc-1 ) e_guess(1:kc-1) = e_itt(1:kc-1) / sqrt(sum(e_itt(1:kc-1)**2)) enddo ! itt-loop From 43771d85c7902b1eb3235b43522adc080916de43 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 8 Jul 2022 09:51:12 -0400 Subject: [PATCH 58/68] (*)Correct salinity rescaling in OBCs from files Copy scaling factors for tracers in scale_factor_from_name, to accommodate the possibility that calls to register_segment_tracer might occur before calls to initialize_segment_data, as they do for temperature and salinity, or afterwards as they do for many user-defined tracers. This commit addresses the issue with the dumbbell subdomain test case not exhibiting proper rescaling for salinity as described in https://github.com/NOAA-GFDL/MOM6/issues/148. Some incorrect unit descriptions in comments were also corrected, and the tracer name comparisons for setting rescaling were made case-insensitive to handle some inconsistently cased name declarations. All answers without dimensional rescaling are bitwise identical. --- src/core/MOM_open_boundary.F90 | 49 +++++++++++++++++++++++++--------- 1 file changed, 36 insertions(+), 13 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index a5382910b8..c768654cc4 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -19,7 +19,7 @@ module MOM_open_boundary use MOM_restart, only : register_restart_field, register_restart_pair use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_obsolete_params, only : obsolete_logical, obsolete_int, obsolete_real, obsolete_char -use MOM_string_functions, only : extract_word, remove_spaces +use MOM_string_functions, only : extract_word, remove_spaces, uppercase use MOM_tidal_forcing, only : astro_longitudes, astro_longitudes_init, eq_phase, nodal_fu, tidal_frequency use MOM_time_manager, only : set_date, time_type, time_type_to_real, operator(-) use MOM_tracer_registry, only : tracer_type, tracer_registry_type, tracer_name_lookup @@ -309,6 +309,7 @@ module MOM_open_boundary real, allocatable :: cff_normal(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] real, allocatable :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc] real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc] + logical :: debug !< If true, write verbose checksums for debugging purposes. real :: silly_h !< A silly value of thickness outside of the domain that can be used to test !! the independence of the OBCs to this external data [H ~> m or kg m-2]. real :: silly_u !< A silly value of velocity outside of the domain that can be used to test @@ -365,7 +366,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) ! Local variables integer :: l ! For looping over segments - logical :: debug_OBC, debug, mask_outside, reentrant_x, reentrant_y + logical :: debug_OBC, mask_outside, reentrant_x, reentrant_y character(len=15) :: segment_param_str ! The run-time parameter name for each segment character(len=1024) :: segment_str ! The contents (rhs) for parameter "segment_param_str" character(len=200) :: config1 ! String for OBC_USER_CONFIG @@ -467,9 +468,9 @@ subroutine open_boundary_config(G, US, param_file, OBC) OBC%add_tide_constituents = .false. endif - call get_param(param_file, mdl, "DEBUG", debug, default=.false.) + call get_param(param_file, mdl, "DEBUG", OBC%debug, default=.false.) call get_param(param_file, mdl, "DEBUG_OBC", debug_OBC, default=.false.) - if (debug_OBC .or. debug) & + if (debug_OBC .or. OBC%debug) & call log_param(param_file, mdl, "DEBUG_OBC", debug_OBC, & "If true, do additional calls to help debug the performance "//& "of the open boundary condition code.", default=.false., & @@ -751,7 +752,9 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) OBC%needs_IO_for_data = .true. ! At least one segment is using I/O for OBC data ! segment%values_needed = .true. ! Indicates that i/o will be needed for this segment segment%field(m)%name = trim(fields(m)) - segment%field(m)%scale = scale_factor_from_name(fields(m), GV, US) + ! The scale factor for tracers may also be set in register_segment_tracer, and a constant input + ! value is rescaled there. + segment%field(m)%scale = scale_factor_from_name(fields(m), GV, US, segment%tr_Reg) if (segment%field(m)%name == 'TEMP') then segment%temp_segment_data_exists = .true. segment%t_values_needed = .false. @@ -908,9 +911,9 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) else segment%field(m)%fid = -1 segment%field(m)%name = trim(fields(m)) - ! The scale factor for tracers is set in register_segment_tracer, and value is - ! rescaled there. scale_factor_from_name returns 1 for tracers. - segment%field(m)%scale = scale_factor_from_name(fields(m), GV, US) + ! The scale factor for tracers may also be set in register_segment_tracer, and a constant input + ! value is rescaled there. + segment%field(m)%scale = scale_factor_from_name(fields(m), GV, US, segment%tr_Reg) segment%field(m)%value = segment%field(m)%scale * value ! Check if this is a tidal field. If so, the number @@ -969,10 +972,15 @@ end subroutine initialize_segment_data !> Return an appropriate dimensional scaling factor for input data based on an OBC segment data !! name, or 1 for tracers or other fields that do not match one of the specified names. -real function scale_factor_from_name(name, GV, US) +!! Note that calls to register_segment_tracer can come before or after calls to scale_factor_from_name. + +real function scale_factor_from_name(name, GV, US, Tr_Reg) character(len=*), intent(in) :: name !< The OBC segment data name to interpret type(verticalGrid_type), intent(in) :: GV !< Container for vertical grid information type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(segment_tracer_registry_type), pointer :: Tr_Reg !< pointer to tracer registry for this segment + + integer :: m select case (trim(name)) case ('U') ; scale_factor_from_name = US%m_s_to_L_T @@ -986,6 +994,16 @@ real function scale_factor_from_name(name, GV, US) case default ; scale_factor_from_name = 1.0 end select + if (associated(Tr_Reg) .and. (scale_factor_from_name == 1.0)) then + ! Check for name matches with previously registered tracers. + do m=1,Tr_Reg%ntseg + if (uppercase(name) == uppercase(Tr_Reg%Tr(m)%name)) then + scale_factor_from_name = Tr_Reg%Tr(m)%scale + exit + endif + enddo + endif + end function scale_factor_from_name !> Initize parameters and fields related to the specification of tides at open boundaries. @@ -4519,8 +4537,9 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & segment%tr_Reg%Tr(ntseg)%scale = scale do m=1,segment%num_fields ! Store the scaling factor for fields with exactly matching names, and possibly - ! rescale the previously stonred input values. - if (trim(segment%field(m)%name) == trim(segment%tr_Reg%Tr(ntseg)%name)) then + ! rescale the previously stored input values. Note that calls to register_segment_tracer + ! can come before or after calls to initialize_segment_data. + if (uppercase(segment%field(m)%name) == uppercase(segment%tr_Reg%Tr(ntseg)%name)) then if (segment%field(m)%fid == -1) then rescale = scale if ((segment%field(m)%scale /= 0.0) .and. (segment%field(m)%scale /= 1.0)) & @@ -5005,6 +5024,7 @@ subroutine open_boundary_register_restarts(HI, GV, US, OBC, Reg, param_file, res endif enddo endif + end subroutine open_boundary_register_restarts !> Update the OBC tracer reservoirs after the tracers have been updated. @@ -5022,8 +5042,10 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry type(OBC_segment_type), pointer :: segment=>NULL() - real :: u_L_in, u_L_out ! The zonal distance moved in or out of a cell [L ~> m] - real :: v_L_in, v_L_out ! The meridional distance moved in or out of a cell [L ~> m] + real :: u_L_in, u_L_out ! The zonal distance moved in or out of a cell, normalized by the reservoir + ! length scale [nondim] + real :: v_L_in, v_L_out ! The meridional distance moved in or out of a cell, normalized by the reservoir + ! length scale [nondim] 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] @@ -5032,6 +5054,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) nz = GV%ke ntr = Reg%ntr + if (associated(OBC)) then ; if (OBC%OBC_pe) then ; do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. associated(segment%tr_Reg)) cycle From 48875ea0df28541a271051c292266aaa1a1741ca Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 13 Jul 2022 10:55:49 -0800 Subject: [PATCH 59/68] Fix to reading of partial OBCs from file. --- src/core/MOM_open_boundary.F90 | 44 +++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 16 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index c768654cc4..7f170f5510 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -3890,35 +3890,39 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX' .or. & segment%field(m)%name == 'Vamp' .or. segment%field(m)%name == 'Vphase') then segment%field(m)%buffer_src(is_obc,:,:) = & - tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) + tmp_buffer(1,2*(js_obc+G%jdg_offset-segment%HI%Jsgb)+1:2*(je_obc+G%jdg_offset-segment%HI%Jsgb)+1:2,:) else segment%field(m)%buffer_src(is_obc,:,:) = & - tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) + tmp_buffer(1,2*(js_obc+G%jdg_offset-segment%HI%Jsgb)+1:2*(je_obc+G%jdg_offset-segment%HI%Jsgb):2,:) endif else if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY' .or. & segment%field(m)%name == 'Uamp' .or. segment%field(m)%name == 'Uphase') then segment%field(m)%buffer_src(:,js_obc,:) = & - tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) + tmp_buffer(2*(is_obc+G%idg_offset-segment%HI%Isgb)+1:2*(ie_obc+G%idg_offset-segment%HI%Isgb)+1:2,1,:) else segment%field(m)%buffer_src(:,js_obc,:) = & - tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) + tmp_buffer(2*(is_obc+G%idg_offset-segment%HI%Isgb)+1:2*(ie_obc+G%idg_offset-segment%HI%Isgb):2,1,:) endif endif else if (segment%is_E_or_W) then if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX' .or. & segment%field(m)%name == 'Vamp' .or. segment%field(m)%name == 'Vphase') then - segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset+1,:) + segment%field(m)%buffer_src(is_obc,:,:) = & + tmp_buffer(1,js_obc+G%jdg_offset-segment%HI%Jsgb+1:je_obc+G%jdg_offset-segment%HI%Jsgb+1,:) else - segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset,:) + segment%field(m)%buffer_src(is_obc,:,:) = & + tmp_buffer(1,js_obc+G%jdg_offset-segment%HI%Jsgb+1:je_obc+G%jdg_offset-segment%HI%Jsgb,:) endif else if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY' .or. & segment%field(m)%name == 'Uamp' .or. segment%field(m)%name == 'Uphase') then - segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset+1,1,:) + segment%field(m)%buffer_src(:,js_obc,:) = & + tmp_buffer(is_obc+G%idg_offset-segment%HI%Isgb+1:ie_obc+G%idg_offset-segment%HI%Isgb+1,1,:) else - segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset,1,:) + segment%field(m)%buffer_src(:,js_obc,:) = & + tmp_buffer(is_obc+G%idg_offset-segment%HI%Isgb+1:ie_obc+G%idg_offset-segment%HI%Isgb,1,:) endif endif endif @@ -3945,32 +3949,40 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (segment%is_E_or_W) then if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then segment%field(m)%dz_src(is_obc,:,:) = & - tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) + tmp_buffer(1,2*(js_obc+G%jdg_offset-segment%HI%Jsgb)+1:2*(je_obc+G%jdg_offset- & + segment%HI%Jsgb)+1:2,:) else segment%field(m)%dz_src(is_obc,:,:) = & - tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) + tmp_buffer(1,2*(js_obc+G%jdg_offset-segment%HI%Jsgb)+1:2*(je_obc+G%jdg_offset- & + segment%HI%Jsgb):2,:) endif else if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then segment%field(m)%dz_src(:,js_obc,:) = & - tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) + tmp_buffer(2*(is_obc+G%idg_offset-segment%HI%Isgb)+1:2*(ie_obc+G%idg_offset- & + segment%HI%Isgb)+1:2,1,:) else segment%field(m)%dz_src(:,js_obc,:) = & - tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) + tmp_buffer(2*(is_obc+G%idg_offset-segment%HI%Isgb)+1:2*(ie_obc+G%idg_offset- & + segment%HI%Isgb):2,1,:) endif endif else if (segment%is_E_or_W) then if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then - segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset+1,:) + segment%field(m)%dz_src(is_obc,:,:) = & + tmp_buffer(1,js_obc+G%jdg_offset-segment%HI%Jsgb+1:je_obc+G%jdg_offset-segment%HI%Jsgb+1,:) else - segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset,:) + segment%field(m)%dz_src(is_obc,:,:) = & + tmp_buffer(1,js_obc+G%jdg_offset-segment%HI%Jsgb+1:je_obc+G%jdg_offset-segment%HI%Jsgb,:) endif else if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then - segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset+1,1,:) + segment%field(m)%dz_src(:,js_obc,:) = & + tmp_buffer(is_obc+G%idg_offset-segment%HI%Isgb+1:ie_obc+G%idg_offset-segment%HI%Isgb+1,1,:) else - segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset,1,:) + segment%field(m)%dz_src(:,js_obc,:) = & + tmp_buffer(is_obc+G%idg_offset-segment%HI%Isgb+1:ie_obc+G%idg_offset-segment%HI%Isgb,1,:) endif endif endif From 4f039a8805e5c1ee165def87dc465ea8b389952b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 14 Jul 2022 13:29:10 -0400 Subject: [PATCH 60/68] +Fix diagnostic conversions in code from dev/ncar Added missing unit conversion factors in two calls to register_diag_field and modified the comments describing the units of some temperature and salinity variables in code that was recently added to the recently main branch of MOM6 via dev/ncar, reflecting the rescaling of temperatures and salinities that is now in the dev/gfdl branch. Without this change, these diagnostics will fail the dimensional consistency testing for temperature and salinity. All answers are bitwise identical, but there is a case change of the units of a variable in the available_diags files. --- src/core/MOM_isopycnal_slopes.F90 | 8 ++++---- src/core/MOM_stoch_eos.F90 | 18 +++++++++--------- src/diagnostics/MOM_diagnostics.F90 | 8 ++++---- 3 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 406c9cfec0..b5bd51d75a 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -90,11 +90,11 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan S_v, & ! Salinity on the interface at the v-point [S ~> ppt]. pres_v ! Pressure on the interface at the v-point [R L2 T-2 ~> Pa]. real, dimension(SZI_(G)) :: & - T_h, & ! Temperature on the interface at the h-point [degC]. - S_h, & ! Salinity on the interface at the h-point [ppt] + T_h, & ! Temperature on the interface at the h-point [C ~> degC]. + S_h, & ! Salinity on the interface at the h-point [S ~> ppt] pres_h, & ! Pressure on the interface at the h-point [R L2 T-2 ~> Pa]. - T_hr, & ! Temperature on the interface at the h (+1) point [degC]. - S_hr, & ! Salinity on the interface at the h (+1) point [ppt] + T_hr, & ! Temperature on the interface at the h (+1) point [C ~> degC]. + S_hr, & ! Salinity on the interface at the h (+1) point [S ~> ppt] pres_hr ! Pressure on the interface at the h (+1) point [R L2 T-2 ~> Pa]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below (B) the diff --git a/src/core/MOM_stoch_eos.F90 b/src/core/MOM_stoch_eos.F90 index bc5e15af4e..2f67077f1e 100644 --- a/src/core/MOM_stoch_eos.F90 +++ b/src/core/MOM_stoch_eos.F90 @@ -53,7 +53,7 @@ module MOM_stoch_eos contains !> Initializes MOM_stoch_eos module. -subroutine MOM_stoch_eos_init(G,Time,param_file,CS,restart_CS,diag) +subroutine MOM_stoch_eos_init(G, Time, param_file, CS, restart_CS, diag) type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(time_type), intent(in) :: Time !< Time for stochastic process @@ -123,7 +123,7 @@ subroutine MOM_stoch_eos_init(G,Time,param_file,CS,restart_CS,diag) end subroutine MOM_stoch_eos_init !> Generates a pattern in space and time for the ocean stochastic equation of state -subroutine MOM_stoch_eos_run(G,u,v,delt,Time,CS,diag) +subroutine MOM_stoch_eos_run(G, u, v, delt, Time, CS, diag) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. @@ -156,7 +156,7 @@ subroutine MOM_stoch_eos_run(G,u,v,delt,Time,CS,diag) end subroutine MOM_stoch_eos_run !> Computes a parameterization of the SGS temperature variance -subroutine MOM_calc_varT(G,GV,h,tv,CS,dt) +subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -167,13 +167,13 @@ subroutine MOM_calc_varT(G,GV,h,tv,CS,dt) ! local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & - T, & !> The temperature (or density) [degC], with the values in + T, & !> The temperature (or density) [C ~> degC], with the values in !! in massless layers filled vertically by diffusion. - S !> The filled salinity [ppt], with the values in + S !> The filled salinity [S ~> ppt], with the values in !! in massless layers filled vertically by diffusion. - integer :: i,j,k + integer :: i, j, k real :: hl(5) !> Copy of local stencil of H [H ~> m] - real :: dTdi2, dTdj2 !> Differences in T variance [degC2] + real :: dTdi2, dTdj2 !> Differences in T variance [C2 ~> degC2] ! This block does a thickness weighted variance calculation and helps control for ! extreme gradients along layers which are vanished against topography. It is @@ -191,11 +191,11 @@ subroutine MOM_calc_varT(G,GV,h,tv,CS,dt) hl(4) = h(i,j-1,k) * G%mask2dCv(i,J-1) hl(5) = h(i,j+1,k) * G%mask2dCv(i,J) - ! SGS variance in i-direction [degC2] + ! SGS variance in i-direction [C2 ~> degC2] dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) & + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) & ) * G%dxT(i,j) * 0.5 )**2 - ! SGS variance in j-direction [degC2] + ! SGS variance in j-direction [C2 ~> degC2] dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) & + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) & ) * G%dyT(i,j) * 0.5 )**2 diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index df733a2ebb..7390db2b92 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1632,11 +1632,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag standard_name='sea_water_salinity_at_sea_floor', & units='psu', conversion=US%S_to_ppt) - CS%id_tosq = register_diag_field('ocean_model', 'tosq', diag%axesTL,& - Time, 'Square of Potential Temperature', 'degc2', & + CS%id_tosq = register_diag_field('ocean_model', 'tosq', diag%axesTL, & + Time, 'Square of Potential Temperature', 'degC2', conversion=US%C_to_degC**2, & standard_name='Potential Temperature Squared') - CS%id_sosq = register_diag_field('ocean_model', 'sosq', diag%axesTL,& - Time, 'Square of Salinity', 'psu2', & + CS%id_sosq = register_diag_field('ocean_model', 'sosq', diag%axesTL, & + Time, 'Square of Salinity', 'psu2', conversion=US%S_to_ppt**2, & standard_name='Salinity Squared') CS%id_temp_layer_ave = register_diag_field('ocean_model', 'temp_layer_ave', & From c2e8465cfab553b48a70d9b768bf67efab9b642b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 13 Jul 2022 14:24:51 -0400 Subject: [PATCH 61/68] *Fix DOME2d_initialize_temperature_salinity bug Removed a line resetting temperatures to 0 for the ZSTAR and SIGMA vertical coordinates in DOME2d_initialize_temperature_salinity, after they had been set to the intended values. github.com/mom-ocean/MOM6/issues/1560 highlights this bug and can be closed after this commit is merged into the main branch of MOM6. This changes the temperature fields (and ocean.stats files) for the flow_downslopes/z and flow_downslopes/sigma test cases, but because temperature does not influence density in these cases, the flows and salinities are unchanged. --- src/user/DOME2d_initialization.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 054a9fe81c..393347d1f2 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -54,13 +54,13 @@ subroutine DOME2d_initialize_topography( D, G, param_file, max_depth ) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & 'Width of shelf, as fraction of domain, in 2d DOME configuration.', & - units='nondim',default=0.1) + units='nondim', default=0.1) call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & 'Width of deep ocean basin, as fraction of domain, in 2d DOME configuration.', & - units='nondim',default=0.3) + units='nondim', default=0.3) call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & 'Depth of shelf, as fraction of basin depth, in 2d DOME configuration.', & - units='nondim',default=0.2) + units='nondim', default=0.2) ! location where downslope starts l1 = dome2d_width_bay @@ -241,7 +241,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & default=0.1, do_not_log=.true.) @@ -331,7 +331,6 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi endif ! Modify temperature when rho coordinates are used - T(G%isc:G%iec,G%jsc:G%jec,1:GV%ke) = 0.0 if (( coordinateMode(verticalCoordinate) == REGRIDDING_RHO ) .or. & ( coordinateMode(verticalCoordinate) == REGRIDDING_LAYER )) then do i = G%isc,G%iec ; do j = G%jsc,G%jec From 05e705da99461633fa349dbdacd53a2fd7e2a911 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 13 Jul 2022 14:29:20 -0400 Subject: [PATCH 62/68] +*Use runtime parameters in DOME initialization Modified the DOME initialization to simplify some expressions and to use run-time parameters, rather than hard-coded values, when initializing the DOME test case. By default, all expressions are mathematically equivalent, but there are roundoff level changes in the topography and sponges due to the use of more generally valid expressions with runtime parameters and the replacement of some divisions for unit conversions by multiplication by a reciprocal. Because the DOME test cases are strongly nonlinear, these small changes cascade up to macroscopic differences, but these are of comparable magnitude to the differences between compilers. There are 10 new runtime parameters that appear in the MOM_parameter_doc.all files for the DOME test cases. --- src/user/DOME_initialization.F90 | 122 +++++++++++++++++++++---------- 1 file changed, 84 insertions(+), 38 deletions(-) diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index ceef4a3a93..e8a6ae713c 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -46,7 +46,13 @@ subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths [Z ~> m]. + real :: min_depth ! The minimum ocean depth [Z ~> m] + real :: shelf_depth ! The ocean depth on the shelf in the DOME configuration [Z ~> m] + real :: slope ! The bottom slope in the DOME configuration [Z L-1 ~> nondim] + real :: shelf_edge_lat ! The latitude of the edge of the topographic shelf [km] + real :: inflow_lon ! The edge longitude of the DOME inflow [km] + real :: inflow_width ! The longitudinal width of the DOME inflow channel [km] + real :: km_to_L ! The conversion factor from the units of latitude to L [L km-1 ~> 1e3] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "DOME_initialize_topography" ! This subroutine's name. @@ -54,22 +60,33 @@ subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + km_to_L = 1.0e3*US%m_to_L + call MOM_mesg(" DOME_initialization.F90, DOME_initialize_topography: setting topography", 5) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) + "The minimum depth of the ocean.", default=0.0, units="m", scale=US%m_to_Z) + call get_param(param_file, mdl, "DOME_TOPOG_SLOPE", slope, & + "The slope of the bottom topography in the DOME configuration.", & + default=0.01, units="nondim", scale=US%L_to_Z) + call get_param(param_file, mdl, "DOME_SHELF_DEPTH", shelf_depth, & + "The bottom depth in the shelf inflow region in the DOME configuration.", & + default=600.0, units="m", scale=US%m_to_Z) + call get_param(param_file, mdl, "DOME_SHELF_EDGE_LAT", shelf_edge_lat, & + "The latitude of the shelf edge in the DOME configuration.", & + default=600.0, units="km") + call get_param(param_file, mdl, "DOME_INFLOW_LON", inflow_lon, & + "The edge longitude of the DOME inflow.", units="km", default=1000.0) + call get_param(param_file, mdl, "DOME_INFLOW_WIDTH", inflow_width, & + "The longitudinal width of the DOME inflow channel.", units="km", default=100.0) do j=js,je ; do i=is,ie - if (G%geoLatT(i,j) < 600.0) then - if (G%geoLatT(i,j) < 300.0) then - D(i,j) = max_depth - else - D(i,j) = max_depth - 10.0*US%m_to_Z * (G%geoLatT(i,j)-300.0) - endif + if (G%geoLatT(i,j) < shelf_edge_lat) then + D(i,j) = min(shelf_depth - slope * (G%geoLatT(i,j)-shelf_edge_lat)*km_to_L, max_depth) else - if ((G%geoLonT(i,j) > 1000.0) .AND. (G%geoLonT(i,j) < 1100.0)) then - D(i,j) = 600.0*US%m_to_Z + if ((G%geoLonT(i,j) > inflow_lon) .AND. (G%geoLonT(i,j) < inflow_lon+inflow_width)) then + D(i,j) = shelf_depth else D(i,j) = 0.5*min_depth endif @@ -158,28 +175,36 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) real :: e_tgt(SZK_(GV)+1) ! Target interface heights [Z ~> m]. real :: min_depth ! The minimum depth at which to apply damping [Z ~> m] - real :: damp_W, damp_E ! Damping rates in the western and eastern sponges [days-1] - real :: peak_damping ! The maximum sponge damping rates as the edges [days-1] - real :: edge_dist ! The distance to an edge, in the same units as longitude [km] - real :: sponge_width ! The width of the sponges, in the same units as longitude [km] + real :: damp_W, damp_E ! Damping rates in the western and eastern sponges [T-1 ~> s-1] + real :: peak_damping ! The maximum sponge damping rates as the edges [T-1 ~> s-1] + real :: km_to_L ! The conversion factor from the units of longitude to L [L km-1 ~> 1e3] + real :: edge_dist ! The distance to an edge [L ~> m] + real :: sponge_width ! The width of the sponges [L ~> m] character(len=40) :: mdl = "DOME_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + km_to_L = 1.0e3*US%m_to_L + ! Set up sponges for the DOME configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) + call get_param(PF, mdl, "DOME_SPONGE_DAMP_RATE", peak_damping, & + "The largest damping rate in the DOME sponges.", & + default=10.0, units="day-1", scale=1.0/(86400.0*US%s_to_T)) + call get_param(PF, mdl, "DOME_SPONGE_WIDTH", sponge_width, & + "The width of the the DOME sponges.", & + default=200.0, units="km", scale=km_to_L) ! Here the inverse damping time [T-1 ~> s-1], is set. Set Idamp to 0 wherever ! there is no sponge, and the subroutines that are called will automatically ! set up the sponges only where Idamp is positive and mask2dT is 1. - peak_damping = 10.0 ! The maximum sponge damping rate in [days-1] - sponge_width = 200.0 ! The width of the sponges [km] + Idamp(:,:) = 0.0 do j=js,je ; do i=is,ie ; if (depth_tot(i,j) > min_depth) then - edge_dist = G%geoLonT(i,j) - G%west_lon + edge_dist = (G%geoLonT(i,j) - G%west_lon) * km_to_L if (edge_dist < 0.5*sponge_width) then damp_W = peak_damping elseif (edge_dist < sponge_width) then @@ -188,7 +213,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) damp_W = 0.0 endif - edge_dist = (G%len_lon + G%west_lon) - G%geoLonT(i,j) + edge_dist = ((G%len_lon + G%west_lon) - G%geoLonT(i,j)) * km_to_L if (edge_dist < 0.5*sponge_width) then damp_E = peak_damping elseif (edge_dist < sponge_width) then @@ -197,7 +222,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) damp_E = 0.0 endif - Idamp(i,j) = max(damp_W, damp_E) / (86400.0 * US%s_to_T) + Idamp(i,j) = max(damp_W, damp_E) endif ; enddo ; enddo e_tgt(1) = 0.0 @@ -234,7 +259,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) end subroutine DOME_initialize_sponges !> Add DOME to the OBC registry and set up some variables that will be used to guide -!! code setting up the restart fieldss related to the OBCs. +!! code setting up the restart fields related to the OBCs. subroutine register_DOME_OBC(param_file, US, OBC, tr_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -259,7 +284,7 @@ end subroutine register_DOME_OBC !> This subroutine sets the properties of flow at open boundary conditions. !! This particular example is for the DOME inflow describe in Legg et al. 2006. -subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) +subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. @@ -270,7 +295,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. @@ -294,12 +319,18 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! v-velocity face, in the same units as G%geoLon [km] real :: D_edge ! The thickness [Z ~> m] of the dense fluid at the ! inner edge of the inflow + real :: RLay_range ! The range of densities [R ~> kg m-3]. + real :: f_0 ! The reference value of the Coriolis parameter [T-1 ~> s-1] + real :: f_inflow ! The value of the Coriolis parameter used to determine DOME inflow + ! properties [T-1 ~> s-1] real :: g_prime_tot ! The reduced gravity across all layers [L2 Z-1 T-2 ~> m s-2] - real :: Def_Rad ! The deformation radius, based on fluid of thickness D_edge, - ! in the same units as G%geoLon [km] + real :: Def_Rad ! The deformation radius, based on fluid of thickness D_edge [L ~> m] + real :: inflow_lon ! The edge longitude of the DOME inflow [km] + real :: I_Def_Rad ! The inverse of the deformation radius in the same units as G%geoLon [km-1] real :: Ri_trans ! The shear Richardson number in the transition ! region of the specified shear profile [nondim] character(len=32) :: name ! The name of a tracer field. + character(len=40) :: mdl = "DOME_set_OBC_data" ! This subroutine's name. integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, nz, ntherm integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() @@ -309,16 +340,31 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - ! The following variables should be transformed into runtime parameters. - D_edge = 300.0*US%m_to_Z ! The thickness of dense fluid in the inflow. - Ri_trans = 1.0/3.0 ! The shear Richardson number in the transition region - ! region of the specified shear profile. + call get_param(PF, mdl, "DOME_INFLOW_THICKNESS", D_edge, & + "The thickness of the dense DOME inflow at the inner edge.", & + default=300.0, units="m", scale=US%m_to_Z) + call get_param(PF, mdl, "DOME_INFLOW_RI_TRANS", Ri_trans, & + "The shear Richardson number in the transition region of the specified "//& + "DOME inflow shear profile.", default=(1.0/3.0), units="nondim") + call get_param(PF, mdl, "DENSITY_RANGE", Rlay_range, & + "The range of reference potential densities in the layers.", & + units="kg m-3", default=2.0, scale=US%kg_m3_to_R) + call get_param(PF, mdl, "F_0", f_0, & + "The reference value of the Coriolis parameter with the betaplane option.", & + units="s-1", default=0.0, scale=US%T_to_s) + call get_param(PF, mdl, "DOME_INFLOW_F", f_inflow, & + "The value of the Coriolis parameter that is used to determine the DOME "//& + "inflow properties.", units="s-1", default=f_0*US%s_to_T, scale=US%T_to_s) + call get_param(PF, mdl, "DOME_INFLOW_LON", inflow_lon, & + "The edge longitude of the DOME inflow.", units="km", default=1000.0) if (.not.associated(OBC)) return - g_prime_tot = (GV%g_Earth / GV%Rho0) * 2.0*US%kg_m3_to_R - Def_Rad = US%L_to_m*sqrt(D_edge*g_prime_tot) / (1.0e-4*US%T_to_s * 1000.0) - tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*US%m_to_L*Def_Rad) * GV%Z_to_H + g_prime_tot = (GV%g_Earth / GV%Rho0) * Rlay_range + Def_Rad = sqrt(D_edge*g_prime_tot) / abs(f_inflow) + tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5*Def_Rad) * GV%Z_to_H + + I_Def_Rad = 1.0 / (1.0e-3*US%L_to_m*Def_Rad) if (OBC%number_of_segments /= 1) then call MOM_error(WARNING, 'Error in DOME OBC segment setup', .true.) @@ -358,9 +404,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! Here lon_im1 estimates G%geoLonBu(I-1,J), which may not have been set if ! the symmetric memory mode is not being used. lon_im1 = 2.0*G%geoLonCv(i,J) - G%geoLonBu(I,J) - segment%normal_trans(i,J,k) = tr_k * (exp(-2.0*(lon_im1 - 1000.0)/Def_Rad) -& - exp(-2.0*(G%geoLonBu(I,J) - 1000.0)/Def_Rad)) - segment%normal_vel(i,J,k) = v_k * exp(-2.0*(G%geoLonCv(i,J) - 1000.0)/Def_Rad) + segment%normal_trans(i,J,k) = tr_k * (exp(-2.0*(lon_im1 - inflow_lon) * I_Def_Rad) - & + exp(-2.0*(G%geoLonBu(I,J) - inflow_lon) * I_Def_Rad)) + segment%normal_vel(i,J,k) = v_k * exp(-2.0*(G%geoLonCv(i,J) - inflow_lon) * I_Def_Rad) enddo ; enddo enddo @@ -370,7 +416,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! In this example, all S inflows have values of 35 psu. name = 'salt' call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_scalar=35.0*US%ppt_to_S, scale=US%ppt_to_S) + call register_segment_tracer(tr_ptr, PF, GV, segment, OBC_scalar=35.0*US%ppt_to_S, scale=US%ppt_to_S) endif if (associated(tv%T)) then ! In this example, the T values are set to be consistent with the layer @@ -395,7 +441,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) enddo ; enddo ; enddo name = 'temp' call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_array=.true., scale=US%degC_to_C) + call register_segment_tracer(tr_ptr, PF, GV, segment, OBC_array=.true., scale=US%degC_to_C) endif ! Set up dye tracers @@ -408,7 +454,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) enddo ; enddo ; enddo name = 'tr_D1' call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, param_file, GV, OBC%segment(1), OBC_array=.true.) + call register_segment_tracer(tr_ptr, PF, GV, OBC%segment(1), OBC_array=.true.) ! All tracers but the first have 0 concentration in their inflows. As 0 is the ! default value for the inflow concentrations, the following calls are unnecessary. @@ -416,7 +462,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) if (m < 10) then ; write(name,'("tr_D",I1.1)') m else ; write(name,'("tr_D",I2.2)') m ; endif call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, param_file, GV, OBC%segment(1), OBC_scalar=0.0) + call register_segment_tracer(tr_ptr, PF, GV, OBC%segment(1), OBC_scalar=0.0) enddo end subroutine DOME_set_OBC_data From 64fe4fc67bf76d7d3599f886c222d0771e3cc7db Mon Sep 17 00:00:00 2001 From: WenhaoChen89 <96131003+WenhaoChen89@users.noreply.github.com> Date: Mon, 18 Jul 2022 14:15:14 -0400 Subject: [PATCH 63/68] Fix to dumbbell initialization in layer mode (#160) * Change dumbbell initialization * Change in Dumbbell Layer Mode --- .../MOM_state_initialization.F90 | 2 +- src/user/dumbbell_initialization.F90 | 69 +++++++++++++++++-- 2 files changed, 65 insertions(+), 6 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0757fd887f..cd6ddbeca7 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -585,7 +585,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, depth_tot, PF, & sponge_CSp, h) - case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, US, tv, depth_tot, PF, useALE, & + case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, US, tv, h, depth_tot, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("phillips"); call Phillips_initialize_sponges(G, GV, US, tv, PF, sponge_CSp, h) case ("dense"); call dense_water_initialize_sponges(G, GV, US, tv, depth_tot, PF, useALE, & diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index c197274067..570e638465 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -16,7 +16,7 @@ module dumbbell_initialization use MOM_verticalGrid, only : verticalGrid_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR -use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA +use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA, REGRIDDING_HYCOM1 use MOM_ALE_sponge, only : ALE_sponge_CS, set_up_ALE_sponge_field, initialize_ALE_sponge implicit none ; private @@ -112,10 +112,14 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, real :: S_range ! The range of salinities in this test case [S ~> ppt] real :: S_light, S_dense ! The lightest and densest salinities in the sponges [S ~> ppt]. real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. + logical :: dbrotate ! If true, rotate the domain. + logical :: use_ALE ! True if ALE is being used, False if in layered mode + ! This include declares and sets the variable "version". # include "version_variable.h" character(len=20) :: verticalCoordinate integer :: i, j, k, is, ie, js, je, nz + real :: x, y is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -128,6 +132,8 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, units='m', default=1.0e-3, scale=US%m_to_Z, do_not_log=just_read) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + call get_param(param_file, mdl, "USE_REGRIDDING", use_ALE, do_not_log = .true.) + if (.not. use_ALE) verticalCoordinate = "LAYER" ! WARNING: this routine specifies the interface heights so that the last layer ! is vanished, even at maximum depth. In order to have a uniform @@ -141,8 +147,36 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, !enddo select case ( coordinateMode(verticalCoordinate) ) + case ( REGRIDDING_LAYER) ! Initial thicknesses for isopycnal coordinates + call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & + 'Logical for rotation of dumbbell domain.',& + units='nondim', default=.false., do_not_log=just_read) + do j=js,je + do i=is,ie + ! Compute normalized zonal coordinates (x,y=0 at center of domain) + if (dbrotate) then + ! This is really y in the rotated case + x = G%geoLatT(i,j) + else + x = G%geoLonT(i,j) + endif + eta1D(1) = 0.0 + eta1D(nz+1) = -depth_tot(i,j) + if (x<0.0) then + do k=nz,2, -1 + eta1D(k) = eta1D(k+1) + min_thickness + enddo + else + do k=2,nz + eta1D(k) = eta1D(k-1) - min_thickness + enddo + endif + do k=1,nz + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) + enddo + enddo; enddo - case ( REGRIDDING_LAYER, REGRIDDING_RHO ) ! Initial thicknesses for isopycnal coordinates + case ( REGRIDDING_RHO, REGRIDDING_HYCOM1) ! Initial thicknesses for isopycnal coordinates call get_param(param_file, mdl, "INITIAL_SSS", S_surf, & units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "INITIAL_S_RANGE", S_range, & @@ -231,12 +265,18 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ real :: x ! The fractional position in the domain [nondim] real :: dblen ! The size of the dumbbell test case [axis_units] logical :: dbrotate ! If true, rotate the domain. + logical :: use_ALE ! If false, use layer mode. character(len=20) :: verticalCoordinate, density_profile is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke T_surf = 20.0*US%degC_to_C + ! layer mode + call get_param(param_file, mdl, "USE_REGRIDDING", use_ALE, do_not_log = .true.) + if (.not. use_ALE) call MOM_error(FATAL, "dumbbell_initialize_temperature_salinity: "//& + "Please use 'fit' for 'TS_CONFIG' in the LAYER mode.") + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "INITIAL_DENSITY_PROFILE", density_profile, & @@ -288,11 +328,12 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ end subroutine dumbbell_initialize_temperature_salinity !> Initialize the restoring sponges for the dumbbell test case -subroutine dumbbell_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_ALE, CSp, ACSp) +subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_file, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< Horizontal grid control structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_in !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure @@ -306,6 +347,7 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h ! sponge thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S ! sponge salinities [S ~> ppt] real, dimension(SZK_(GV)+1) :: eta1D ! interface positions for ALE sponge + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! A temporary array for interface heights [Z ~> m]. integer :: i, j, k, nz real :: x ! The fractional position in the domain [nondim] @@ -404,9 +446,26 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use enddo endif enddo ; enddo - endif - if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) + else + do j=G%jsc,G%jec ; do i=G%isc,G%iec + eta(i,j,1) = 0.0 + do k=2,nz + eta(i,j,k) = eta(i,j,k-1)- GV%H_to_Z * h_in(i,j,k-1) + enddo + eta(i,j,nz+1) = -depth_tot(i,j) + do k=1,nz + S(i,j,k)= tv%S(i,j,k) + enddo + enddo ; enddo + + ! This call sets up the damping rates and interface heights. + ! This sets the inverse damping timescale fields in the sponges. ! + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV) + + ! The remaining calls to set_up_sponge_field can be in any order. ! + if ( associated(tv%S) ) call set_up_sponge_field(S, tv%S, G, GV, nz, CSp) + endif end subroutine dumbbell_initialize_sponges From 2217e6319f9bb39a1c78edc4fab4ad20c5c3c443 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 18 Jul 2022 15:29:38 -0400 Subject: [PATCH 64/68] +Restored public interface to post_data_1d_k Made post_data_1d_k publicly visible once again, rather than requiring calls to use post_data, to support backward compatibility with older versions of the ocean_BGC code. This interface was removed from public visibility as a part of github.com/NOAA-GFDL/MOM6/pull/107, but it caused problems with some of GFDL's Earth System Models, as noted in https://github.com/NOAA-GFDL/MOM6/issues/168. All answers are bitwise identical for any cases that compiled before. --- src/framework/MOM_diag_mediator.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 1f6b4133c0..677c268ab3 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -41,6 +41,9 @@ module MOM_diag_mediator public set_axes_info, post_data, register_diag_field, time_type public post_product_u, post_product_sum_u, post_product_v, post_product_sum_v public set_masks_for_axes +! post_data_1d_k is a deprecated interface that can be replaced by a call to post_data, but +! it is being retained for backward compatibility to older versions of the ocean_BGC code. +public post_data_1d_k public safe_alloc_ptr, safe_alloc_alloc public enable_averaging, enable_averages, disable_averaging, query_averaging_enabled public diag_mediator_init, diag_mediator_end, set_diag_mediator_grid From 58db99ba2947471562261a407df260bbee62656e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 8 Jul 2022 12:03:41 -0400 Subject: [PATCH 65/68] +Overload MOM_tracer_chksum to use tracer registry Overloaded MOM_tracer_chksum and MOM_tracer_chkinv with a simpler interface that takes the tracer registry as an input argument, rather than requiring that its elements be unpacked outside of the call. This was done as an overload to the existing interface to avoid breaking backward compatibility, but it seems likely that in due course the older, more complicated interface can be obsoleted. All answers are bitwise identical, but there are new interfaces to provide tracer debugging capabilities. --- src/tracer/MOM_tracer_registry.F90 | 70 +++++++++++++++++++++++++++--- 1 file changed, 64 insertions(+), 6 deletions(-) diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 2f1ca73252..c3f5f64edf 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -23,6 +23,7 @@ module MOM_tracer_registry use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_tracer_types, only : tracer_type, tracer_registry_type + implicit none ; private #include @@ -35,6 +36,16 @@ module MOM_tracer_registry public tracer_name_lookup public tracer_type, tracer_registry_type +!> Write out checksums for registered tracers +interface MOM_tracer_chksum + module procedure tracer_array_chksum, tracer_Reg_chksum +end interface MOM_tracer_chksum + +!> Calculate and print the global inventories of registered tracers +interface MOM_tracer_chkinv + module procedure tracer_array_chkinv, tracer_Reg_chkinv +end interface MOM_tracer_chkinv + contains !> This subroutine registers a tracer to be advected and laterally diffused. @@ -746,8 +757,8 @@ subroutine post_tracer_transport_diagnostics(G, GV, Reg, h_diag, diag) end subroutine post_tracer_transport_diagnostics -!> This subroutine writes out chksums for tracers. -subroutine MOM_tracer_chksum(mesg, Tr, ntr, G) +!> This subroutine writes out chksums for the first ntr registered tracers. +subroutine tracer_array_chksum(mesg, Tr, ntr, G) character(len=*), intent(in) :: mesg !< message that appears on the chksum lines type(tracer_type), intent(in) :: Tr(:) !< array of all of registered tracers integer, intent(in) :: ntr !< number of registered tracers @@ -759,10 +770,26 @@ subroutine MOM_tracer_chksum(mesg, Tr, ntr, G) call hchksum(Tr(m)%t, mesg//trim(Tr(m)%name), G%HI, scale=Tr(m)%conc_scale) enddo -end subroutine MOM_tracer_chksum +end subroutine tracer_array_chksum -!> Calculates and prints the global inventory of all tracers in the registry. -subroutine MOM_tracer_chkinv(mesg, G, GV, h, Tr, ntr) +!> This subroutine writes out chksums for all the registered tracers. +subroutine tracer_Reg_chksum(mesg, Reg, G) + character(len=*), intent(in) :: mesg !< message that appears on the chksum lines + type(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + + integer :: m + + if (.not.associated(Reg)) return + + do m=1,Reg%ntr + call hchksum(Reg%Tr(m)%t, mesg//trim(Reg%Tr(m)%name), G%HI, scale=Reg%Tr(m)%conc_scale) + enddo + +end subroutine tracer_Reg_chksum + +!> Calculates and prints the global inventory of the first ntr tracers in the registry. +subroutine tracer_array_chkinv(mesg, G, GV, h, Tr, ntr) character(len=*), intent(in) :: mesg !< message that appears on the chksum lines type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -787,7 +814,38 @@ subroutine MOM_tracer_chkinv(mesg, G, GV, h, Tr, ntr) if (is_root_pe()) write(0,'(A,1X,A5,1X,ES25.16,1X,A)') "h-point: inventory", Tr(m)%name, total_inv, mesg enddo -end subroutine MOM_tracer_chkinv +end subroutine tracer_array_chkinv + + +!> Calculates and prints the global inventory of all tracers in the registry. +subroutine tracer_Reg_chkinv(mesg, G, GV, h, Reg) + character(len=*), intent(in) :: mesg !< message that appears on the chksum lines + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + + ! Local variables + real :: vol_scale ! The dimensional scaling factor to convert volumes to m3 [m3 H-1 L-2 ~> 1 or m3 kg-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tr_inv ! Volumetric tracer inventory in each cell [conc m3] + real :: total_inv ! The total amount of tracer [conc m3] + integer :: is, ie, js, je, nz + integer :: i, j, k, m + + if (.not.associated(Reg)) return + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + vol_scale = GV%H_to_m*G%US%L_to_m**2 + do m=1,Reg%ntr + do k=1,nz ; do j=js,je ; do i=is,ie + tr_inv(i,j,k) = Reg%Tr(m)%conc_scale*Reg%Tr(m)%t(i,j,k) * (vol_scale * h(i,j,k) * G%areaT(i,j)*G%mask2dT(i,j)) + enddo ; enddo ; enddo + total_inv = reproducing_sum(tr_inv, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) + if (is_root_pe()) write(0,'(A,1X,A5,1X,ES25.16,1X,A)') "h-point: inventory", Reg%Tr(m)%name, total_inv, mesg + enddo + +end subroutine tracer_Reg_chkinv + !> Find a tracer in the tracer registry by name. subroutine tracer_name_lookup(Reg, tr_ptr, name) From c8a62692c59547b84a094aaa5d4724456c159a20 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 8 Jul 2022 12:05:11 -0400 Subject: [PATCH 66/68] Added tracer debugging checksum calls Added calls to write tracer checksums from step_MOM_tracer_dyn when DEBUG=True. Also updated a number of MOM_tracer_chksum and MOM_tracer_chkinv calls in MOM_offline_main and MOM_tracer_hor_diff to use the new and streamlined form of the interfaces. All answers are bitwise identical, but there are additional output lines when debugging is enabled. --- src/core/MOM.F90 | 5 ++++- src/tracer/MOM_offline_main.F90 | 32 +++++++++++++++--------------- src/tracer/MOM_tracer_hor_diff.F90 | 6 +++--- 3 files changed, 23 insertions(+), 20 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 8c39faf198..0e87a1fb3e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -122,7 +122,7 @@ module MOM use MOM_tracer_hor_diff, only : tracer_hor_diff_end, tracer_hor_diff_CS use MOM_tracer_registry, only : tracer_registry_type, register_tracer, tracer_registry_init use MOM_tracer_registry, only : register_tracer_diagnostics, post_tracer_diagnostics_at_sync -use MOM_tracer_registry, only : post_tracer_transport_diagnostics +use MOM_tracer_registry, only : post_tracer_transport_diagnostics, MOM_tracer_chksum use MOM_tracer_registry, only : preALE_tracer_diagnostics, postALE_tracer_diagnostics use MOM_tracer_registry, only : lock_tracer_registry, tracer_registry_end use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_CS @@ -1288,10 +1288,13 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) else x_first = (MODULO(G%first_direction,2) == 0) endif + if (CS%debug) call MOM_tracer_chksum("Pre-advect ", CS%tracer_Reg, G) call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_first) + if (CS%debug) call MOM_tracer_chksum("Post-advect ", CS%tracer_Reg, G) call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) + if (CS%debug) call MOM_tracer_chksum("Post-diffuse ", CS%tracer_Reg, G) if (showCallTree) call callTree_waypoint("finished tracer advection/diffusion (step_MOM)") call update_segment_tracer_reservoirs(G, GV, CS%uhtr, CS%vhtr, h, CS%OBC, & CS%t_dyn_rel_adv, CS%tracer_Reg) diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index cd1572a05f..31b7b29445 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -323,7 +323,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C call hchksum(h_vol, "h_vol before advect", G%HI, scale=HL2_to_kg_scale) call uvchksum("[uv]htr_sub before advect", uhtr_sub, vhtr_sub, G%HI, scale=HL2_to_kg_scale) write(debug_msg, '(A,I4.4)') 'Before advect ', iter - call MOM_tracer_chkinv(debug_msg, G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv(debug_msg, G, GV, h_pre, CS%tracer_reg) endif call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, US, & @@ -344,7 +344,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C if (CS%debug) then call hchksum(h_new,"h_new before ALE", G%HI, scale=GV%H_to_m) write(debug_msg, '(A,I4.4)') 'Before ALE ', iter - call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg) endif call cpu_clock_begin(id_clock_ALE) call ALE_main_offline(G, GV, h_new, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%OBC, CS%dt_offline) @@ -353,7 +353,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C if (CS%debug) then call hchksum(h_new, "h_new after ALE", G%HI, scale=GV%H_to_m) write(debug_msg, '(A,I4.4)') 'After ALE ', iter - call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg) endif endif @@ -395,7 +395,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C if (CS%debug) then call hchksum(h_pre, "h after offline_advection_ale", G%HI, scale=GV%H_to_m) call uvchksum("[uv]htr after offline_advection_ale", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) - call MOM_tracer_chkinv("After offline_advection_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("After offline_advection_ale", G, GV, h_pre, CS%tracer_reg) endif call cpu_clock_end(CS%id_clock_offline_adv) @@ -459,7 +459,7 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve if (converged) return if (CS%debug) then - call MOM_tracer_chkinv("Before redistribute ", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("Before redistribute ", G, GV, h_pre, CS%tracer_reg) endif call cpu_clock_begin(CS%id_clock_redistribute) @@ -478,7 +478,7 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve call pass_vector(uhtr, vhtr, G%Domain) if (CS%debug) then - call MOM_tracer_chksum("Before upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) + call MOM_tracer_chksum("Before upwards redistribute ", CS%tracer_Reg, G) call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) endif @@ -495,7 +495,7 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve max_iter_in=1, update_vol_prev=.true., uhr_out=uhr, vhr_out=vhr) if (CS%debug) then - call MOM_tracer_chksum("After upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) + call MOM_tracer_chksum("After upwards redistribute ", CS%tracer_Reg, G) endif ! Convert h_new back to layer thickness for ALE remapping @@ -519,7 +519,7 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve call pass_vector(uhtr, vhtr, G%Domain) if (CS%debug) then - call MOM_tracer_chksum("Before barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) + call MOM_tracer_chksum("Before barotropic redistribute ", CS%tracer_Reg, G) call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) endif @@ -536,7 +536,7 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve max_iter_in=1, update_vol_prev=.true., uhr_out=uhr, vhr_out=vhr) if (CS%debug) then - call MOM_tracer_chksum("After barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) + call MOM_tracer_chksum("After barotropic redistribute ", CS%tracer_Reg, G) endif ! Convert h_new back to layer thickness for ALE remapping @@ -582,7 +582,7 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve if (CS%debug) then call hchksum(h_pre, "h_pre after redistribute", G%HI, scale=GV%H_to_m) call uvchksum("uhtr after redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) - call MOM_tracer_chkinv("after redistribute ", G, GV, h_new, CS%tracer_Reg%Tr, CS%tracer_Reg%ntr) + call MOM_tracer_chkinv("after redistribute ", G, GV, h_new, CS%tracer_Reg) endif call cpu_clock_end(CS%id_clock_redistribute) @@ -663,7 +663,7 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_p call hchksum(h_pre, "h_pre before offline_diabatic_ale", G%HI, scale=GV%H_to_m) call hchksum(eatr, "eatr before offline_diabatic_ale", G%HI, scale=GV%H_to_m) call hchksum(ebtr, "ebtr before offline_diabatic_ale", G%HI, scale=GV%H_to_m) - call MOM_tracer_chkinv("Before offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("Before offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg) endif eatr(:,:,:) = 0. @@ -727,7 +727,7 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_p call hchksum(h_pre, "h_pre after offline_diabatic_ale", G%HI, scale=GV%H_to_m) call hchksum(eatr, "eatr after offline_diabatic_ale", G%HI, scale=GV%H_to_m) call hchksum(ebtr, "ebtr after offline_diabatic_ale", G%HI, scale=GV%H_to_m) - call MOM_tracer_chkinv("After offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("After offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg) endif call cpu_clock_end(CS%id_clock_offline_diabatic) @@ -767,7 +767,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) if (CS%debug) then call hchksum(h, "h before fluxes into ocean", G%HI, scale=GV%H_to_m) - call MOM_tracer_chkinv("Before fluxes into ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("Before fluxes into ocean", G, GV, h, CS%tracer_reg) endif do m = 1,CS%tracer_reg%ntr ! Layer thicknesses should only be updated after the last tracer is finished @@ -777,7 +777,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) enddo if (CS%debug) then call hchksum(h, "h after fluxes into ocean", G%HI, scale=GV%H_to_m) - call MOM_tracer_chkinv("After fluxes into ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("After fluxes into ocean", G, GV, h, CS%tracer_reg) endif ! Now that fluxes into the ocean are done, save the negative fluxes for later @@ -805,7 +805,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) if (CS%debug) then call hchksum(h, "h before fluxes out of ocean", G%HI, scale=GV%H_to_m) - call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg) endif do m = 1, CS%tracer_reg%ntr ! Layer thicknesses should only be updated after the last tracer is finished @@ -815,7 +815,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) enddo if (CS%debug) then call hchksum(h, "h after fluxes out of ocean", G%HI, scale=GV%H_to_m) - call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg) endif end subroutine offline_fw_fluxes_out_ocean diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 7f8361620d..1e0c80079c 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -195,7 +195,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online endif ; endif CS%first_call = .false. - if (CS%debug) call MOM_tracer_chksum("Before tracer diffusion ", Reg%Tr, ntr, G) + if (CS%debug) call MOM_tracer_chksum("Before tracer diffusion ", Reg, G) use_VarMix = .false. ; Resoln_scaled = .false. ; use_Eady = .false. if (VarMix%use_variable_mixing) then @@ -528,7 +528,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (CS%Diffuse_ML_interior) then if (CS%show_call_tree) call callTree_waypoint("Calling epipycnal_ML_diff (tracer_hordiff)") - if (CS%debug) call MOM_tracer_chksum("Before epipycnal diff ", Reg%Tr, ntr, G) + if (CS%debug) call MOM_tracer_chksum("Before epipycnal diff ", Reg, G) call cpu_clock_begin(id_clock_epimix) call tracer_epipycnal_ML_diff(h, dt, Reg%Tr, ntr, khdt_x, khdt_y, G, GV, US, & @@ -536,7 +536,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online call cpu_clock_end(id_clock_epimix) endif - if (CS%debug) call MOM_tracer_chksum("After tracer diffusion ", Reg%Tr, ntr, G) + if (CS%debug) call MOM_tracer_chksum("After tracer diffusion ", Reg, G) ! post diagnostics for 2d tracer diffusivity if (CS%id_KhTr_u > 0) then From 8ddd0c1a2676146488f571cc14b61c6c04ef4346 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 8 Jul 2022 12:05:50 -0400 Subject: [PATCH 67/68] (*)Corrected OBC allocated tests in advect_y Corrected two allocated tests for OBC-related arrays in advect_y, bringing them into conformity with what was already being done in advect_x. Given the nature of these changes, it seems likely that any case that would have worked before will give bitwise identical answers, but that segmentation faults might now be avoided in certain configurations using OBCs. --- src/tracer/MOM_tracer_advect.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 95bef29d68..6d238a8e86 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -967,7 +967,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (vhr(i,J,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_N)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr - if (allocated(segment%tr_Reg%Tr(m)%t)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%tres(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo @@ -990,7 +990,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr - if (allocated(segment%tr_Reg%Tr(m)%t)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo From c6197818475161e922976fa0769abc4ee6a989d4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 22 Jul 2022 12:47:37 -0400 Subject: [PATCH 68/68] (*)Fix set_up_ALE_sponge_field call T & S scaling Corrected the dimensional rescaling factors in two calls to set_up_ALE_sponge_field for temperature and salinity for time-varying fields being read in from an input file. These had been given the inverse of the correct values. An optional scale argument was also added (with its default value) in the call to set up ALE sponge velocities, for greater clarity of what this call is doing. This commit should address an issue noted by Kate Hedstrom when evaluating the first draft of PR #1577 from dev/gfdl to main. All answers are bitwise identical in cases where dimensional rescaling of temperature and salinity are not being applied, and answers with the rescaling of temperature and salinity should now reproduce those without the rescaling. --- src/initialization/MOM_state_initialization.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index cd6ddbeca7..257d25dad0 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -2138,15 +2138,16 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t endif ! The remaining calls to set_up_sponge_field can be in any order. if ( use_temperature) then - call set_up_ALE_sponge_field(filename, potemp_var, Time, G, GV, US, tv%T, ALE_CSp, scale=US%C_to_degC) - call set_up_ALE_sponge_field(filename, salin_var, Time, G, GV, US, tv%S, ALE_CSp, scale=US%S_to_ppt) + call set_up_ALE_sponge_field(filename, potemp_var, Time, G, GV, US, tv%T, ALE_CSp, scale=US%degC_to_C) + call set_up_ALE_sponge_field(filename, salin_var, Time, G, GV, US, tv%S, ALE_CSp, scale=US%ppt_to_S) endif if (sponge_uv) then filename = trim(inputdir)//trim(state_uv_file) call log_param(param_file, mdl, "INPUTDIR/SPONGE_STATE_UV_FILE", filename) if (.not.file_exists(filename, G%Domain)) & call MOM_error(FATAL, " initialize_sponges: Unable to open "//trim(filename)) - call set_up_ALE_sponge_vel_field(filename, u_var, filename, v_var, Time, G, GV, US, ALE_CSp, u, v) + call set_up_ALE_sponge_vel_field(filename, u_var, filename, v_var, Time, G, GV, US, & + ALE_CSp, u, v, scale=US%m_s_to_L_T) endif endif endif