diff --git a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 index 860ba90487..8d04caebeb 100644 --- a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 @@ -71,8 +71,8 @@ module MOM_surface_forcing_gfdl real :: latent_heat_fusion !< Latent heat of fusion [J kg-1] real :: latent_heat_vapor !< Latent heat of vaporization [J kg-1] - real :: max_p_surf !< The maximum surface pressure that can be - !! exerted by the atmosphere and floating sea-ice [Pa]. + real :: max_p_surf !< The maximum surface pressure that can be exerted by + !! the atmosphere and floating sea-ice [R L2 T-2 ~> Pa]. !! This is needed because the FMS coupling structure !! does not limit the water that can be frozen out !! of the ocean and the ice-ocean heat fluxes are @@ -548,14 +548,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) enddo ; enddo else do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) @@ -673,7 +673,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ net_mass_src, & ! A temporary of net mass sources [kg m-2 s-1]. ustar_tmp ! A temporary array of ustar values [Z T-1 ~> m s-1]. - real :: I_GEarth ! 1.0 / G_Earth [s2 m-1] + real :: I_GEarth ! Pressure conversion factors times 1.0 / G_Earth [kg m-2 T2 R-1 L-2 ~> s2 m-1] real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1] real :: mass_ice ! mass of sea ice at a face [kg m-2] real :: mass_eff ! effective mass of sea ice for rigidity [kg m-2] @@ -751,12 +751,12 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then do j=js,je ; do i=is,ie - forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + forces%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) enddo ; enddo else do j=js,je ; do i=is,ie - forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + forces%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) forces%p_surf(i,j) = forces%p_surf_full(i,j) enddo ; enddo endif @@ -837,7 +837,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / CS%G_Earth + I_GEarth = US%RL2_T2_to_Pa / CS%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1299,8 +1299,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "needed because the FMS coupling structure does not "//& "limit the water that can be frozen out of the ocean and "//& "the ice-ocean heat fluxes are treated explicitly. No "//& - "limit is applied if a negative value is used.", units="Pa", & - default=-1.0) + "limit is applied if a negative value is used.", & + units="Pa", default=-1.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) call get_param(param_file, mdl, "RESTORE_SALINITY", CS%restore_salt, & "If true, the coupled driver will add a globally-balanced "//& "fresh-water flux that drives sea-surface salinity "//& diff --git a/config_src/mct_driver/mom_surface_forcing_mct.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 index 38bd54acf1..12fe940ead 100644 --- a/config_src/mct_driver/mom_surface_forcing_mct.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -68,9 +68,9 @@ module MOM_surface_forcing_mct real :: latent_heat_fusion !< latent heat of fusion [J kg-1] real :: latent_heat_vapor !< latent heat of vaporization [J kg-1] - real :: max_p_surf !< maximum surface pressure that can be - !! exerted by the atmosphere and floating sea-ice, - !! [Pa]. This is needed because the FMS coupling + real :: max_p_surf !< The maximum surface pressure that can be exerted by + !! the atmosphere and floating sea-ice [R L2 T-2 ~> Pa]. + !! This is needed because the FMS coupling !! structure does not limit the water that can be !! frozen out of the ocean and the ice-ocean heat !! fluxes are treated explicitly. @@ -527,12 +527,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) enddo; enddo else do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) enddo; enddo endif @@ -621,7 +621,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) real :: tau_mag !< magnitude of the wind stress [R Z L T-2 ~> Pa] real :: Pa_conversion ! A unit conversion factor from Pa to the internal wind stress units [R Z L T-2 Pa-1 ~> 1] real :: stress_conversion ! A unit conversion factor from Pa times any stress multiplier [R Z L T-2 Pa-1 ~> 1] - real :: I_GEarth !< 1.0 / G%G_Earth [s2 m-1] + real :: I_GEarth !< Pressure conversion factors times 1.0 / G_Earth [kg m-2 T2 R-1 L-2 ~> s2 m-1] real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1] real :: mass_ice !< mass of sea ice at a face [kg m-2] real :: mass_eff !< effective mass of sea ice for rigidity [kg m-2] @@ -686,12 +686,12 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then do j=js,je ; do i=is,ie - forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + forces%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) enddo ; enddo else do j=js,je ; do i=is,ie - forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + forces%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) forces%p_surf(i,j) = forces%p_surf_full(i,j) enddo ; enddo endif @@ -845,7 +845,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / CS%G_Earth + I_GEarth = US%RL2_T2_to_Pa / CS%g_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1077,8 +1077,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "needed because the FMS coupling structure does not "//& "limit the water that can be frozen out of the ocean and "//& "the ice-ocean heat fluxes are treated explicitly. No "//& - "limit is applied if a negative value is used.", units="Pa", & - default=-1.0) + "limit is applied if a negative value is used.", & + units="Pa", default=-1.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & "If true, adjusts the salinity restoring seen to zero "//& diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index dea2ce1284..fce7bda421 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -69,9 +69,9 @@ module MOM_surface_forcing_nuopc real :: latent_heat_fusion !< latent heat of fusion [J/kg] real :: latent_heat_vapor !< latent heat of vaporization [J/kg] - real :: max_p_surf !< maximum surface pressure that can be - !! exerted by the atmosphere and floating sea-ice, - !! in Pa. This is needed because the FMS coupling + real :: max_p_surf !< maximum surface pressure that can be exerted by the + !! atmosphere and floating sea-ice [R L2 T-2 ~> Pa]. + !! This is needed because the FMS coupling !! structure does not limit the water that can be !! frozen out of the ocean and the ice-ocean heat !! fluxes are treated explicitly. @@ -524,12 +524,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) enddo; enddo else do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) enddo; enddo endif @@ -618,7 +618,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) real :: tau_mag !< magnitude of the wind stress [R Z L T-2 ~> Pa] real :: Pa_conversion ! A unit conversion factor from Pa to the internal wind stress units [R Z L T-2 Pa-1 ~> 1] real :: stress_conversion ! A unit conversion factor from Pa times any stress multiplier [R Z L T-2 Pa-1 ~> 1] - real :: I_GEarth !< 1.0 / G_Earth [s2 m-1] + real :: I_GEarth !< Pressure conversion factors times 1.0 / G_Earth [kg m-2 T2 R-1 L-2 ~> s2 m-1] real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice !< mass of sea ice at a face (kg/m^2) real :: mass_eff !< effective mass of sea ice for rigidity (kg/m^2) @@ -682,12 +682,12 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then do j=js,je ; do i=is,ie - forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + forces%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) enddo ; enddo else do j=js,je ; do i=is,ie - forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + forces%p_surf_full(i,j) = G%mask2dT(i,j) * US%kg_m3_to_R*US%m_s_to_L_T**2*IOB%p(i-i0,j-j0) forces%p_surf(i,j) = forces%p_surf_full(i,j) enddo ; enddo endif @@ -845,7 +845,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / CS%g_Earth + I_GEarth = US%RL2_T2_to_Pa / CS%g_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1076,8 +1076,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "needed because the FMS coupling structure does not "//& "limit the water that can be frozen out of the ocean and "//& "the ice-ocean heat fluxes are treated explicitly. No "//& - "limit is applied if a negative value is used.", units="Pa", & - default=-1.0) + "limit is applied if a negative value is used.", & + units="Pa", default=-1.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & "If true, adjusts the salinity restoring seen to zero "//& diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index bc290b3f94..9bc71dd15f 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -84,7 +84,7 @@ module MOM_regridding !> Minimum thickness allowed when building the new grid through regridding [H ~> m or kg m-2]. real :: min_thickness - !> Reference pressure for potential density calculations [Pa] + !> Reference pressure for potential density calculations [R L2 T-2 ~> Pa] real :: ref_pressure = 2.e7 !> Weight given to old coordinate when blending between new and old grids [nondim] @@ -199,7 +199,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m logical :: tmpLogical, fix_haloclines, set_max, do_sum, main_parameters logical :: coord_is_state_dependent, ierr logical :: default_2018_answers, remap_answers_2018 - real :: filt_len, strat_tol, index_scale, tmpReal + real :: filt_len, strat_tol, index_scale, tmpReal, P_Ref real :: maximum_depth ! The maximum depth of the ocean [m] (not in Z). real :: dz_fixed_sfc, Rho_avg_depth, nlay_sfc_int real :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha @@ -513,11 +513,16 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m call initCoord(CS, GV, US, coord_mode) if (main_parameters .and. coord_is_state_dependent) then + call get_param(param_file, mdl, "P_REF", P_Ref, & + "The pressure that is used for calculating the coordinate "//& + "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& + "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", & + units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & "When interpolating potential density profiles we can add "//& "some artificial compressibility solely to make homogeneous "//& "regions appear stratified.", units="nondim", default=0.) - call set_regrid_params(CS, compress_fraction=tmpReal) + call set_regrid_params(CS, compress_fraction=tmpReal, ref_pressure=P_Ref) endif if (main_parameters) then @@ -594,7 +599,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m call set_regrid_params(CS, adaptTimeRatio=adaptTimeRatio, adaptZoom=adaptZoom, & adaptZoomCoeff=adaptZoomCoeff, adaptBuoyCoeff=adaptBuoyCoeff, adaptAlpha=adaptAlpha, & - adaptDoMin=tmpLogical, adaptDrho0=US%R_to_kg_m3*adaptDrho0) + adaptDoMin=tmpLogical, adaptDrho0=adaptDrho0) endif if (main_parameters .and. coord_is_state_dependent) then @@ -865,7 +870,7 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_ case ( REGRIDDING_RHO ) if (do_convective_adjustment) call convective_adjustment(G, GV, h, tv) - call build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) + call build_rho_grid( G, GV, G%US, h, tv, dzInterface, remapCS, CS ) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) case ( REGRIDDING_ARBITRARY ) @@ -873,14 +878,14 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_ call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) case ( REGRIDDING_HYCOM1 ) - call build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) + call build_grid_HyCOM1( G, GV, G%US, h, tv, h_new, dzInterface, CS ) case ( REGRIDDING_SLIGHT ) - call build_grid_SLight( G, GV, h, tv, dzInterface, CS ) + call build_grid_SLight( G, GV, G%US, h, tv, dzInterface, CS ) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) case ( REGRIDDING_ADAPTIVE ) - call build_grid_adaptive(G, GV, h, tv, dzInterface, remapCS, CS) + call build_grid_adaptive(G, GV, G%US, h, tv, dzInterface, remapCS, CS) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) case default @@ -1317,7 +1322,7 @@ end subroutine build_sigma_grid ! Build grid based on target interface densities !------------------------------------------------------------------------------ !> This routine builds a new grid based on a given set of target interface densities. -subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) +subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS ) !------------------------------------------------------------------------------ ! This routine builds a new grid based on a given set of target interface ! densities (these target densities are computed by taking the mean value @@ -1336,6 +1341,7 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) ! Arguments type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth @@ -1449,9 +1455,10 @@ end subroutine build_rho_grid !! \remark { Based on Bleck, 2002: An oceanice general circulation model framed in !! hybrid isopycnic-Cartesian coordinates, Ocean Modelling 37, 55-88. !! http://dx.doi.org/10.1016/S1463-5003(01)00012-9 } -subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) +subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure type(regridding_CS), intent(in) :: CS !< Regridding control structure @@ -1462,7 +1469,8 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2] real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface [H ~> m or kg m-2] real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [Pa] + real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [R L2 T-2 ~> Pa] + real :: ref_pres ! The reference pressure [R L2 T-2 ~> Pa] integer :: i, j, k, nki real :: depth real :: h_neglect, h_neglect_edge @@ -1489,12 +1497,12 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) z_col(1) = 0. ! Work downward rather than bottom up do K = 1, GV%ke z_col(K+1) = z_col(K) + h(i,j,k) - p_col(k) = CS%ref_pressure + CS%compressibility_fraction * & - ( 0.5 * ( z_col(K) + z_col(K+1) ) * GV%H_to_Pa - CS%ref_pressure ) + p_col(k) = tv%P_Ref + CS%compressibility_fraction * & + ( 0.5 * ( z_col(K) + z_col(K+1) ) * (GV%H_to_RZ*GV%g_Earth) - tv%P_Ref ) enddo call build_hycom1_column(CS%hycom_CS, tv%eqn_of_state, GV%ke, depth, & - h(i, j, :), tv%T(i, j, :), tv%S(i, j, :), p_col, & + h(i,j,:), tv%T(i,j,:), tv%S(i,j,:), p_col, & z_col, z_col_new, zScale=GV%Z_to_H, & h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) @@ -1519,9 +1527,10 @@ end subroutine build_grid_HyCOM1 !> This subroutine builds an adaptive grid that follows density surfaces where !! possible, subject to constraints on the smoothness of interface heights. -subroutine build_grid_adaptive(G, GV, h, tv, dzInterface, remapCS, CS) +subroutine build_grid_adaptive(G, GV, US, h, tv, dzInterface, remapCS, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables @@ -1567,7 +1576,7 @@ subroutine build_grid_adaptive(G, GV, h, tv, dzInterface, remapCS, CS) cycle endif - call build_adapt_column(CS%adapt_CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) + call build_adapt_column(CS%adapt_CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNext) call filtered_grid_motion(CS, nz, zInt(i,j,:), zNext, dzInterface(i,j,:)) ! convert from depth to z @@ -1585,9 +1594,10 @@ end subroutine build_grid_adaptive !! shallow topography, this will tend to give a uniform sigma-like coordinate. !! For sufficiently shallow water, a minimum grid spacing is used to avoid !! certain instabilities. -subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) +subroutine build_grid_SLight(G, GV, US, h, tv, dzInterface, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface !< Changes in interface position @@ -1596,7 +1606,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) real, dimension(SZK_(GV)+1) :: z_col ! Interface positions relative to the surface [H ~> m or kg m-2] real, dimension(SZK_(GV)+1) :: z_col_new ! Interface positions relative to the surface [H ~> m or kg m-2] real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [Pa] + real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [R L2 T-2 ~> Pa] real :: depth integer :: i, j, k, nz real :: h_neglect, h_neglect_edge @@ -1622,11 +1632,11 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) z_col(1) = 0. ! Work downward rather than bottom up do K=1,nz z_col(K+1) = z_col(K) + h(i,j,k) - p_col(k) = CS%ref_pressure + CS%compressibility_fraction * & - ( 0.5 * ( z_col(K) + z_col(K+1) ) * GV%H_to_Pa - CS%ref_pressure ) + p_col(k) = tv%P_Ref + CS%compressibility_fraction * & + ( 0.5 * ( z_col(K) + z_col(K+1) ) * (GV%H_to_RZ*GV%g_Earth) - tv%P_Ref ) enddo - call build_slight_column(CS%slight_CS, tv%eqn_of_state, GV%H_to_Pa, & + call build_slight_column(CS%slight_CS, tv%eqn_of_state, GV%H_to_RZ*GV%g_Earth, & GV%H_subroundoff, nz, depth, h(i, j, :), & tv%T(i, j, :), tv%S(i, j, :), p_col, z_col, z_col_new, & h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) @@ -1880,8 +1890,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, 1, GV%ke, 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 @@ -1900,8 +1909,7 @@ 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), 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 ) stratified = .false. @@ -1962,7 +1970,7 @@ end function uniformResolution subroutine initCoord(CS, GV, US, coord_mode) type(regridding_CS), intent(inout) :: CS !< Regridding control structure character(len=*), intent(in) :: coord_mode !< A string indicating the coordinate mode. - !! See the documenttion for regrid_consts + !! See the documentation for regrid_consts !! for the recognized values. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1975,16 +1983,15 @@ subroutine initCoord(CS, GV, US, coord_mode) case (REGRIDDING_SIGMA) call init_coord_sigma(CS%sigma_CS, CS%nk, CS%coordinateResolution) case (REGRIDDING_RHO) - call init_coord_rho(CS%rho_CS, CS%nk, CS%ref_pressure, CS%target_density, CS%interp_CS, & - rho_scale=US%kg_m3_to_R) + call init_coord_rho(CS%rho_CS, CS%nk, CS%ref_pressure, CS%target_density, CS%interp_CS) case (REGRIDDING_HYCOM1) call init_coord_hycom(CS%hycom_CS, CS%nk, CS%coordinateResolution, CS%target_density, & - CS%interp_CS, rho_scale=US%kg_m3_to_R) + CS%interp_CS) case (REGRIDDING_SLIGHT) call init_coord_slight(CS%slight_CS, CS%nk, CS%ref_pressure, CS%target_density, & - CS%interp_CS, GV%m_to_H, rho_scale=US%kg_m3_to_R) + CS%interp_CS, GV%m_to_H) case (REGRIDDING_ADAPTIVE) - call init_coord_adapt(CS%adapt_CS, CS%nk, CS%coordinateResolution, GV%m_to_H) + call init_coord_adapt(CS%adapt_CS, CS%nk, CS%coordinateResolution, GV%m_to_H, US%kg_m3_to_R) end select end subroutine initCoord @@ -2225,7 +2232,7 @@ end function getCoordinateShortName !> Can be used to set any of the parameters for MOM_regridding. subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_grid_weight, & interp_scheme, depth_of_time_filter_shallow, depth_of_time_filter_deep, & - compress_fraction, dz_min_surface, nz_fixed_surface, Rho_ML_avg_depth, & + compress_fraction, ref_pressure, dz_min_surface, nz_fixed_surface, Rho_ML_avg_depth, & nlay_ML_to_interior, fix_haloclines, halocline_filt_len, & halocline_strat_tol, integrate_downward_for_e, remap_answers_2018, & adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha, adaptDoMin, adaptDrho0) @@ -2237,7 +2244,9 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri character(len=*), optional, intent(in) :: interp_scheme !< Interpolation method for state-dependent coordinates real, optional, intent(in) :: depth_of_time_filter_shallow !< Depth to start cubic [H ~> m or kg m-2] real, optional, intent(in) :: depth_of_time_filter_deep !< Depth to end cubic [H ~> m or kg m-2] - real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density + real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density [nondim] + real, optional, intent(in) :: ref_pressure !< The reference pressure for density-dependent + !! coordinates [R L2 T-2 ~> Pa] real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost !! SLight_nkml_min layers [H ~> m or kg m-2] integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the top of the model @@ -2264,7 +2273,7 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri !! preventing interfaces from being shallower than !! the depths specified by the regridding coordinate. real, optional, intent(in) :: adaptDrho0 !< Reference density difference for stratification-dependent - !! diffusion. [kg m-3] + !! diffusion. [R ~> kg m-3] if (present(interp_scheme)) call set_interp_scheme(CS%interp_CS, interp_scheme) if (present(boundary_extrapolation)) call set_interp_extrap(CS%interp_CS, boundary_extrapolation) @@ -2283,6 +2292,7 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri if (present(min_thickness)) CS%min_thickness = min_thickness if (present(compress_fraction)) CS%compressibility_fraction = compress_fraction + if (present(ref_pressure)) CS%ref_pressure = ref_pressure if (present(integrate_downward_for_e)) CS%integrate_downward_for_e = integrate_downward_for_e if (present(remap_answers_2018)) CS%remap_answers_2018 = remap_answers_2018 diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 98bbeb7b10..42ae0ee245 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -5,6 +5,7 @@ module coord_adapt use MOM_EOS, only : calculate_density_derivs use MOM_error_handler, only : MOM_error, FATAL +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : ocean_grid_type, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -36,7 +37,7 @@ module coord_adapt !> Stratification-dependent diffusion coefficient real :: adaptBuoyCoeff - !> Reference density difference for stratification-dependent diffusion [kg m-3] + !> Reference density difference for stratification-dependent diffusion [R ~> kg m-3] real :: adaptDrho0 !> If true, form a HYCOM1-like mixed layet by preventing interfaces @@ -49,31 +50,28 @@ module coord_adapt contains !> Initialise an adapt_CS with parameters -subroutine init_coord_adapt(CS, nk, coordinateResolution, m_to_H) +subroutine init_coord_adapt(CS, nk, coordinateResolution, m_to_H, kg_m3_to_R) type(adapt_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid real, dimension(:), intent(in) :: coordinateResolution !< Nominal near-surface resolution [m] or !! other units specified with m_to_H - real, optional, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses - - real :: m_to_H_rescale ! A unit conversion factor. + real, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses + real, intent(in) :: kg_m3_to_R !< A conversion factor from kg m-3 to the units of density if (associated(CS)) call MOM_error(FATAL, "init_coord_adapt: CS already associated") allocate(CS) allocate(CS%coordinateResolution(nk)) - m_to_H_rescale = 1.0 ; if (present(m_to_H)) m_to_H_rescale = m_to_H - CS%nk = nk CS%coordinateResolution(:) = coordinateResolution(:) ! Set real parameter default values CS%adaptTimeRatio = 1e-1 ! Nondim. CS%adaptAlpha = 1.0 ! Nondim. - CS%adaptZoom = 200.0 * m_to_H_rescale + CS%adaptZoom = 200.0 * m_to_H ! [H ~> m or kg m-2] CS%adaptZoomCoeff = 0.0 ! Nondim. CS%adaptBuoyCoeff = 0.0 ! Nondim. - CS%adaptDrho0 = 0.5 ! [kg m-3] + CS%adaptDrho0 = 0.5 * kg_m3_to_R ! [R ~> kg m-3] end subroutine init_coord_adapt @@ -98,7 +96,7 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom real, optional, intent(in) :: adaptZoomCoeff !< Near-surface zooming coefficient real, optional, intent(in) :: adaptBuoyCoeff !< Stratification-dependent diffusion coefficient real, optional, intent(in) :: adaptDrho0 !< Reference density difference for - !! stratification-dependent diffusion + !! stratification-dependent diffusion [R ~> kg m-3] logical, optional, intent(in) :: adaptDoMin !< If true, form a HYCOM1-like mixed layer by !! preventing interfaces from becoming shallower than !! the depths set by coordinateResolution @@ -114,10 +112,11 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom if (present(adaptDoMin)) CS%adaptDoMin = adaptDoMin end subroutine set_adapt_params -subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) +subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNext) type(adapt_CS), intent(in) :: CS !< The control structure for this module 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(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables integer, intent(in) :: i !< The i-index of the column to work on @@ -130,8 +129,12 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) ! Local variables integer :: k, nz - real :: h_up, b1, b_denom_1, d1, depth, drdz, nominal_z, stretching - real, dimension(SZK_(GV)+1) :: alpha, beta, del2sigma ! drho/dT and drho/dS + 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) :: 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 nz = CS%nk @@ -143,8 +146,8 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) ! local depth for scaling diffusivity depth = G%bathyT(i,j) * GV%Z_to_H - ! initialize del2sigma to zero - del2sigma(:) = 0. + ! initialize del2sigma and the thickness change response to it zero + del2sigma(:) = 0.0 ; dh_d2s(:) = 0.0 ! calculate del-squared of neutral density by a ! stencilled finite difference @@ -155,8 +158,8 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) call calculate_density_derivs( & 0.5 * (tInt(i,j,2:nz) + tInt(i,j-1,2:nz)), & 0.5 * (sInt(i,j,2:nz) + sInt(i,j-1,2:nz)), & - 0.5 * (zInt(i,j,2:nz) + zInt(i,j-1,2:nz)) * GV%H_to_Pa, & - alpha, beta, 2, nz - 1, tv%eqn_of_state) + 0.5 * (zInt(i,j,2:nz) + zInt(i,j-1,2:nz)) * (GV%H_to_RZ * GV%g_Earth), & + alpha, beta, tv%eqn_of_state, (/2,nz/) ) del2sigma(2:nz) = del2sigma(2:nz) + & (alpha(2:nz) * (tInt(i,j-1,2:nz) - tInt(i,j,2:nz)) + & @@ -167,8 +170,8 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) call calculate_density_derivs( & 0.5 * (tInt(i,j,2:nz) + tInt(i,j+1,2:nz)), & 0.5 * (sInt(i,j,2:nz) + sInt(i,j+1,2:nz)), & - 0.5 * (zInt(i,j,2:nz) + zInt(i,j+1,2:nz)) * GV%H_to_Pa, & - alpha, beta, 2, nz - 1, tv%eqn_of_state) + 0.5 * (zInt(i,j,2:nz) + zInt(i,j+1,2:nz)) * (GV%H_to_RZ * GV%g_Earth), & + alpha, beta, tv%eqn_of_state, (/2,nz/) ) del2sigma(2:nz) = del2sigma(2:nz) + & (alpha(2:nz) * (tInt(i,j+1,2:nz) - tInt(i,j,2:nz)) + & @@ -179,8 +182,8 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) call calculate_density_derivs( & 0.5 * (tInt(i,j,2:nz) + tInt(i-1,j,2:nz)), & 0.5 * (sInt(i,j,2:nz) + sInt(i-1,j,2:nz)), & - 0.5 * (zInt(i,j,2:nz) + zInt(i-1,j,2:nz)) * GV%H_to_Pa, & - alpha, beta, 2, nz - 1, tv%eqn_of_state) + 0.5 * (zInt(i,j,2:nz) + zInt(i-1,j,2:nz)) * (GV%H_to_RZ * GV%g_Earth), & + alpha, beta, tv%eqn_of_state, (/2,nz/) ) del2sigma(2:nz) = del2sigma(2:nz) + & (alpha(2:nz) * (tInt(i-1,j,2:nz) - tInt(i,j,2:nz)) + & @@ -191,8 +194,8 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) call calculate_density_derivs( & 0.5 * (tInt(i,j,2:nz) + tInt(i+1,j,2:nz)), & 0.5 * (sInt(i,j,2:nz) + sInt(i+1,j,2:nz)), & - 0.5 * (zInt(i,j,2:nz) + zInt(i+1,j,2:nz)) * GV%H_to_Pa, & - alpha, beta, 2, nz - 1, tv%eqn_of_state) + 0.5 * (zInt(i,j,2:nz) + zInt(i+1,j,2:nz)) * (GV%H_to_RZ * GV%g_Earth), & + alpha, beta, tv%eqn_of_state, (/2,nz/) ) del2sigma(2:nz) = del2sigma(2:nz) + & (alpha(2:nz) * (tInt(i+1,j,2:nz) - tInt(i,j,2:nz)) + & @@ -205,23 +208,23 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) ! ! a positive curvature means we're too light relative to adjacent columns, ! so del2sigma needs to be positive too (push the interface deeper) - call calculate_density_derivs(tInt(i,j,:), sInt(i,j,:), zInt(i,j,:) * GV%H_to_Pa, & - alpha, beta, 1, nz + 1, tv%eqn_of_state) + call calculate_density_derivs(tInt(i,j,:), sInt(i,j,:), zInt(i,j,:) * (GV%H_to_RZ * GV%g_Earth), & + alpha, beta, tv%eqn_of_state, (/1,nz/) ) !### This should be (/1,nz+1/) - see 25 lines below. do K = 2, nz ! TODO make lower bound here configurable - del2sigma(K) = del2sigma(K) * (0.5 * (h(i,j,k-1) + h(i,j,k))) / & + dh_d2s(K) = del2sigma(K) * (0.5 * (h(i,j,k-1) + h(i,j,k))) / & max(alpha(K) * (tv%T(i,j,k) - tv%T(i,j,k-1)) + & - beta(K) * (tv%S(i,j,k) - tv%S(i,j,k-1)), 1e-20) + beta(K) * (tv%S(i,j,k) - tv%S(i,j,k-1)), 1e-20*US%kg_m3_to_R) ! don't move the interface so far that it would tangle with another ! interface in the direction we're moving (or exceed a Nyquist limit ! that could cause oscillations of the interface) - h_up = merge(h(i,j,k), h(i,j,k-1), del2sigma(K) > 0.) - del2sigma(K) = 0.5 * CS%adaptAlpha * & - sign(min(abs(del2sigma(K)), 0.5 * h_up), del2sigma(K)) + h_up = merge(h(i,j,k), h(i,j,k-1), dh_d2s(K) > 0.) + dh_d2s(K) = 0.5 * CS%adaptAlpha * & + sign(min(abs(del2sigma(K)), 0.5 * h_up), dh_d2s(K)) ! update interface positions so we can diffuse them - zNext(K) = zInt(i,j,K) + del2sigma(K) + zNext(K) = zInt(i,j,K) + dh_d2s(K) enddo ! solve diffusivity equation to smooth grid @@ -233,7 +236,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) do k = 1, nz ! calculate the dr bit of drdz drdz = 0.5 * (alpha(K) + alpha(K+1)) * (tInt(i,j,K+1) - tInt(i,j,K)) + & - 0.5 * (beta(K) + beta(K+1)) * (sInt(i,j,K+1) - sInt(i,j,K)) + 0.5 * (beta(K) + beta(K+1)) * (sInt(i,j,K+1) - sInt(i,j,K)) ! divide by dz from the new interface positions drdz = drdz / (zNext(K) - zNext(K+1) + GV%H_subroundoff) ! don't do weird stuff in unstably-stratified regions diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 1686ac51c9..016e4016eb 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -21,9 +21,6 @@ module coord_hycom !> Nominal density of interfaces [R ~> kg m-3] real, allocatable, dimension(:) :: target_density - !> Density scaling factor [R m3 kg-1 ~> 1] - real :: kg_m3_to_R - !> Maximum depths of interfaces [H ~> m or kg m-2] real, allocatable, dimension(:) :: max_interface_depths @@ -39,13 +36,12 @@ module coord_hycom contains !> Initialise a hycom_CS with pointers to parameters -subroutine init_coord_hycom(CS, nk, coordinateResolution, target_density, interp_CS, rho_scale) +subroutine init_coord_hycom(CS, nk, coordinateResolution, target_density, interp_CS) type(hycom_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in generated grid real, dimension(nk), intent(in) :: coordinateResolution !< Nominal near-surface resolution [Z ~> m] real, dimension(nk+1),intent(in) :: target_density !< Interface target densities [R ~> kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation - real, optional, intent(in) :: rho_scale !< A dimensional scaling factor for target_density if (associated(CS)) call MOM_error(FATAL, "init_coord_hycom: CS already associated!") allocate(CS) @@ -56,7 +52,6 @@ subroutine init_coord_hycom(CS, nk, coordinateResolution, target_density, interp CS%coordinateResolution(:) = coordinateResolution(:) CS%target_density(:) = target_density(:) CS%interp_CS = interp_CS - CS%kg_m3_to_R = 1.0 ; if (present(rho_scale)) CS%kg_m3_to_R = rho_scale end subroutine init_coord_hycom @@ -109,7 +104,7 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & 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) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(nz), intent(in) :: p_col !< Layer pressure [Pa] + 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] real, dimension(CS%nk+1), intent(inout) :: z_col_new !< Absolute positions of interfaces [H ~> m or kg m-2] real, optional, intent(in) :: zScale !< Scaling factor from the input coordinate thicknesses in [Z ~> m] @@ -136,7 +131,7 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & z_scale = 1.0 ; if (present(zScale)) z_scale = zScale ! Work bottom recording potential density - call calculate_density(T, S, p_col, rho_col, 1, nz, eqn_of_state, scale=CS%kg_m3_to_R) + call calculate_density(T, S, p_col, rho_col, eqn_of_state) ! This ensures the potential density profile is monotonic ! although not necessarily single valued. do k = nz-1, 1, -1 diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index a78b1dd749..5299c74b1b 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -19,7 +19,7 @@ module coord_rho !> Minimum thickness allowed for layers, often in [H ~> m or kg m-2] real :: min_thickness = 0. - !> Reference pressure for density calculations [Pa] + !> Reference pressure for density calculations [R L2 T-2 ~> Pa] real :: ref_pressure !> If true, integrate for interface positions from the top downward. @@ -29,9 +29,6 @@ module coord_rho !> Nominal density of interfaces [R ~> kg m-3] real, allocatable, dimension(:) :: target_density - !> Density scaling factor [R m3 kg-1 ~> 1] - real :: kg_m3_to_R - !> Interpolation control structure type(interp_CS_type) :: interp_CS end type rho_CS @@ -41,13 +38,12 @@ module coord_rho contains !> Initialise a rho_CS with pointers to parameters -subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS, rho_scale) +subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS) type(rho_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid - real, intent(in) :: ref_pressure !< Coordinate reference pressure [Pa] + real, intent(in) :: ref_pressure !< Coordinate reference pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [R ~> kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation - real, optional, intent(in) :: rho_scale !< A dimensional scaling factor for target_density if (associated(CS)) call MOM_error(FATAL, "init_coord_rho: CS already associated!") allocate(CS) @@ -57,7 +53,6 @@ subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS, rho_s CS%ref_pressure = ref_pressure CS%target_density(:) = target_density(:) CS%interp_CS = interp_CS - CS%kg_m3_to_R = 1.0 ; if (present(rho_scale)) CS%kg_m3_to_R = rho_scale end subroutine init_coord_rho @@ -111,7 +106,7 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & ! Local variables integer :: k, count_nonzero_layers integer, dimension(nz) :: mapping - real, dimension(nz) :: pres ! Pressures used to calculate density [Pa] + real, dimension(nz) :: pres ! Pressures used to calculate density [R L2 T-2 ~> Pa] real, dimension(nz) :: h_nv ! Thicknesses of non-vanishing layers [H ~> m or kg m-2] real, dimension(nz) :: densities ! Layer density [R ~> kg m-3] real, dimension(nz+1) :: xTmp ! Temporary positions [H ~> m or kg m-2] @@ -129,7 +124,7 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & ! Compute densities on source column pres(:) = CS%ref_pressure - call calculate_density(T, S, pres, densities, 1, nz, eqn_of_state, scale=CS%kg_m3_to_R) + call calculate_density(T, S, pres, densities, eqn_of_state) do k = 1,count_nonzero_layers densities(k) = densities(mapping(k)) enddo @@ -211,7 +206,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ ! Local variables real, dimension(nz+1) :: x0, x1, xTmp ! Temporary interface heights [Z ~> m] - real, dimension(nz) :: pres ! The pressure used in the equation of state [Pa]. + 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) :: Tmp ! A temporary variable holding a remapped variable. @@ -252,8 +247,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, & - 1, nz, eqn_of_state, scale=CS%kg_m3_to_R) + 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 30f2597090..5cfa09213f 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -20,7 +20,7 @@ module coord_slight !> Minimum thickness allowed when building the new grid through regridding [H ~> m or kg m-2] real :: min_thickness - !> Reference pressure for potential density calculations [Pa] + !> Reference pressure for potential density calculations [R L2 T-2 ~> Pa] real :: ref_pressure !> Fraction (between 0 and 1) of compressibility to add to potential density @@ -54,9 +54,6 @@ module coord_slight !> Nominal density of interfaces [R ~> kg m-3]. real, allocatable, dimension(:) :: target_density - !> Density scaling factor [R m3 kg-1 ~> 1] - real :: kg_m3_to_R - !> Maximum depths of interfaces [H ~> m or kg m-2]. real, allocatable, dimension(:) :: max_interface_depths @@ -72,14 +69,13 @@ module coord_slight contains !> Initialise a slight_CS with pointers to parameters -subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_to_H, rho_scale) +subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_to_H) type(slight_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid - real, intent(in) :: ref_pressure !< Coordinate reference pressure [Pa] + real, intent(in) :: ref_pressure !< Coordinate reference pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [R ~> kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation real, optional, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses - real, optional, intent(in) :: rho_scale !< A dimensional scaling factor for target_density real :: m_to_H_rescale ! A unit conversion factor. @@ -101,7 +97,6 @@ subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_ CS%dz_ml_min = 1.0 * m_to_H_rescale CS%halocline_filter_length = 2.0 * m_to_H_rescale CS%halocline_strat_tol = 0.25 ! Nondim. - CS%kg_m3_to_R = 1.0 ; if (present(rho_scale)) CS%kg_m3_to_R = rho_scale end subroutine init_coord_slight @@ -182,19 +177,20 @@ subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & end subroutine set_slight_params !> Build a SLight coordinate column -subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & +subroutine build_slight_column(CS, eqn_of_state, H_to_pres, H_subroundoff, & nz, depth, h_col, T_col, S_col, p_col, z_col, z_col_new, & h_neglect, h_neglect_edge) type(slight_CS), intent(in) :: CS !< Coordinate control structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure - real, intent(in) :: H_to_Pa !< GV%H_to_Pa + real, intent(in) :: H_to_pres !< A conversion factor from thicknesses to + !! scaled pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] 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) :: h_col !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(nz), intent(in) :: p_col !< Layer quantities + 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] real, dimension(nz+1), intent(inout) :: z_col_new !< Absolute positions of interfaces [H ~> m or kg m-2] real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of @@ -207,8 +203,8 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & 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) :: rho_tmp ! A temporary density [R ~> kg m-3] - real, dimension(nz+1) :: drho_dp ! The partial derivative of density with pressure [kg m-3 Pa-1] - real, dimension(nz+1) :: p_IS, p_R + 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] real, dimension(nz+1) :: drhoIS_dS ! The partial derivative of in situ density with salinity @@ -218,19 +214,20 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & real, dimension(nz+1) :: drhoR_dS ! The partial derivative of reference density with salinity ! in [R ppt-1 ~> kg m-3 ppt-1] real, dimension(nz+1) :: strat_rat - real :: H_to_cPa + 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] real :: drIS, drR ! In situ and reference density differences [R ~> kg m-3] - real :: Fn_now, I_HStol, Fn_zero_val - real :: z_int_unst - real :: dz ! A uniform layer thickness in very shallow water [H ~> m or kg m-2]. - real :: dz_ur ! The total thickness of an unstable region [H ~> m or kg m-2]. + real :: Fn_now, I_HStol, Fn_zero_val ! Nondimensional variables [nondim] + real :: z_int_unst ! The depth where the stratification allows the interior grid to start [H ~> m or kg m-2] + real :: dz ! A uniform layer thickness in very shallow water [H ~> m or kg m-2]. + real :: dz_ur ! The total thickness of an unstable region [H ~> m or kg m-2]. real :: wgt, cowgt ! A weight and its complement [nondim]. - real :: rho_ml_av ! The average potential density in a near-surface region [R ~> kg m-3]. - real :: H_ml_av ! A thickness to try to use in taking the near-surface average [H ~> m or kg m-2]. - real :: rho_x_z ! A cumulative integral of a density [R H ~> kg m-2 or kg2 m-5]. - real :: z_wt ! The thickness actually used in taking the near-surface average [H ~> m or kg m-2]. - real :: k_interior ! The (real) value of k where the interior grid starts. - real :: k_int2 ! The (real) value of k where the interior grid starts. + real :: rho_ml_av ! The average potential density in a near-surface region [R ~> kg m-3]. + real :: H_ml_av ! A thickness to try to use in taking the near-surface average [H ~> m or kg m-2]. + real :: rho_x_z ! A cumulative integral of a density [R H ~> kg m-2 or kg2 m-5]. + real :: z_wt ! The thickness actually used in taking the near-surface average [H ~> m or kg m-2]. + real :: k_interior ! The (real) value of k where the interior grid starts [nondim]. + real :: k_int2 ! The (real) value of k where the interior grid starts [nondim]. real :: z_interior ! The depth where the interior grid starts [H ~> m or kg m-2]. real :: z_ml_fix ! The depth at which the fixed-thickness near-surface layers end [H ~> m or kg m-2]. real :: dz_dk ! The thickness of layers between the fixed-thickness @@ -254,8 +251,7 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & dz = (z_col(nz+1) - z_col(1)) / real(nz) do K=2,nz ; z_col_new(K) = z_col(1) + dz*real(K-1) ; enddo else - call calculate_density(T_col, S_col, p_col, rho_col, 1, nz, & - eqn_of_state, scale=CS%kg_m3_to_R) + call calculate_density(T_col, S_col, p_col, rho_col, eqn_of_state) ! Find the locations of the target potential densities, flagging ! locations in apparently unstable regions as not reliable. @@ -371,23 +367,22 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & T_int(1) = T_f(1) ; S_int(1) = S_f(1) do K=2,nz T_int(K) = 0.5*(T_f(k-1) + T_f(k)) ; S_int(K) = 0.5*(S_f(k-1) + S_f(k)) - p_IS(K) = z_col(K) * H_to_Pa + p_IS(K) = z_col(K) * H_to_pres p_R(K) = CS%ref_pressure + CS%compressibility_fraction * ( p_IS(K) - CS%ref_pressure ) enddo T_int(nz+1) = T_f(nz) ; S_int(nz+1) = S_f(nz) - p_IS(nz+1) = z_col(nz+1) * H_to_Pa - call calculate_density_derivs(T_int, S_int, p_IS, drhoIS_dT, drhoIS_dS, 2, nz-1, & - eqn_of_state, scale=CS%kg_m3_to_R) - call calculate_density_derivs(T_int, S_int, p_R, drhoR_dT, drhoR_dS, 2, nz-1, & - eqn_of_state, scale=CS%kg_m3_to_R) + p_IS(nz+1) = z_col(nz+1) * H_to_pres + call calculate_density_derivs(T_int, S_int, p_IS, drhoIS_dT, drhoIS_dS, & + eqn_of_state, (/2,nz/) ) + 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, 2, nz-1, eqn_of_state) else do K=2,nz ; drho_dp(K) = 0.0 ; enddo endif - H_to_cPa = CS%compressibility_fraction*CS%kg_m3_to_R*H_to_Pa + H_to_cPa = CS%compressibility_fraction * H_to_pres strat_rat(1) = 1.0 do K=2,nz drIS = drhoIS_dT(K) * (T_f(k) - T_f(k-1)) + & diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1ee89f307c..80cc36c577 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -74,7 +74,7 @@ module MOM use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid -use MOM_EOS, only : EOS_init, calculate_density, calculate_TFreeze +use MOM_EOS, only : EOS_init, calculate_density, calculate_TFreeze, EOS_domain use MOM_fixed_initialization, only : MOM_initialize_fixed use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_forcing_type, only : deallocate_mech_forcing, deallocate_forcing_type @@ -278,9 +278,9 @@ module MOM !! a previous time-step or the ocean restart file. !! This is only valid when interp_p_surf is true. real, dimension(:,:), pointer :: & - p_surf_prev => NULL(), & !< surface pressure [Pa] at end previous call to step_MOM - p_surf_begin => NULL(), & !< surface pressure [Pa] at start of step_MOM_dyn_... - p_surf_end => NULL() !< surface pressure [Pa] at end of step_MOM_dyn_... + p_surf_prev => NULL(), & !< surface pressure [R L2 T-2 ~> Pa] at end previous call to step_MOM + p_surf_begin => NULL(), & !< surface pressure [R L2 T-2 ~> Pa] at start of step_MOM_dyn_... + p_surf_end => NULL() !< surface pressure [R L2 T-2 ~> Pa] at end of step_MOM_dyn_... ! Variables needed to reach between start and finish phases of initialization logical :: write_IC !< If true, then the initial conditions will be written to file @@ -488,7 +488,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS v => NULL(), & ! v : meridional velocity component [L T-1 ~> m s-1] h => NULL() ! h : layer thickness [H ~> m or kg m-2] real, dimension(:,:), pointer :: & - p_surf => NULL() ! A pointer to the ocean surface pressure [Pa]. + p_surf => NULL() ! A pointer to the ocean surface pressure [R L2 T-2 ~> Pa]. real :: I_wt_ssh ! The inverse of the time weights [T-1 ~> s-1] type(time_type) :: Time_local, end_time_thermo, Time_temp @@ -938,10 +938,10 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface !! pressure at the beginning of this dynamic - !! step, intent in [Pa]. + !! step, intent in [R L2 T-2 ~> Pa]. real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface !! pressure at the end of this dynamic step, - !! intent in [Pa]. + !! intent in [R L2 T-2 ~> Pa]. real, intent(in) :: dt !< time interval covered by this call [T ~> s]. real, intent(in) :: dt_thermo !< time interval covered by any updates that may !! span multiple dynamics steps [T ~> s]. @@ -1872,7 +1872,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif ! This is here in case these values are used inappropriately. - use_frazil = .false. ; bound_salinity = .false. ; CS%tv%P_Ref = 2.0e7 + use_frazil = .false. ; bound_salinity = .false. + CS%tv%P_Ref = 2.0e7*US%kg_m3_to_R*US%m_s_to_L_T**2 if (use_temperature) then call get_param(param_file, "MOM", "FRAZIL", use_frazil, & "If true, water freezes if it gets too cold, and the "//& @@ -1887,8 +1888,8 @@ 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. "//& - "The default is 0.01 for backward compatibility but ideally "//& - "should be 0.", units="PPT", default=0.01, do_not_log=.not.bound_salinity) + "The default is 0.01 for backward compatibility but ideally should be 0.", & + units="PPT", default=0.01, 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 "//& @@ -1899,8 +1900,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (use_EOS) call get_param(param_file, "MOM", "P_REF", CS%tv%P_Ref, & "The pressure that is used for calculating the coordinate "//& "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& - "This is only used if USE_EOS and ENABLE_THERMODYNAMICS "//& - "are true.", units="Pa", default=2.0e7) + "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", & + units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) if (bulkmixedlayer) then call get_param(param_file, "MOM", "NKML", nkml, & @@ -2245,7 +2246,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Use the Wright equation of state by default, unless otherwise specified ! Note: this line and the following block ought to be in a separate ! initialization routine for tv. - if (use_EOS) call EOS_init(param_file, CS%tv%eqn_of_state) + if (use_EOS) call EOS_init(param_file, CS%tv%eqn_of_state, US) if (use_temperature) then allocate(CS%tv%TempxPmE(isd:ied,jsd:jed)) ; CS%tv%TempxPmE(:,:) = 0.0 if (use_geothermal) then @@ -2658,8 +2659,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif if (CS%interp_p_surf) then - CS%p_surf_prev_set = & - query_initialized(CS%p_surf_prev,"p_surf_prev",restart_CSp) + CS%p_surf_prev_set = query_initialized(CS%p_surf_prev,"p_surf_prev",restart_CSp) if (CS%p_surf_prev_set) call pass_var(CS%p_surf_prev, G%domain) endif @@ -2891,32 +2891,37 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) 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)), intent(inout) :: ssh !< time mean surface height [m] - real, dimension(:,:), optional, pointer :: p_atm !< atmospheric pressure [Pa] + real, dimension(:,:), optional, pointer :: p_atm !< Ocean surface pressure [R L2 T-2 ~> Pa] logical, optional, intent(in) :: use_EOS !< If true, calculate the density for !! the SSH correction using the equation of state. - real :: Rho_conv ! The density used to convert surface pressure to + real :: Rho_conv(SZI_(G)) ! The density used to convert surface pressure to ! a corrected effective SSH [R ~> kg m-3]. - real :: IgR0 ! The SSH conversion factor from Pa to m [m Pa-1]. + real :: IgR0 ! The SSH conversion factor from R L2 T-2 to m [m T2 R-1 L-2 ~> m Pa-1]. logical :: calc_rho + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + EOSdom(:) = EOS_domain(G%HI) if (present(p_atm)) then ; if (associated(p_atm)) then calc_rho = associated(tv%eqn_of_state) if (present(use_EOS) .and. calc_rho) calc_rho = use_EOS - ! Correct the output sea surface height for the contribution from the - ! atmospheric pressure - do j=js,je ; do i=is,ie + ! Correct the output sea surface height for the contribution from the ice pressure. + do j=js,je if (calc_rho) then - call calculate_density(tv%T(i,j,1), tv%S(i,j,1), p_atm(i,j)/2.0, & - Rho_conv, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), Rho_conv, & + tv%eqn_of_state, EOSdom) + do i=is,ie + IgR0 = US%Z_to_m / (Rho_conv(i) * GV%g_Earth) + ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 + enddo else - Rho_conv = GV%Rho0 + do i=is,ie + ssh(i,j) = ssh(i,j) + p_atm(i,j) * (US%Z_to_m / (GV%Rho0 * GV%g_Earth)) + enddo endif - IgR0 = 1.0 / (Rho_conv * US%R_to_kg_m3*GV%mks_g_Earth) - ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 - enddo ; enddo + enddo endif ; endif end subroutine adjust_ssh_for_p_atm @@ -3210,13 +3215,13 @@ subroutine extract_surface_state(CS, sfc_state_in) 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 - sfc_state%taux_shelf(I,j) = US%R_to_kg_m3*US%L_T_to_m_s**2*US%Z_to_L*CS%visc%taux_shelf(I,j) + sfc_state%taux_shelf(I,j) = US%RZ_T_to_kg_m2s*US%L_T_to_m_s*CS%visc%taux_shelf(I,j) enddo ; enddo endif if (allocated(sfc_state%tauy_shelf) .and. associated(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) = US%R_to_kg_m3*US%L_T_to_m_s**2*US%Z_to_L*CS%visc%tauy_shelf(i,J) + sfc_state%tauy_shelf(i,J) = US%RZ_T_to_kg_m2s*US%L_T_to_m_s*CS%visc%tauy_shelf(i,J) enddo ; enddo endif diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 5579b2311f..6fad3e0d93 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -59,10 +59,10 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), & optional, pointer :: p_atm !< The pressure at the ice-ocean or - !! atmosphere-ocean interface [Pa]. + !! atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in each layer - !! due to eta anomalies [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! due to eta anomalies [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: eta !< The bottom mass used to calculate PFu and PFv, !! [H ~> m or kg m-2], with any tidal contributions. diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 43de125701..99268460df 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -31,7 +31,7 @@ module MOM_PressureForce_Mont type, public :: PressureForce_Mont_CS ; private logical :: tides !< If true, apply tidal momentum forcing. real :: Rho0 !< The density used in the Boussinesq - !! approximation [kg m-3]. + !! approximation [R ~> kg m-3]. real :: GFS_scale !< Ratio between gravity applied to top interface and the !! gravitational acceleration of the planet [nondim]. !! Usually this ratio is 1. @@ -71,7 +71,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !! (equal to -dM/dy) [L T-2 ~> m s-2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or - !! atmosphere-ocean [Pa]. + !! atmosphere-ocean [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies, @@ -82,8 +82,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. alpha_star, & ! Compression adjusted specific volume [R-1 ~> m3 kg-1]. - dz_geo ! The change in geopotential across a layer [m2 s-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. + dz_geo ! The change in geopotential across a layer [L2 T-2 ~> m2 s-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [R L2 T-2 ~> Pa]. ! p may be adjusted (with a nonlinear equation of state) so that ! its derivative compensates for the adiabatic compressibility ! in seawater, but p will still be close to the pressure. @@ -97,43 +97,40 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! deepest variable density near-surface layer [R ~> kg m-3]. real, dimension(SZI_(G),SZJ_(G)) :: & - dM, & ! A barotropic correction to the Montgomery potentials to - ! enable the use of a reduced gravity form of the equations - ! [m2 s-2]. - dp_star, & ! Layer thickness after compensation for compressibility [Pa]. + dM, & ! A barotropic correction to the Montgomery potentials to enable the use + ! of a reduced gravity form of the equations [L2 T-2 ~> m2 s-2]. + dp_star, & ! Layer thickness after compensation for compressibility [R L2 T-2 ~> Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! Bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. geopot_bot ! Bottom geopotential relative to time-mean sea level, ! including any tidal contributions [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density [Pa] (usually 2e7 Pa = 2000 dbar). + ! density [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). real :: rho_in_situ(SZI_(G)) !In-situ density of a layer [R ~> kg m-3]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer ! compensated density gradients [L T-2 ~> m s-2] real :: dp_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [Pa]. + ! in roundoff and can be neglected [R L2 T-2 ~> Pa]. logical :: use_p_atm ! If true, use the atmospheric pressure. - logical :: use_EOS ! If true, density is calculated from T & S using - ! an equation of state. - logical :: is_split ! A flag indicating whether the pressure - ! gradient terms are to be split into - ! barotropic and baroclinic pieces. + logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. + logical :: is_split ! A flag indicating whether the pressure gradient terms are to be + ! split into barotropic and baroclinic pieces. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: I_gEarth ! The inverse of g_Earth [s2 Z m-2 ~> s2 m-1] + real :: I_gEarth ! The inverse of g_Earth [T2 Z L-2 ~> s2 m-1] ! real :: dalpha - real :: Pa_to_p_dyn ! A conversion factor from Pa (= kg m-1 s-2) to the units of - ! dynamic pressure (R L2 T-2) [ R L2 T-2 m s2 kg-1 ~> nondim] - real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). + real :: Pa_to_H ! A factor to convert from R L2 T-2 to the thickness units (H). real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [R-1 ~> m3 kg-1]. real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each ! interface [R-1 ~> m3 kg-1]. + integer, dimension(2) :: EOSdom ! The computational domain for the equation of state integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke nkmb=GV%nk_rho_varies Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) use_p_atm = .false. if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif @@ -148,9 +145,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - Pa_to_p_dyn = US%kg_m3_to_R * US%m_s_to_L_T**2 - I_gEarth = 1.0 / (US%L_T_to_m_s**2 * GV%g_Earth) - dp_neglect = GV%H_to_Pa * GV%H_subroundoff + I_gEarth = 1.0 / GV%g_Earth + dp_neglect = GV%g_Earth * GV%H_to_RZ * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / (GV%Rlay(k)) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo @@ -163,20 +159,20 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 - p(i,j,K+1) = p(i,j,K) + GV%H_to_Pa * h(i,j,k) + p(i,j,K+1) = p(i,j,K) + GV%g_Earth * GV%H_to_RZ * h(i,j,k) enddo ; enddo ; enddo if (present(eta)) then - Pa_to_H = 1.0 / GV%H_to_Pa + Pa_to_H = 1.0 / (GV%g_Earth * GV%H_to_RZ) if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = (p(i,j,nz+1) - p_atm(i,j))*Pa_to_H ! eta has the same units as h. + eta(i,j) = (p(i,j,nz+1) - p_atm(i,j)) * Pa_to_H ! eta has the same units as h. enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = p(i,j,nz+1)*Pa_to_H ! eta has the same units as h. + eta(i,j) = p(i,j,nz+1) * Pa_to_H ! eta has the same units as h. enddo ; enddo endif endif @@ -195,7 +191,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=1) enddo !$OMP parallel do default(shared) - do j=Jsq,Jeq+1 ; do k=1,nz; do i=Isq,Ieq+1 + do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 SSH(i,j) = SSH(i,j) + I_gEarth * dz_geo(i,j,k) enddo ; enddo ; enddo else @@ -233,8 +229,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo - call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then tv_tmp%T(i,j,k) = tv%T(i,j,nkmb) ; tv_tmp%S(i,j,k) = tv%S(i,j,nkmb) @@ -250,8 +246,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb endif !$OMP parallel do default(shared) private(rho_in_situ) do k=1,nz ; do j=Jsq,Jeq+1 - call calculate_density(tv_tmp%T(:,j,k),tv_tmp%S(:,j,k),p_ref, & - rho_in_situ,Isq,Ieq-Isq+2,tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_in_situ, & + tv%eqn_of_state, EOSdom) do i=Isq,Ieq+1 ; alpha_star(i,j,k) = 1.0 / rho_in_situ(i) ; enddo enddo ; enddo endif ! use_EOS @@ -260,20 +256,20 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + Pa_to_p_dyn*p(i,j,nz+1) * alpha_star(i,j,nz) + M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_star(i,j,nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + Pa_to_p_dyn*p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) + M(i,j,k) = M(i,j,k+1) + p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) enddo ; enddo enddo else ! not use_EOS !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + Pa_to_p_dyn*p(i,j,nz+1) * alpha_Lay(nz) + M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_Lay(nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + Pa_to_p_dyn*p(i,j,K+1) * dalpha_int(K+1) + M(i,j,k) = M(i,j,k+1) + p(i,j,K+1) * dalpha_int(K+1) enddo ; enddo enddo endif ! use_EOS @@ -296,11 +292,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! enddo ; enddo ! if (use_EOS) then ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - Pa_to_p_dyn*p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) +! M(i,j,k) = M(i,j,k-1) - p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) ! enddo ; enddo ; enddo ! else ! not use_EOS ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - Pa_to_p_dyn*p(i,j,K) * dalpha_int(K) +! M(i,j,k) = M(i,j,k-1) - p(i,j,K) * dalpha_int(K) ! enddo ; enddo ; enddo ! endif ! use_EOS @@ -321,16 +317,16 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo do j=js,je ; do I=Isq,Ieq ! PFu_bc = p* grad alpha* - PFu_bc = (alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * Pa_to_p_dyn * & - ((dp_star(i,j) * dp_star(i+1,j) + (p(i,j,K) * dp_star(i+1,j) + & - p(i+1,j,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i+1,j)))) + PFu_bc = (alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * & + ((dp_star(i,j)*dp_star(i+1,j) + (p(i,j,K)*dp_star(i+1,j) + p(i+1,j,K)*dp_star(i,j))) / & + (dp_star(i,j) + dp_star(i+1,j)))) PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * Pa_to_p_dyn * & - ((dp_star(i,j) * dp_star(i,j+1) + (p(i,j,K) * dp_star(i,j+1) + & - p(i,j+1,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i,j+1)))) + PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & + ((dp_star(i,j)*dp_star(i,j+1) + (p(i,j,K)*dp_star(i,j+1) + p(i,j+1,K)*dp_star(i,j))) / & + (dp_star(i,j) + dp_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo @@ -372,7 +368,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !! (equal to -dM/dy) [L T-2 ~> m s2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or - !! atmosphere-ocean [Pa]. + !! atmosphere-ocean [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies !! [L2 T-2 H-1 ~> m s-2]. @@ -400,8 +396,8 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! forces from astronomical sources and self- ! attraction and loading, in depth units [Z ~> m]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density [Pa] (usually 2e7 Pa = 2000 dbar). - real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. + ! density [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). + real :: I_Rho0 ! 1/Rho0 [R-1 ~> m3 kg-1]. real :: G_Rho0 ! G_Earth / Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer ! compensated density gradients [L T-2 ~> m s-2] @@ -414,12 +410,14 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! gradient terms are to be split into ! barotropic and baroclinic pieces. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. + integer, dimension(2) :: EOSdom ! The computational domain for the equation of state integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke nkmb=GV%nk_rho_varies Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) use_p_atm = .false. if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif @@ -488,8 +486,8 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo - call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -510,7 +508,8 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !$OMP parallel do default(shared) do k=1,nz+1 ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), & - Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R*G_Rho0) + tv%eqn_of_state, EOSdom) + do i=Isq,Ieq+1 ; rho_star(i,j,k) = G_Rho0*rho_star(i,j,k) ; enddo enddo ; enddo endif ! use_EOS @@ -520,7 +519,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = CS%GFS_scale * (rho_star(i,j,1) * e(i,j,1)) - if (use_p_atm) M(i,j,1) = M(i,j,1) + US%m_s_to_L_T**2*p_atm(i,j) * I_Rho0 + if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k-1) + (rho_star(i,j,k) - rho_star(i,j,k-1)) * e(i,j,K) @@ -531,7 +530,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = GV%g_prime(1) * e(i,j,1) - if (use_p_atm) M(i,j,1) = M(i,j,1) + US%m_s_to_L_T**2*p_atm(i,j) * I_Rho0 + if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * e(i,j,K) @@ -609,7 +608,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height [Z ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: Rho0 !< The "Boussinesq" ocean density [kg m-3]. + real, intent(in) :: Rho0 !< The "Boussinesq" ocean density [R ~> kg m-3]. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top !! interface and the gravitational acceleration of !! the planet [nondim]. Usually this ratio is 1. @@ -623,23 +622,25 @@ 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 [Pa]. + 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 :: 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 m3 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] + 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 [kg s-2 m-1 Z-1 ~> kg s-2 m-2] logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. real :: z_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. + integer, dimension(2) :: EOSdom ! The computational domain for the equation of state integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) - Rho0xG = Rho0*US%L_T_to_m_s**2 * GV%g_Earth + Rho0xG = Rho0 * GV%g_Earth G_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) z_neglect = GV%H_subroundoff*GV%H_to_Z @@ -665,7 +666,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) press(i) = -Rho0xG*e(i,j,1) enddo call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & - Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + tv%eqn_of_state, EOSdom) do i=Isq,Ieq+1 pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo @@ -676,7 +677,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) S_int(i) = 0.5*(tv%S(i,j,k-1)+tv%S(i,j,k)) enddo call calculate_density_derivs(T_int, S_int, press, dR_dT, dR_dS, & - Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + tv%eqn_of_state, EOSdom) do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + G_Rho0 * & ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) * & @@ -707,22 +708,22 @@ end subroutine Set_pbce_Bouss subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures [Pa]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures [R L2 T-2 ~> Pa]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: GFS_scale !< Ratio between gravity applied to top !! interface and the gravitational acceleration of !! the planet [nondim]. Usually this ratio is 1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due - !! to free surface height anomalies - !! [L2 H-1 T-2 ~> m4 kg-1 s-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: pbce !< The baroclinic pressure anomaly in each + !! layer due to free surface height anomalies + !! [L2 H-1 T-2 ~> m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: alpha_star !< The layer specific volumes !! (maybe compressibility compensated) [R-1 ~> m3 kg-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & dpbce, & ! A barotropic correction to the pbce to enable the use of ! a reduced gravity form of the equations [L2 H-1 T-2 ~> m4 kg-1 s-2]. - C_htot ! dP_dH divided by the total ocean pressure [R L2 T-2 H-1 Pa-1 ~> m2 kg-1]. + 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]. @@ -733,17 +734,18 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) real :: dP_dH ! A factor that converts from thickness to pressure times other dimensional ! conversion factors [R L2 T-2 H-1 ~> Pa m2 kg-1]. real :: dp_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [Pa]. - logical :: use_EOS ! If true, density is calculated from T & S using - ! an equation of state. + ! in roundoff and can be neglected [R L2 T-2 ~> Pa]. + logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. + integer, dimension(2) :: EOSdom ! The computational domain for the equation of state integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) use_EOS = associated(tv%eqn_of_state) dP_dH = GV%g_Earth * GV%H_to_RZ - dp_neglect = GV%H_to_Pa * GV%H_subroundoff + dp_neglect = GV%g_Earth * GV%H_to_RZ * GV%H_subroundoff if (use_EOS) then if (present(alpha_star)) then @@ -761,8 +763,8 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) else !$OMP parallel do default(shared) private(T_int,S_int,dR_dT,dR_dS,rho_in_situ) do j=Jsq,Jeq+1 - call calculate_density(tv%T(:,j,nz), tv%S(:,j,nz), p(:,j,nz+1), & - rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,nz), tv%S(:,j,nz), p(:,j,nz+1), rho_in_situ, & + tv%eqn_of_state, EOSdom) do i=Isq,Ieq+1 C_htot(i,j) = dP_dH / ((p(i,j,nz+1)-p(i,j,1)) + dp_neglect) pbce(i,j,nz) = dP_dH / (rho_in_situ(i)) @@ -772,10 +774,9 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) T_int(i) = 0.5*(tv%T(i,j,k)+tv%T(i,j,k+1)) S_int(i) = 0.5*(tv%S(i,j,k)+tv%S(i,j,k+1)) enddo - call calculate_density(T_int, S_int, p(:,j,k+1), rho_in_situ, & - Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T_int, S_int, p(:,j,k+1), rho_in_situ, tv%eqn_of_state, EOSdom) call calculate_density_derivs(T_int, S_int, p(:,j,k+1), dR_dT, dR_dS, & - Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + tv%eqn_of_state, EOSdom) do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k+1) + ((p(i,j,K+1)-p(i,j,1))*C_htot(i,j)) * & ((dR_dT(i)*(tv%T(i,j,k+1)-tv%T(i,j,k)) + & @@ -796,8 +797,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) pbce(i,j,nz) = dP_dH * alpha_Lay(nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - pbce(i,j,k) = pbce(i,j,k+1) + ((p(i,j,K+1)-p(i,j,1))*C_htot(i,j)) * & - dalpha_int(K+1) + pbce(i,j,k) = pbce(i,j,k+1) + ((p(i,j,K+1)-p(i,j,1))*C_htot(i,j)) * dalpha_int(K+1) enddo ; enddo enddo endif ! use_EOS @@ -851,7 +851,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%R_to_kg_m3) call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) call get_param(param_file, mdl, "USE_EOS", use_EOS, default=.true., & diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 75a2dfad7f..614bf3bc8a 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -36,7 +36,7 @@ module MOM_PressureForce_AFV type, public :: PressureForce_AFV_CS ; private logical :: tides !< If true, apply tidal momentum forcing. real :: Rho0 !< The density used in the Boussinesq - !! approximation [kg m-3]. + !! approximation [R ~> kg m-3]. real :: GFS_scale !< A scaling of the surface pressure gradients to !! allow the use of a reduced gravity model [nondim]. type(time_type), pointer :: Time !< A pointer to the ocean model's clock. @@ -74,10 +74,10 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface [Pa]. + !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. @@ -110,15 +110,15 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface [Pa]. + !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. @@ -131,11 +131,11 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p T_b ! of temperature within each layer [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dza, & ! The change in geopotential anomaly between the top and bottom - ! of a layer [m2 s-2]. + ! of a layer [L2 T-2 ~> m2 s-2]. intp_dza ! The vertical integral in depth of the pressure anomaly less - ! the pressure anomaly at the top of the layer [Pa m2 s-2]. + ! the pressure anomaly at the top of the layer [R L4 Z-4 ~> Pa m2 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & - dp, & ! The (positive) change in pressure across a layer [Pa]. + dp, & ! The (positive) change in pressure across a layer [R L2 Z-2 ~> Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. @@ -148,41 +148,42 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p ! density near-surface layer [R ~> kg m-3]. real, dimension(SZIB_(G),SZJ_(G)) :: & intx_za ! The zonal integral of the geopotential anomaly along the - ! interface below a layer, divided by the grid spacing [m2 s-2]. + ! interface below a layer, divided by the grid spacing [L2 T-2 ~> m2 s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & - intx_dza ! The change in intx_za through a layer [m2 s-2]. + intx_dza ! The change in intx_za through a layer [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJB_(G)) :: & inty_za ! The meridional integral of the geopotential anomaly along the - ! interface below a layer, divided by the grid spacing [m2 s-2]. + ! interface below a layer, divided by the grid spacing [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & - inty_dza ! The change in inty_za through a layer [m2 s-2]. + inty_dza ! The change in inty_za through a layer [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density, [Pa] (usually 2e7 Pa = 2000 dbar). + ! density, [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). real :: dp_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [Pa]. - real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: I_gEarth ! The inverse of g_Earth_z [s2 Z m-2 ~> s2 m-1] + ! in roundoff and can be neglected [R L2 T-2 ~> Pa]. + real :: I_gEarth ! The inverse of GV%g_Earth [L2 Z L-2 ~> s2 m-1] real :: alpha_anom ! The in-situ specific volume, averaged over a - ! layer, less alpha_ref [m3 kg-1]. + ! layer, less alpha_ref [R-1 ~> m3 kg-1]. logical :: use_p_atm ! If true, use the atmospheric pressure. 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. + 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 :: alpha_ref ! A reference specific volume [m3 kg-1], that is used - ! to reduce the impact of truncation errors. - real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. - real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). + real :: alpha_ref ! A reference specific volume [R-1 ~> m3 kg-1] that is used + ! to reduce the impact of truncation errors. + real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. + real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H) [H T2 R-1 L-2 ~> H Pa-1]. + real :: H_to_RL2_T2 ! A factor to convert from thicknesss units (H) to pressure units [R L2 T-2 H-1 ~> Pa H-1]. ! real :: oneatm = 101325.0 ! 1 atm in [Pa] = [kg m-1 s-2] real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke nkmb=GV%nk_rho_varies Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_AFV_nonBouss: Module must be initialized before it is used.") @@ -193,10 +194,10 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p use_ALE = .false. if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS - dp_neglect = GV%H_to_Pa * GV%H_subroundoff - alpha_ref = 1.0/CS%Rho0 - g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth - I_gEarth = 1.0 / g_Earth_z + H_to_RL2_T2 = GV%g_Earth*GV%H_to_RZ + dp_neglect = GV%g_Earth*GV%H_to_RZ * GV%H_subroundoff + alpha_ref = 1.0 / CS%Rho0 + I_gEarth = 1.0 / GV%g_Earth if (use_p_atm) then !$OMP parallel do default(shared) @@ -211,7 +212,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=2,nz+1 ; do i=Isq,Ieq+1 - p(i,j,K) = p(i,j,K-1) + GV%H_to_Pa * h(i,j,k-1) + p(i,j,K) = p(i,j,K-1) + H_to_RL2_T2 * h(i,j,k-1) enddo ; enddo ; enddo if (use_EOS) then @@ -228,8 +229,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo - call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then tv_tmp%T(i,j,k) = tv%T(i,j,nkmb) ; tv_tmp%S(i,j,k) = tv%S(i,j,nkmb) @@ -263,13 +264,10 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p if (use_EOS) then if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then - call int_spec_vol_dp_generic_plm( T_t(:,:,k), T_b(:,:,k), & - S_t(:,:,k), S_b(:,:,k), p(:,:,K), p(:,:,K+1), & - alpha_ref, dp_neglect, p(:,:,nz+1), G%HI, & - tv%eqn_of_state, dza(:,:,k), intp_dza(:,:,k), & - intx_dza(:,:,k), inty_dza(:,:,k), & - useMassWghtInterp = CS%useMassWghtInterp) - i=k + call int_spec_vol_dp_generic_plm( T_t(:,:,k), T_b(:,:,k), S_t(:,:,k), S_b(:,:,k), & + p(:,:,K), p(:,:,K+1), alpha_ref, dp_neglect, p(:,:,nz+1), G%HI, & + tv%eqn_of_state, dza(:,:,k), intp_dza(:,:,k), intx_dza(:,:,k), inty_dza(:,:,k), & + useMassWghtInterp=CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call MOM_error(FATAL, "PressureForce_AFV_nonBouss: "//& "int_spec_vol_dp_generic_ppm does not exist yet.") @@ -283,12 +281,12 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p p(:,:,K+1), alpha_ref, G%HI, tv%eqn_of_state, & dza(:,:,k), intp_dza(:,:,k), intx_dza(:,:,k), & inty_dza(:,:,k), bathyP=p(:,:,nz+1), dP_tiny=dp_neglect, & - useMassWghtInterp = CS%useMassWghtInterp) + useMassWghtInterp=CS%useMassWghtInterp) endif else - alpha_anom = 1.0/(US%R_to_kg_m3*GV%Rlay(k)) - alpha_ref + alpha_anom = 1.0 / GV%Rlay(k) - alpha_ref do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dp(i,j) = GV%H_to_Pa * h(i,j,k) + dp(i,j) = H_to_RL2_T2 * h(i,j,k) dza(i,j,k) = alpha_anom * dp(i,j) intp_dza(i,j,k) = 0.5 * alpha_anom * dp(i,j)**2 enddo ; enddo @@ -312,7 +310,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - g_Earth_z*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -328,7 +326,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j) + za(i,j) = za(i,j) - GV%g_Earth * e_tidal(i,j) enddo ; enddo endif @@ -337,19 +335,17 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p if (use_EOS) then !$OMP parallel do default(shared) private(rho_in_situ) do j=Jsq,Jeq+1 - call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), & - rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), rho_in_situ, & + tv%eqn_of_state, EOSdom) do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & - (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) + dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & - (p(i,j,1)*(1.0/(US%R_to_kg_m3*GV%Rlay(1)) - alpha_ref) + za(i,j)) + dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) enddo ; enddo endif ! else @@ -374,28 +370,26 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p ! a set of idealized cases, and should be bug-free. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dp(i,j) = GV%H_to_Pa*h(i,j,k) + dp(i,j) = H_to_RL2_T2 * h(i,j,k) za(i,j) = za(i,j) - dza(i,j,k) enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do I=Isq,Ieq intx_za(I,j) = intx_za(I,j) - intx_dza(I,j,k) - PFu(I,j,k) = (((za(i,j)*dp(i,j) + intp_dza(i,j,k)) - & - (za(i+1,j)*dp(i+1,j) + intp_dza(i+1,j,k))) + & - ((dp(i+1,j) - dp(i,j)) * intx_za(I,j) - & - (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (US%m_s_to_L_T**2 * 2.0*G%IdxCu(I,j) / & - ((dp(i,j) + dp(i+1,j)) + dp_neglect)) + PFu(I,j,k) = ( ((za(i,j)*dp(i,j) + intp_dza(i,j,k)) - & + (za(i+1,j)*dp(i+1,j) + intp_dza(i+1,j,k))) + & + ((dp(i+1,j) - dp(i,j)) * intx_za(I,j) - & + (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k)) ) * & + (2.0*G%IdxCu(I,j) / ((dp(i,j) + dp(i+1,j)) + dp_neglect)) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie inty_za(i,J) = inty_za(i,J) - inty_dza(i,J,k) PFv(i,J,k) = (((za(i,j)*dp(i,j) + intp_dza(i,j,k)) - & - (za(i,j+1)*dp(i,j+1) + intp_dza(i,j+1,k))) + & - ((dp(i,j+1) - dp(i,j)) * inty_za(i,J) - & - (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (US%m_s_to_L_T**2 * 2.0*G%IdyCv(i,J) / & - ((dp(i,j) + dp(i,j+1)) + dp_neglect)) + (za(i,j+1)*dp(i,j+1) + intp_dza(i,j+1,k))) + & + ((dp(i,j+1) - dp(i,j)) * inty_za(i,J) - & + (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & + (2.0*G%IdyCv(i,J) / ((dp(i,j) + dp(i,j+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then @@ -416,7 +410,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p endif if (present(eta)) then - Pa_to_H = 1.0 / GV%H_to_Pa + Pa_to_H = 1.0 / (GV%g_Earth * GV%H_to_RZ) if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -453,10 +447,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface [Pa]. + !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any !! tidal contributions or compressibility compensation. @@ -471,22 +465,21 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [R ~> kg m-3]. real, dimension(SZI_(G),SZJ_(G)) :: & - dz_geo, & ! The change in geopotential thickness through a layer times some dimensional - ! rescaling factors [kg m-1 R-1 s-2 ~> m2 s-2]. + dz_geo, & ! The change in geopotential thickness through a layer [L2 T-2 ~> m2 s-2]. pa, & ! The pressure anomaly (i.e. pressure + g*RHO_0*e) at the - ! the interface atop a layer [Pa]. + ! the interface atop a layer [R L2 T-2 ~> Pa]. dpa, & ! The change in pressure anomaly between the top and bottom - ! of a layer [Pa]. + ! of a layer [R L2 T-2 ~> Pa]. intz_dpa ! The vertical integral in depth of the pressure anomaly less the - ! pressure anomaly at the top of the layer [H Pa ~> m Pa or kg m-2 Pa]. + ! pressure anomaly at the top of the layer [H R L2 T-2 ~> m Pa or kg m-2 Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & intx_pa, & ! The zonal integral of the pressure anomaly along the interface - ! atop a layer, divided by the grid spacing [Pa]. - intx_dpa ! The change in intx_pa through a layer [Pa]. + ! atop a layer, divided by the grid spacing [R L2 T-2 ~> Pa]. + intx_dpa ! The change in intx_pa through a layer [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJB_(G)) :: & inty_pa, & ! The meridional integral of the pressure anomaly along the - ! interface atop a layer, divided by the grid spacing [Pa]. - inty_dpa ! The change in inty_pa through a layer [Pa]. + ! interface atop a layer, divided by the grid spacing [R L2 T-2 ~> Pa]. + inty_dpa ! The change in inty_pa through a layer [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter @@ -498,16 +491,13 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at ! of salinity and temperature within each layer. 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, [Pa] (usually 2e7 Pa = 2000 dbar). - real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. + ! density, [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). + real :: p0(SZI_(G)) ! An array of zeros to use for pressure [R L2 T-2 ~> Pa]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m]. - real :: g_Earth_mks_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: g_Earth_z_geo ! Another scaled version of g_Earth [R m5 kg-1 Z-1 s-2 ~> m s-2]. - real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. + real :: I_Rho0 ! The inverse of the Boussinesq reference density [R-1 ~> m3 kg-1]. real :: G_Rho0 ! G_Earth / Rho0 in [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. - real :: Rho_ref ! The reference density [R ~> kg m-3]. - real :: Rho_ref_mks ! The reference density in mks units [kg m-3]. + real :: rho_ref ! The reference density [R ~> kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. @@ -515,12 +505,14 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. real, parameter :: C1_6 = 1.0/6.0 + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke nkmb=GV%nk_rho_varies Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_AFV_Bouss: Module must be initialized before it is used.") @@ -534,12 +526,9 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z - I_Rho0 = US%m_s_to_L_T**2 / (US%R_to_kg_m3*GV%Rho0) - g_Earth_mks_z = US%L_T_to_m_s**2 * GV%g_Earth - g_Earth_z_geo = US%R_to_kg_m3*US%L_T_to_m_s**2 * GV%g_Earth + I_Rho0 = 1.0 / GV%Rho0 G_Rho0 = GV%g_Earth / GV%Rho0 - rho_ref_mks = CS%Rho0 - rho_ref = rho_ref_mks*US%kg_m3_to_R + rho_ref = CS%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -591,8 +580,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo - call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -615,10 +604,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at do j=Jsq,Jeq+1 if (use_p_atm) then call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), rho_in_situ, & - Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + tv%eqn_of_state, EOSdom) else call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, & - Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + tv%eqn_of_state, EOSdom) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) @@ -651,12 +640,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*g_Earth_z_geo)*e(i,j,1) + p_atm(i,j) + pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*g_Earth_z_geo)*e(i,j,1) + pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) enddo ; enddo endif !$OMP parallel do default(shared) @@ -680,24 +669,20 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at ! where the layers are located. if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then - call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & - S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref_mks, CS%Rho0, g_Earth_mks_z, & - dz_neglect, G%bathyT, G%HI, G%HI, & - tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & - useMassWghtInterp = CS%useMassWghtInterp) + call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), S_t(:,:,k), S_b(:,:,k),& + e(:,:,K), e(:,:,K+1), rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & + G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & + useMassWghtInterp=CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref_mks, CS%Rho0, g_Earth_mks_z, & - G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & - intx_dpa, inty_dpa) + rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, dpa, & + intz_dpa, intx_dpa, inty_dpa) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref_mks, CS%Rho0, g_Earth_mks_z, G%HI, G%HI, tv%eqn_of_state, & - dpa, intz_dpa, intx_dpa, inty_dpa, & - G%bathyT, dz_neglect, CS%useMassWghtInterp) + rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, dpa, & + intz_dpa, intx_dpa, inty_dpa, G%bathyT, dz_neglect, CS%useMassWghtInterp) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -706,7 +691,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dz_geo(i,j) = g_Earth_z_geo * GV%H_to_Z*h(i,j,k) + dz_geo(i,j) = GV%g_Earth * GV%H_to_Z*h(i,j,k) dpa(i,j) = (GV%Rlay(k) - rho_ref) * dz_geo(i,j) intz_dpa(i,j) = 0.5*(GV%Rlay(k) - rho_ref) * dz_geo(i,j)*h(i,j,k) enddo ; enddo @@ -767,15 +752,14 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at if (present(eta)) then if (CS%tides) then - ! eta is the sea surface height relative to a time-invariant geoid, for - ! comparison with what is used for eta in btstep. See how e was calculated - ! about 200 lines above. - !$OMP parallel do default(shared) + ! eta is the sea surface height relative to a time-invariant geoid, for comparison with + ! what is used for eta in btstep. See how e was calculated about 200 lines above. + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else - !$OMP parallel do default(shared) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo @@ -819,7 +803,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_C "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) call get_param(param_file, "MOM", "USE_REGRIDDING", use_ALE, & diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index faa7912f1e..ab0c665f7a 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -36,7 +36,7 @@ module MOM_PressureForce_blk_AFV type, public :: PressureForce_blk_AFV_CS ; private logical :: tides !< If true, apply tidal momentum forcing. real :: Rho0 !< The density used in the Boussinesq - !! approximation [kg m-3]. + !! approximation [R ~> kg m-3]. real :: GFS_scale !< A scaling of the surface pressure gradients to !! allow the use of a reduced gravity model [nondim]. type(time_type), pointer :: Time !< A pointer to the ocean model's clock. @@ -74,10 +74,10 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface [Pa]. + !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. @@ -109,15 +109,15 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface [Pa]. + !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. @@ -125,55 +125,55 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, ! than the mixed layer have the mixed layer's properties [ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dza, & ! The change in geopotential anomaly between the top and bottom - ! of a layer [m2 s-2]. + ! of a layer [L2 T-2 ~> m2 s-2]. intp_dza ! The vertical integral in depth of the pressure anomaly less - ! the pressure anomaly at the top of the layer [Pa m2 s-2]. + ! the pressure anomaly at the top of the layer [R L4 T-4 ~> Pa m2 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & - dp, & ! The (positive) change in pressure across a layer [Pa]. + dp, & ! The (positive) change in pressure across a layer [R L2 T-2 ~> Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the - ! interface atop a layer [m2 s-2]. + ! interface atop a layer [L2 T-2 ~> m2 s-2]. real, dimension(SZDI_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices - dp_bk, & ! The (positive) change in pressure across a layer [Pa]. + dp_bk, & ! The (positive) change in pressure across a layer [R L2 T-2 ~> Pa]. za_bk ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the - ! interface atop a layer [m2 s-2]. + ! interface atop a layer [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [R ~> kg m-3]. real, dimension(SZDIB_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices intx_za_bk ! The zonal integral of the geopotential anomaly along the - ! interface below a layer, divided by the grid spacing [m2 s-2]. + ! interface below a layer, divided by the grid spacing [L2 T-2 ~> m2 s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & - intx_dza ! The change in intx_za through a layer [m2 s-2]. + intx_dza ! The change in intx_za through a layer [L2 T-2 ~> m2 s-2]. real, dimension(SZDI_(G%Block(1)),SZDJB_(G%Block(1))) :: & ! on block indices inty_za_bk ! The meridional integral of the geopotential anomaly along the - ! interface below a layer, divided by the grid spacing [m2 s-2]. + ! interface below a layer, divided by the grid spacing [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & - inty_dza ! The change in inty_za through a layer [m2 s-2]. + inty_dza ! The change in inty_za through a layer [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density [Pa] (usually 2e7 Pa = 2000 dbar). + ! density [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). real :: dp_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [Pa]. - real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: I_gEarth ! The inverse of g_Earth_z [s2 Z m-2 ~> s2 m-1] + ! in roundoff and can be neglected [R L2 T-2 ~> Pa]. + real :: I_gEarth ! The inverse of GV%g_Earth [L2 Z L-2 ~> s2 m-1] real :: alpha_anom ! The in-situ specific volume, averaged over a - ! layer, less alpha_ref [m3 kg-1]. + ! layer, less alpha_ref [R-1 ~> 3 kg-1]. logical :: use_p_atm ! If true, use the atmospheric pressure. - logical :: use_EOS ! If true, density is calculated from T & S using an - ! equation of state. + logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: alpha_ref ! A reference specific volume [m3 kg-1], that is used - ! to reduce the impact of truncation errors. - real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. - real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). + real :: alpha_ref ! A reference specific volume [R-1 ~> m3 kg-1] that is used + ! to reduce the impact of truncation errors. + real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. + real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H) [H T2 R-1 L-2 ~> H Pa-1]. + real :: H_to_RL2_T2 ! A factor to convert from thicknesss units (H) to pressure units [R L2 T-2 H-1 ~> Pa H-1]. ! real :: oneatm = 101325.0 ! 1 atm in [Pa] = [kg m-1 s-2] real, parameter :: C1_6 = 1.0/6.0 + integer, dimension(2) :: EOSdom ! The computational domain for the equation of state integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: is_bk, ie_bk, js_bk, je_bk, Isq_bk, Ieq_bk, Jsq_bk, Jeq_bk integer :: i, j, k, n, ib, jb, ioff_bk, joff_bk @@ -181,6 +181,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke nkmb=GV%nk_rho_varies Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_AFV_nonBouss: Module must be initialized before it is used.") @@ -189,10 +190,10 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif use_EOS = associated(tv%eqn_of_state) - dp_neglect = GV%H_to_Pa * GV%H_subroundoff - alpha_ref = 1.0/CS%Rho0 - g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth - I_gEarth = 1.0 / g_Earth_z + H_to_RL2_T2 = GV%g_Earth*GV%H_to_RZ + dp_neglect = GV%g_Earth*GV%H_to_RZ * GV%H_subroundoff + alpha_ref = 1.0 / CS%Rho0 + I_gEarth = 1.0 / GV%g_Earth if (use_p_atm) then !$OMP parallel do default(shared) @@ -207,7 +208,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=2,nz+1 ; do i=Isq,Ieq+1 - p(i,j,K) = p(i,j,K-1) + GV%H_to_Pa * h(i,j,k-1) + p(i,j,K) = p(i,j,K-1) + H_to_RL2_T2 * h(i,j,k-1) enddo ; enddo ; enddo if (use_EOS) then @@ -224,8 +225,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo - call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then tv_tmp%T(i,j,k) = tv%T(i,j,nkmb) ; tv_tmp%S(i,j,k) = tv%S(i,j,nkmb) @@ -249,11 +250,11 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, p(:,:,K+1), alpha_ref, G%HI, tv%eqn_of_state, & dza(:,:,k), intp_dza(:,:,k), intx_dza(:,:,k), & inty_dza(:,:,k), bathyP=p(:,:,nz+1), dP_tiny=dp_neglect, & - useMassWghtInterp = CS%useMassWghtInterp) + useMassWghtInterp=CS%useMassWghtInterp) else - alpha_anom = 1.0/(US%R_to_kg_m3*GV%Rlay(k)) - alpha_ref + alpha_anom = 1.0 / GV%Rlay(k) - alpha_ref do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dp(i,j) = GV%H_to_Pa * h(i,j,k) + dp(i,j) = H_to_RL2_T2 * h(i,j,k) dza(i,j,k) = alpha_anom * dp(i,j) intp_dza(i,j,k) = 0.5 * alpha_anom * dp(i,j)**2 enddo ; enddo @@ -277,7 +278,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - g_Earth_z*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -293,7 +294,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j) + za(i,j) = za(i,j) - GV%g_Earth * e_tidal(i,j) enddo ; enddo endif @@ -302,19 +303,17 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, if (use_EOS) then !$OMP parallel do default(shared) private(rho_in_situ) do j=Jsq,Jeq+1 - call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), & - rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), rho_in_situ, & + tv%eqn_of_state, EOSdom) do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * & - US%m_s_to_L_T**2*(p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) + dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * & - US%m_s_to_L_T**2*(p(i,j,1)*(1.0/(US%R_to_kg_m3*GV%Rlay(1)) - alpha_ref) + za(i,j)) + dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) enddo ; enddo endif ! else @@ -326,8 +325,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, ! linearly between the values at thickness points, but the bottom ! geopotentials will not now be linear at the sub-grid-scale. Doing this ! ensures no motion with flat isopycnals, even with a nonlinear equation of state. -!$OMP parallel do default(none) shared(nz,za,G,GV,dza,intx_dza,h,PFu, & -!$OMP intp_dza,p,dp_neglect,inty_dza,PFv,CS,dM,US) & +!$OMP parallel do default(none) shared(nz,za,G,GV,dza,intx_dza,h,PFu,PFv,CS,dM,US, & +!$OMP intp_dza,p,dp_neglect,inty_dza,H_to_RL2_T2) & !$OMP private(is_bk,ie_bk,js_bk,je_bk,Isq_bk,Ieq_bk,Jsq_bk, & !$OMP Jeq_bk,ioff_bk,joff_bk,i,j,za_bk,intx_za_bk, & !$OMP inty_za_bk,dp_bk) @@ -355,28 +354,26 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, ! a set of idealized cases, and should be bug-free. do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - dp_bk(ib,jb) = GV%H_to_Pa*h(i,j,k) + dp_bk(ib,jb) = H_to_RL2_T2*h(i,j,k) za_bk(ib,jb) = za_bk(ib,jb) - dza(i,j,k) enddo ; enddo do jb=js_bk,je_bk ; do Ib=Isq_bk,Ieq_bk I = Ib+ioff_bk ; j = jb+joff_bk intx_za_bk(Ib,jb) = intx_za_bk(Ib,jb) - intx_dza(I,j,k) - PFu(I,j,k) = (((za_bk(ib,jb)*dp_bk(ib,jb) + intp_dza(i,j,k)) - & - (za_bk(ib+1,jb)*dp_bk(ib+1,jb) + intp_dza(i+1,j,k))) + & - ((dp_bk(ib+1,jb) - dp_bk(ib,jb)) * intx_za_bk(Ib,jb) - & - (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (US%m_s_to_L_T**2 * 2.0*G%IdxCu(I,j) / & - ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + dp_neglect)) + PFu(I,j,k) = ( ((za_bk(ib,jb)*dp_bk(ib,jb) + intp_dza(i,j,k)) - & + (za_bk(ib+1,jb)*dp_bk(ib+1,jb) + intp_dza(i+1,j,k))) + & + ((dp_bk(ib+1,jb) - dp_bk(ib,jb)) * intx_za_bk(Ib,jb) - & + (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k)) ) * & + (2.0*G%IdxCu(I,j) / ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + dp_neglect)) enddo ; enddo do Jb=Jsq_bk,Jeq_bk ; do ib=is_bk,ie_bk i = ib+ioff_bk ; J = Jb+joff_bk inty_za_bk(ib,Jb) = inty_za_bk(ib,Jb) - inty_dza(i,J,k) - PFv(i,J,k) = (((za_bk(ib,jb)*dp_bk(ib,jb) + intp_dza(i,j,k)) - & - (za_bk(ib,jb+1)*dp_bk(ib,jb+1) + intp_dza(i,j+1,k))) + & - ((dp_bk(ib,jb+1) - dp_bk(ib,jb)) * inty_za_bk(ib,Jb) - & - (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (US%m_s_to_L_T**2 * 2.0*G%IdyCv(i,J) / & - ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + dp_neglect)) + PFv(i,J,k) = ( ((za_bk(ib,jb)*dp_bk(ib,jb) + intp_dza(i,j,k)) - & + (za_bk(ib,jb+1)*dp_bk(ib,jb+1) + intp_dza(i,j+1,k))) + & + ((dp_bk(ib,jb+1) - dp_bk(ib,jb)) * inty_za_bk(ib,Jb) - & + (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k)) ) * & + (2.0*G%IdyCv(i,J) / ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then @@ -396,7 +393,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, endif if (present(eta)) then - Pa_to_H = 1.0 / GV%H_to_Pa + Pa_to_H = 1.0 / (GV%g_Earth * GV%H_to_RZ) if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -434,10 +431,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface [Pa]. + !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. @@ -452,22 +449,21 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [R ~> kg m-3]. real, dimension(SZDI_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices - dz_bk, & ! The change in geopotential thickness through a layer times some dimensional - ! rescaling factors [kg m-1 R-1 s-2 ~> m2 s-2]. + dz_bk, & ! The change in geopotential thickness through a layer [L2 T-2 ~> m2 s-2]. pa_bk, & ! The pressure anomaly (i.e. pressure + g*RHO_0*e) at the - ! the interface atop a layer [Pa]. + ! the interface atop a layer [R L2 T-2 ~> Pa]. dpa_bk, & ! The change in pressure anomaly between the top and bottom - ! of a layer [Pa]. + ! of a layer [R L2 T-2 ~> Pa]. intz_dpa_bk ! The vertical integral in depth of the pressure anomaly less the - ! pressure anomaly at the top of the layer [H Pa ~> m Pa or kg m-2 Pa]. + ! pressure anomaly at the top of the layer [H R L2 T-2 ~> m Pa or kg m-2 Pa]. real, dimension(SZDIB_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices intx_pa_bk, & ! The zonal integral of the pressure anomaly along the interface - ! atop a layer, divided by the grid spacing [Pa]. - intx_dpa_bk ! The change in intx_pa through a layer [Pa]. + ! atop a layer, divided by the grid spacing [R L2 T-2 ~> Pa]. + intx_dpa_bk ! The change in intx_pa through a layer [R L2 T-2 ~> Pa]. real, dimension(SZDI_(G%Block(1)),SZDJB_(G%Block(1))) :: & ! on block indices inty_pa_bk, & ! The meridional integral of the pressure anomaly along the - ! interface atop a layer, divided by the grid spacing [Pa]. - inty_dpa_bk ! The change in inty_pa through a layer [Pa]. + ! interface atop a layer, divided by the grid spacing [R L2 T-2 ~> Pa]. + inty_dpa_bk ! The change in inty_pa through a layer [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter @@ -479,16 +475,13 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, T_t, T_b ! Top and bottom edge temperatures for linear reconstructions within each layer [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 [Pa] (usually 2e7 Pa = 2000 dbar). - real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. + ! density [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). + real :: p0(SZI_(G)) ! An array of zeros to use for pressure [R L2 T-2 ~> Pa]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. - real :: g_Earth_mks_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: g_Earth_z_geo ! Another scaled version of g_Earth [R m5 kg-1 Z-1 s-2 ~> m s-2]. + real :: I_Rho0 ! The inverse of the Boussinesq reference density [R-1 ~> m3 kg-1]. real :: G_Rho0 ! G_Earth / Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. - real :: Rho_ref ! The reference density [R-1 ~> kg m-3]. - real :: Rho_ref_mks ! The reference density in mks units [kg m-3]. + real :: rho_ref ! The reference density [R ~> kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. @@ -497,6 +490,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. real, parameter :: C1_6 = 1.0/6.0 + integer, dimension(2) :: EOSdom ! The computational domain for the equation of state integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: is_bk, ie_bk, js_bk, je_bk, Isq_bk, Ieq_bk, Jsq_bk, Jeq_bk integer :: ioff_bk, joff_bk @@ -505,6 +499,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke nkmb=GV%nk_rho_varies Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_AFV_Bouss: Module must be initialized before it is used.") @@ -518,12 +513,9 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z - I_Rho0 = US%m_s_to_L_T**2 / (US%R_to_kg_m3*GV%Rho0) - g_Earth_mks_z = US%L_T_to_m_s**2 * GV%g_Earth - g_Earth_z_geo = US%R_to_kg_m3*US%L_T_to_m_s**2 * GV%g_Earth + I_Rho0 = 1.0 / GV%Rho0 G_Rho0 = GV%g_Earth / GV%Rho0 - Rho_ref_mks = CS%Rho0 - Rho_ref = Rho_ref_mks*US%kg_m3_to_R + rho_ref = CS%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -575,8 +567,8 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) enddo ; enddo - call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, & - Rho_cv_BL(:), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -598,11 +590,11 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, !$OMP parallel do default(shared) do j=Jsq,Jeq+1 if (use_p_atm) then - call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), & - rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), rho_in_situ, & + tv%eqn_of_state, EOSdom) else - call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, & - rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, & + tv%eqn_of_state, EOSdom) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) @@ -629,9 +621,9 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, endif endif -!$OMP parallel do default(none) shared(use_p_atm,Rho_ref,Rho_ref_mks,G,GV,e,p_atm,nz,use_EOS,& -!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp,g_Earth_z_geo, & -!$OMP g_Earth_mks_z,h,PFu,I_Rho0,h_neglect,dz_neglect,PFv,dM)& +!$OMP parallel do default(none) shared(use_p_atm,rho_ref,G,GV,US,e,p_atm,nz,use_EOS,& +!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp, & +!$OMP h,PFu,I_Rho0,h_neglect,dz_neglect,PFv,dM)& !$OMP private(is_bk,ie_bk,js_bk,je_bk,Isq_bk,Ieq_bk,Jsq_bk, & !$OMP Jeq_bk,ioff_bk,joff_bk,pa_bk, & !$OMP intx_pa_bk,inty_pa_bk,dpa_bk,intz_dpa_bk, & @@ -650,12 +642,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, if (use_p_atm) then do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (Rho_ref*g_Earth_z_geo)*e(i,j,1) + p_atm(i,j) + pa_bk(ib,jb) = (Rho_ref*GV%g_Earth)*e(i,j,1) + p_atm(i,j) enddo ; enddo else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (Rho_ref*g_Earth_z_geo)*e(i,j,1) + pa_bk(ib,jb) = (Rho_ref*GV%g_Earth)*e(i,j,1) enddo ; enddo endif do jb=js_bk,je_bk ; do Ib=Isq_bk,Ieq_bk @@ -677,22 +669,19 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ! where the layers are located. if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then - call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & - S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - Rho_ref_mks, CS%Rho0, g_Earth_mks_z, & - dz_neglect, G%bathyT, G%HI, G%Block(n), & - tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & - useMassWghtInterp = CS%useMassWghtInterp) + call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), S_t(:,:,k), S_b(:,:,k), & + e(:,:,K), e(:,:,K+1), rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, G%HI, & + G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & + useMassWghtInterp=CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & - tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - Rho_ref_mks, CS%Rho0, g_Earth_mks_z, & - G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, & + tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), rho_ref, CS%Rho0, & + GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, & intx_dpa_bk, inty_dpa_bk) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - Rho_ref_mks, CS%Rho0, g_Earth_mks_z, G%HI, G%Block(n), tv%eqn_of_state, & + rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & G%bathyT, dz_neglect, CS%useMassWghtInterp) endif @@ -702,7 +691,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - dz_bk(ib,jb) = g_Earth_z_geo*GV%H_to_Z*h(i,j,k) + dz_bk(ib,jb) = GV%g_Earth*GV%H_to_Z*h(i,j,k) dpa_bk(ib,jb) = (GV%Rlay(k) - Rho_ref)*dz_bk(ib,jb) intz_dpa_bk(ib,jb) = 0.5*(GV%Rlay(k) - Rho_ref) * dz_bk(ib,jb)*h(i,j,k) enddo ; enddo @@ -759,15 +748,14 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, if (present(eta)) then if (CS%tides) then - ! eta is the sea surface height relative to a time-invariant geoid, for - ! comparison with what is used for eta in btstep. See how e was calculated - ! about 200 lines above. - !$OMP parallel do default(shared) + ! eta is the sea surface height relative to a time-invariant geoid, for comparison with + ! what is used for eta in btstep. See how e was calculated about 200 lines above. + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else - !$OMP parallel do default(shared) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo @@ -811,7 +799,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, US, param_file, diag, CS, tid "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) call get_param(param_file, "MOM", "USE_REGRIDDING", use_ALE, & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 62cff69a8c..2517846b4c 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -250,10 +250,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s type(time_type), intent(in) :: Time_local !< model time at end of time step real, intent(in) :: dt !< time step [T ~> s] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic - !! time step [Pa] - real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic - !! time step [Pa] + real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at the start of this dynamic + !! time step [R L2 T-2 ~> Pa] + real, dimension(:,:), pointer :: p_surf_end !< surf pressure at the end of this dynamic + !! time step [R L2 T-2 ~> Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & target, intent(inout) :: uh !< zonal volume/mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -306,7 +306,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are ! saved for use in the Flather open boundary condition code [L T-1 ~> m s-1]. - real :: Pa_to_eta ! A factor that converts pressures to the units of eta. + real :: pres_to_eta ! A factor that converts pressures to the units of eta + ! [H T2 R-1 L-2 ~> m Pa-1 or kg m-2 Pa-1] real, pointer, dimension(:,:) :: & p_surf => NULL(), eta_PF_start => NULL(), & taux_bot => NULL(), tauy_bot => NULL(), & @@ -413,11 +414,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call PressureForce(h, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) if (dyn_p_surf) then - Pa_to_eta = 1.0 / GV%H_to_Pa + pres_to_eta = 1.0 / (GV%g_Earth * GV%H_to_RZ) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_PF_start(i,j) = CS%eta_PF(i,j) - Pa_to_eta * & - (p_surf_begin(i,j) - p_surf_end(i,j)) + eta_PF_start(i,j) = CS%eta_PF(i,j) - pres_to_eta * (p_surf_begin(i,j) - p_surf_end(i,j)) enddo ; enddo endif call cpu_clock_end(id_clock_pres) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index a5671948b1..8c6e7d4299 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -200,9 +200,9 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, intent(in) :: dt !< The dynamics time step [T ~> s]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface - !! pressure at the start of this dynamic step [Pa]. + !! pressure at the start of this dynamic step [R L2 T-2 ~> Pa]. real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface - !! pressure at the end of this dynamic step [Pa]. + !! pressure at the end of this dynamic step [R L2 T-2 ~> Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index e88b7c32dc..d3adfaa194 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -209,10 +209,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to !! the surface pressure at the beginning - !! of this dynamic step [Pa]. + !! of this dynamic step [R L2 T-2 ~> Pa]. real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to !! the surface pressure at the end of - !! this dynamic step [Pa]. + !! this dynamic step [R L2 T-2 ~> Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 2f3d0d1b5f..73efeec927 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -10,7 +10,7 @@ module MOM_forcing_type use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_alloc, query_averaging_enabled use MOM_diag_mediator, only : enable_averages, enable_averaging, disable_averaging use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_EOS, only : calculate_density_derivs +use MOM_EOS, only : calculate_density_derivs, EOS_domain use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_opacity, only : sumSWoverBands, optics_type, extract_optics_slice, optics_nbands @@ -132,13 +132,13 @@ module MOM_forcing_type ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: p_surf_full => NULL() - !< Pressure at the top ocean interface [Pa]. + !< Pressure at the top ocean interface [R L2 T-2 ~> Pa]. !! if there is sea-ice, then p_surf_flux is at ice-ocean interface real, pointer, dimension(:,:) :: p_surf => NULL() - !< Pressure at the top ocean interface [Pa] as used to drive the ocean model. + !< Pressure at the top ocean interface [R L2 T-2 ~> Pa] as used to drive the ocean model. !! If p_surf is limited, p_surf may be smaller than p_surf_full, otherwise they are the same. real, pointer, dimension(:,:) :: p_surf_SSH => NULL() - !< Pressure at the top ocean interface [Pa] that is used in corrections to the sea surface + !< Pressure at the top ocean interface [R L2 T-2 ~> Pa] that is used in corrections to the sea surface !! height field that is passed back to the calling routines. !! p_surf_SSH may point to p_surf or to p_surf_full. logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere @@ -211,14 +211,14 @@ module MOM_forcing_type ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: p_surf_full => NULL() - !< Pressure at the top ocean interface [Pa]. + !< Pressure at the top ocean interface [R L2 T-2 ~> Pa]. !! if there is sea-ice, then p_surf_flux is at ice-ocean interface real, pointer, dimension(:,:) :: p_surf => NULL() - !< Pressure at the top ocean interface [Pa] as used to drive the ocean model. + !< Pressure at the top ocean interface [R L2 T-2 ~> Pa] as used to drive the ocean model. !! If p_surf is limited, p_surf may be smaller than p_surf_full, otherwise they are the same. real, pointer, dimension(:,:) :: p_surf_SSH => NULL() - !< Pressure at the top ocean interface that is used in corrections to the sea surface - !! height field that is passed back to the calling routines. + !< Pressure at the top ocean interface [R L2 T-2 ~> Pa] that is used in corrections + !! to the sea surface height field that is passed back to the calling routines. !! p_surf_SSH may point to p_surf or to p_surf_full. ! iceberg related inputs @@ -867,10 +867,7 @@ subroutine extractFluxes2d(G, GV, US, fluxes, optics, nsw, dt, FluxRescaleDepth, logical, intent(in) :: aggregate_FW !< For determining how to aggregate the forcing. integer :: j -!$OMP parallel do default(none) shared(G, GV, US, fluxes, optics, nsw, dt, FluxRescaleDepth, & -!$OMP useRiverHeatContent, useCalvingHeatContent, & -!$OMP h,T,netMassInOut,netMassOut,Net_heat,Net_salt,Pen_SW_bnd,tv, & -!$OMP aggregate_FW) + !$OMP parallel do default(shared) do j=G%jsc, G%jec call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent,& @@ -907,7 +904,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables - integer :: start, npts, k + integer :: k real, parameter :: dt = 1. ! to return a rate from extractFluxes1d real, dimension(SZI_(G)) :: netH ! net FW flux [H s-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G)) :: netEvap ! net FW flux leaving ocean via evaporation @@ -915,7 +912,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt real, dimension(SZI_(G)) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band ! [degC H ~> degC m or degC kg m-2] - real, dimension(SZI_(G)) :: pressure ! pressurea the surface [Pa] + real, dimension(SZI_(G)) :: 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),SZK_(G)+1) :: netPen ! The net penetrating shortwave radiation at each level @@ -933,10 +930,8 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt useCalvingHeatContent = .False. depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) - pressure(:) = 0. ! Ignore atmospheric pressure + pressure(:) = 0. ! Ignores atmospheric pressure ### GoRho = (GV%g_Earth * GV%H_to_Z*US%T_to_s) / GV%Rho0 - start = 1 + G%isc - G%isd - npts = 1 + G%iec - G%isc H_limit_fluxes = depthBeforeScalingFluxes @@ -947,7 +942,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! netSalt = salt via surface fluxes [ppt H s-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 - call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt*US%s_to_T, & + call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt*US%s_to_T, & depthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & h(:,j,:), Temp(:,j,:), netH, netEvap, netHeatMinusSW, & netSalt, penSWbnd, tv, .false., skip_diags=skip_diags) @@ -958,8 +953,8 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt H_limit_fluxes, .true., penSWbnd, netPen) ! Density derivatives - call calculate_density_derivs(Temp(:,j,1), Salt(:,j,1), pressure, & - dRhodT, dRhodS, start, npts, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(Temp(:,j,1), Salt(:,j,1), pressure, dRhodT, dRhodS, & + tv%eqn_of_state, EOS_domain(G%HI)) ! Adjust netSalt to reflect dilution effect of FW flux netSalt(G%isc:G%iec) = netSalt(G%isc:G%iec) - Salt(G%isc:G%iec,j,1) * netH(G%isc:G%iec) ! ppt H/s @@ -1079,9 +1074,9 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) call hchksum(fluxes%seaice_melt_heat, mesg//" fluxes%seaice_melt_heat", G%HI, & haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%p_surf)) & - call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf",G%HI,haloshift=hshift) + call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf", G%HI, haloshift=hshift , scale=US%RL2_T2_to_Pa) if (associated(fluxes%salt_flux)) & - call hchksum(fluxes%salt_flux, mesg//" fluxes%salt_flux",G%HI,haloshift=hshift, scale=RZ_T_conversion) + call hchksum(fluxes%salt_flux, mesg//" fluxes%salt_flux", G%HI, haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%TKE_tidal)) & call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal", G%HI, haloshift=hshift, & scale=US%RZ3_T3_to_W_m2) @@ -1132,9 +1127,9 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, US, haloshift) ! and js...je as their extent. if (associated(forces%taux) .and. associated(forces%tauy)) & call uvchksum(mesg//" forces%tau[xy]", forces%taux, forces%tauy, G%HI, & - haloshift=hshift, symmetric=.true., scale=US%R_to_kg_m3*US%L_T_to_m_s**2*US%Z_to_L) + haloshift=hshift, symmetric=.true., scale=US%RZ_T_to_kg_m2s*US%L_T_to_m_s) if (associated(forces%p_surf)) & - call hchksum(forces%p_surf, mesg//" forces%p_surf",G%HI,haloshift=hshift) + call hchksum(forces%p_surf, mesg//" forces%p_surf", G%HI, haloshift=hshift, scale=US%RL2_T2_to_Pa) if (associated(forces%ustar)) & call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) & @@ -1246,17 +1241,17 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_taux = register_diag_field('ocean_model', 'taux', diag%axesCu1, Time, & 'Zonal surface stress from ocean interactions with atmos and ice', & - 'Pa', conversion=US%R_to_kg_m3*US%L_T_to_m_s**2*US%Z_to_L, & + 'Pa', conversion=US%RZ_T_to_kg_m2s*US%L_T_to_m_s, & standard_name='surface_downward_x_stress', cmor_field_name='tauuo', & cmor_units='N m-2', cmor_long_name='Surface Downward X Stress', & cmor_standard_name='surface_downward_x_stress') handles%id_tauy = register_diag_field('ocean_model', 'tauy', diag%axesCv1, Time, & 'Meridional surface stress ocean interactions with atmos and ice', & - 'Pa', conversion=US%R_to_kg_m3*US%L_T_to_m_s**2*US%Z_to_L, & - standard_name='surface_downward_y_stress', cmor_field_name='tauvo', & - cmor_units='N m-2', cmor_long_name='Surface Downward Y Stress', & - cmor_standard_name='surface_downward_y_stress') + 'Pa', conversion=US%RZ_T_to_kg_m2s*US%L_T_to_m_s, & + standard_name='surface_downward_y_stress', cmor_field_name='tauvo', & + cmor_units='N m-2', cmor_long_name='Surface Downward Y Stress', & + cmor_standard_name='surface_downward_y_stress') handles%id_ustar = register_diag_field('ocean_model', 'ustar', diag%axesT1, Time, & 'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', & @@ -1281,9 +1276,10 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, endif endif - handles%id_psurf = register_diag_field('ocean_model', 'p_surf', diag%axesT1, Time, & - 'Pressure at ice-ocean or atmosphere-ocean interface', 'Pa', cmor_field_name='pso', & - cmor_long_name='Sea Water Pressure at Sea Water Surface', & + handles%id_psurf = register_diag_field('ocean_model', 'p_surf', diag%axesT1, Time, & + 'Pressure at ice-ocean or atmosphere-ocean interface', & + 'Pa', conversion=US%RL2_T2_to_Pa, cmor_field_name='pso', & + cmor_long_name='Sea Water Pressure at Sea Water Surface', & cmor_standard_name='sea_water_pressure_at_sea_water_surface') handles%id_TKE_tidal = register_diag_field('ocean_model', 'TKE_tidal', diag%axesT1, Time, & diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 8dbacf6798..ea529d42c5 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -47,12 +47,13 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !! the units of eta to m; by default this is US%Z_to_m. ! Local variables - real :: p(SZI_(G),SZJ_(G),SZK_(G)+1) ! Hydrostatic pressure at each interface [Pa] + real :: p(SZI_(G),SZJ_(G),SZK_(G)+1) ! Hydrostatic pressure at each interface [R L2 T-2 ~> Pa] real :: dz_geo(SZI_(G),SZJ_(G),SZK_(G)) ! The change in geopotential height - ! across a layer [m2 s-2]. + ! across a layer [L2 T-2 ~> m2 s-2]. real :: dilate(SZI_(G)) ! non-dimensional dilation factor real :: htot(SZI_(G)) ! total thickness [H ~> m or kg m-2] - real :: I_gEarth + real :: I_gEarth ! The inverse of the gravitational acceleration times the + ! rescaling factor derived from eta_to_m [T2 Z L-2 ~> s2 m-1] real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. integer i, j, k, isv, iev, jsv, jev, nz, halo @@ -67,7 +68,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta H_to_rho_eta = GV%H_to_RZ * Z_to_eta - I_gEarth = Z_to_eta / (US%Z_to_m * GV%mks_g_Earth) + I_gEarth = Z_to_eta / GV%g_Earth !$OMP parallel default(shared) private(dilate,htot) !$OMP do @@ -99,7 +100,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) ! ### THIS SHOULD BE P_SURF, IF AVAILABLE. do i=isv,iev ; p(i,j,1) = 0.0 ; enddo do k=1,nz ; do i=isv,iev - p(i,j,K+1) = p(i,j,K) + GV%H_to_Pa*h(i,j,k) + p(i,j,K+1) = p(i,j,K) + GV%g_Earth*GV%H_to_RZ*h(i,j,k) enddo ; enddo enddo !$OMP do @@ -159,11 +160,12 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !! the units of eta to m; by default this is US%Z_to_m. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & - p ! The pressure at interfaces [Pa]. + p ! Hydrostatic pressure at each interface [R L2 T-2 ~> Pa] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - dz_geo ! The change in geopotential height across a layer [m2 s-2]. + dz_geo ! The change in geopotential height across a layer [L2 T-2 ~> m2 s-2]. real :: htot(SZI_(G)) ! The sum of all layers' thicknesses [H ~> m or kg m-2]. - real :: I_gEarth + real :: I_gEarth ! The inverse of the gravitational acceleration times the + ! rescaling factor derived from eta_to_m [T2 Z L-2 ~> s2 m-1] real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. integer i, j, k, is, ie, js, je, nz, halo @@ -174,7 +176,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta H_to_rho_eta = GV%H_to_RZ * Z_to_eta - I_gEarth = Z_to_eta / (US%Z_to_m * GV%mks_g_Earth) + I_gEarth = Z_to_eta / GV%g_Earth !$OMP parallel default(shared) private(htot) !$OMP do @@ -196,10 +198,11 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) if (associated(tv%eqn_of_state)) then !$OMP do do j=js,je + ! ### THIS SHOULD BE P_SURF, IF AVAILABLE. do i=is,ie ; p(i,j,1) = 0.0 ; enddo do k=1,nz ; do i=is,ie - p(i,j,k+1) = p(i,j,k) + GV%H_to_Pa*h(i,j,k) + p(i,j,k+1) = p(i,j,k) + GV%g_Earth*GV%H_to_RZ*h(i,j,k) enddo ; enddo enddo !$OMP do diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index fc60d54f10..4f1a2d261e 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -55,7 +55,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! 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_(G)+1) :: & - pres ! The pressure at an interface [Pa]. + 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]. @@ -65,11 +65,11 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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]. - pres_u ! Pressure on the interface at the u-point [Pa]. + 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]. - pres_v ! Pressure on the interface at the v-point [Pa]. + 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 ! interface times the grid spacing [R ~> kg m-3]. @@ -99,6 +99,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: H_to_Z ! A conversion factor from thickness units to the units of e. logical :: present_N2_u, present_N2_v + integer, dimension(2) :: EOSdom_u, EOSdom_v ! Domains for the equation of state calculations at u and v points integer :: is, ie, js, je, nz, IsdB integer :: i, j, k @@ -147,18 +148,19 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. - pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) enddo ; enddo !$OMP parallel do default(shared) do j=js-1,je+1 - do k=2,nz ; do i=is-1,ie+1 - pres(i,j,K+1) = pres(i,j,K) + GV%H_to_Pa*h(i,j,k) + do k=1,nz ; do i=is-1,ie+1 + pres(i,j,K+1) = pres(i,j,K) + GV%g_Earth * GV%H_to_RZ * h(i,j,k) enddo ; enddo enddo - !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & - !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & - !$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & + EOSdom_u(1) = is-1 - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) + + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv,h,e, & + !$OMP h_neglect,dz_neglect,Z_to_L,L_to_Z,H_to_Z,h_neglect2, & + !$OMP present_N2_u,G_Rho0,N2_u,slope_x,EOSdom_u) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & @@ -176,8 +178,8 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & T_u(I) = 0.25*((T(i,j,k) + T(i+1,j,k)) + (T(i,j,k-1) + T(i+1,j,k-1))) S_u(I) = 0.25*((S(i,j,k) + S(i+1,j,k)) + (S(i,j,k-1) + S(i+1,j,k-1))) enddo - call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, & - drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, drho_dS_u, & + tv%eqn_of_state, EOSdom_u) endif do I=is-1,ie @@ -242,10 +244,12 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & enddo ! I enddo ; enddo ! end of j-loop + EOSdom_v(1) = is - (G%isd-1) ; EOSdom_v(2) = ie - (G%isd-1) + ! Calculate the meridional isopycnal slope. !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & - !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y) & + !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y,EOSdom_v) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & @@ -262,8 +266,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, is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + 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 diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 8e7dad1e51..7908d130b8 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -83,7 +83,7 @@ module MOM_variables real, pointer :: S(:,:,:) => NULL() !< Salnity [PSU] or [gSalt/kg], generically [ppt]. type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the !! equation of state to use. - real :: P_Ref !< The coordinate-density reference pressure [Pa]. + 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]. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 0608499f92..2823175b23 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -93,9 +93,9 @@ subroutine verticalGridInit( param_file, GV, US ) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, & "Parameters providing information about the vertical grid.") - call get_param(param_file, mdl, "G_EARTH", GV%mks_g_Earth, & + call get_param(param_file, mdl, "G_EARTH", GV%g_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default = 9.80, scale=US%Z_to_m*US%m_s_to_L_T**2) call get_param(param_file, mdl, "RHO_0", GV%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& @@ -127,7 +127,7 @@ subroutine verticalGridInit( param_file, GV, US ) "units of thickness into m.", units="m H-1", default=1.0) GV%H_to_m = GV%H_to_m * H_rescale_factor endif - GV%g_Earth = US%m_to_L**2*US%Z_to_m*US%T_to_s**2 * GV%mks_g_Earth + GV%mks_g_Earth = US%L_T_to_m_s**2*US%m_to_Z * GV%g_Earth #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & @@ -156,7 +156,7 @@ subroutine verticalGridInit( param_file, GV, US ) GV%H_to_MKS = GV%H_to_kg_m2 endif GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) - GV%H_to_Pa = GV%mks_g_Earth * GV%H_to_kg_m2 + GV%H_to_Pa = US%L_T_to_m_s**2*US%m_to_Z * GV%g_Earth * GV%H_to_kg_m2 GV%H_to_Z = GV%H_to_m * US%m_to_Z GV%Z_to_H = US%Z_to_m * GV%m_to_H diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 95b1f450e3..ca9ad28b62 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -15,7 +15,7 @@ module MOM_diagnostics use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids, diag_copy_storage_to_diag use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_domains, only : To_North, To_East -use MOM_EOS, only : calculate_density, int_density_dz +use MOM_EOS, only : calculate_density, int_density_dz, EOS_domain use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type @@ -208,7 +208,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !! accelerations in momentum equation. type(cont_diag_ptrs), intent(in) :: CDp !< structure with pointers to !! terms in continuity equation. - real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure [Pa]. + real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure [R L2 T-2 ~> Pa]. !! If p_surf is not associated, it is the same !! as setting the surface pressure to 0. real, intent(in) :: dt !< The time difference since the last @@ -223,6 +223,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !! calculating interface heights [H ~> m or kg m-2]. ! Local variables + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb real :: Rcv(SZI_(G),SZJ_(G),SZK_(G)) ! Coordinate variable potential density [R ~> kg m-3]. @@ -232,12 +233,12 @@ 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)) - real :: pressure_1d(SZI_(G)) ! Temporary array for pressure when calling EOS + real :: pressure_1d(SZI_(G)) ! Temporary array for pressure when calling EOS [R L2 T-2 ~> Pa] real :: wt, wt_p real :: f2_h ! Squared Coriolis parameter at to h-points [T-2 ~> s-2] real :: mag_beta ! Magnitude of the gradient of f [T-1 L-1 ~> s-1 m-1] - real :: absurdly_small_freq2 ! Srequency squared used to avoid division by 0 [T-2 ~> s-2] + real :: absurdly_small_freq2 ! Frequency squared used to avoid division by 0 [T-2 ~> s-2] integer :: k_list @@ -344,8 +345,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call post_data(CS%id_volcello, work_3d, CS%diag) endif else ! thkcello = dp/(rho*g) for non-Boussinesq + EOSdom(:) = EOS_domain(G%HI) do j=js,je - if (associated(p_surf)) then ! Pressure loading at top of surface layer [Pa] + if (associated(p_surf)) then ! Pressure loading at top of surface layer [R L2 T-2 ~> Pa] do i=is,ie pressure_1d(i) = p_surf(i,j) enddo @@ -355,17 +357,17 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & enddo endif do k=1,nz ! Integrate vertically downward for pressure - do i=is,ie ! Pressure for EOS at the layer center [Pa] - pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) + do i=is,ie ! Pressure for EOS at the layer center [R L2 T-2 ~> Pa] + 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, is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + 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) enddo - do i=is,ie ! Pressure for EOS at the bottom interface [Pa] - pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) + do i=is,ie ! Pressure for EOS at the bottom interface [R L2 T-2 ~> Pa] + pressure_1d(i) = pressure_1d(i) + 0.5*(GV%H_to_RZ*GV%g_Earth)*h(i,j,k) enddo enddo ! k enddo ! j @@ -462,11 +464,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & associated(CS%uhGM_Rlay) .or. associated(CS%vhGM_Rlay)) then if (associated(tv%eqn_of_state)) then + EOSdom(:) = EOS_domain(G%HI, halo=1) 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), is-1, ie-is+3, tv%eqn_of_state , scale=US%kg_m3_to_R) + 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. do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 @@ -584,33 +587,34 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if (associated(tv%eqn_of_state)) then + EOSdom(:) = EOS_domain(G%HI) if (CS%id_rhopot0 > 0) then pressure_1d(:) = 0. -!$OMP parallel do default(none) shared(tv,Rcv,is,ie,js,je,nz,pressure_1d) + !$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),is,ie-is+1, 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 if (CS%id_rhopot0 > 0) call post_data(CS%id_rhopot0, Rcv, CS%diag) endif if (CS%id_rhopot2 > 0) then - pressure_1d(:) = 2.E7 ! 2000 dbars -!$OMP parallel do default(none) shared(tv,Rcv,is,ie,js,je,nz,pressure_1d) + 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),is,ie-is+1, 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 if (CS%id_rhopot2 > 0) call post_data(CS%id_rhopot2, Rcv, CS%diag) endif if (CS%id_rhoinsitu > 0) then -!$OMP parallel do default(none) shared(tv,Rcv,is,ie,js,je,nz,h,GV) private(pressure_1d) + !$OMP parallel do default(shared) private(pressure_1d) 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 - call calculate_density(tv%T(:,j,k),tv%S(:,j,k),pressure_1d, & - Rcv(:,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 + 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) + 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_rhoinsitu > 0) call post_data(CS%id_rhoinsitu, Rcv, CS%diag) @@ -769,7 +773,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. - real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure [Pa]. + real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure [R L2 T-2 ~> Pa]. !! If p_surf is not associated, it is the same !! as setting the surface pressure to 0. type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a @@ -785,11 +789,11 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) ! (rho*dz for col_mass) or reference density (Rho_0*dz for mass_wt). btm_pres,&! The pressure at the ocean bottom, or CMIP variable 'pbo'. ! This is the column mass multiplied by gravity plus the pressure - ! at the ocean surface [Pa]. - dpress, & ! Change in hydrostatic pressure across a layer [Pa]. + ! at the ocean surface [R L2 T-2 ~> Pa]. + dpress, & ! Change in hydrostatic pressure across a layer [R L2 T-2 ~> Pa]. tr_int ! vertical integral of a tracer times density, ! (Rho_0 in a Boussinesq model) [TR kg m-2]. - real :: IG_Earth ! Inverse of gravitational acceleration [s2 Z m-2 ~> s2 m-1]. + real :: IG_Earth ! Inverse of gravitational acceleration [T2 Z L-2 ~> s2 m-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -831,7 +835,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) do j=js,je ; do i=is,ie ; mass(i,j) = 0.0 ; enddo ; enddo if (GV%Boussinesq) then if (associated(tv%eqn_of_state)) then - IG_Earth = 1.0 / (US%Z_to_m*GV%mks_g_Earth) + IG_Earth = 1.0 / GV%g_Earth ! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo do j=G%jscB,G%jecB+1 ; do i=G%iscB,G%iecB+1 z_bot(i,j) = 0.0 @@ -841,11 +845,10 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) z_top(i,j) = z_bot(i,j) z_bot(i,j) = z_top(i,j) - GV%H_to_Z*h(i,j,k) enddo ; enddo - call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), & - z_top, z_bot, 0.0, US%R_to_kg_m3*GV%Rho0, GV%mks_g_Earth*US%Z_to_m, & + call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), z_top, z_bot, 0.0, GV%Rho0, GV%g_Earth, & G%HI, G%HI, tv%eqn_of_state, dpress) do j=js,je ; do i=is,ie - mass(i,j) = mass(i,j) + dpress(i,j) * US%kg_m3_to_R*IG_Earth + mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth enddo ; enddo enddo else @@ -867,7 +870,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) ! pbo = (mass * g) + p_surf ! where p_surf is the sea water pressure at sea water surface. do j=js,je ; do i=is,ie - btm_pres(i,j) = US%RZ_to_kg_m2*mass(i,j) * GV%mks_g_Earth + btm_pres(i,j) = GV%g_Earth * mass(i,j) if (associated(p_surf)) then btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif @@ -1578,11 +1581,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'Coordinate Potential Density', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_rhopot0 = register_diag_field('ocean_model', 'rhopot0', diag%axesTL, Time, & - 'Potential density referenced to surface', 'kg m-3') + 'Potential density referenced to surface', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_rhopot2 = register_diag_field('ocean_model', 'rhopot2', diag%axesTL, Time, & - 'Potential density referenced to 2000 dbar', 'kg m-3') + 'Potential density referenced to 2000 dbar', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_rhoinsitu = register_diag_field('ocean_model', 'rhoinsitu', diag%axesTL, Time, & - 'In situ density', 'kg m-3') + 'In situ density', 'kg 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) @@ -1732,7 +1735,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'The height of the water column', 'm', conversion=US%Z_to_m) CS%id_pbo = register_diag_field('ocean_model', 'pbo', diag%axesT1, Time, & long_name='Sea Water Pressure at Sea Floor', standard_name='sea_water_pressure_at_sea_floor', & - units='Pa') + units='Pa', conversion=US%RL2_T2_to_Pa) call set_dependent_diagnostics(MIS, ADp, CDp, G, CS) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 56545dc50d..c955c4eb95 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -76,7 +76,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & real, dimension(SZK_(G)+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] - pres, & ! Interface pressure [Pa] + pres, & ! Interface pressure [R L2 T-2 ~> Pa] T_int, & ! Temperature interpolated to interfaces [degC] S_int, & ! Salinity interpolated to interfaces [ppt] gprime ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. @@ -100,7 +100,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s m-1] real :: lam0 ! The first guess of the eigenvalue [T2 L-2 ~> s m-1] real :: min_h_frac ! [nondim] - real :: Z_to_Pa ! A conversion factor from thicknesses (in Z) to pressure (in Pa) + real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1] real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses [Z ~> m] H_here, & ! A thickness [Z ~> m] @@ -158,7 +158,8 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 - Z_to_Pa = GV%Z_to_H * GV%H_to_Pa + ! Simplifying the following could change answers at roundoff. + Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) use_EOS = associated(tv%eqn_of_state) rescale = 1024.0**4 ; I_rescale = 1.0/rescale @@ -170,7 +171,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,T,S,tv,& !$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & !$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & -!$OMP Z_to_Pa,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2,c2_scale) & +!$OMP Z_to_pres,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2,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, & !$OMP drho_dS,drxh_sum,kc,Hc,Hc_H,Tc,Sc,I_Hnew,gprime,& @@ -237,12 +238,12 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & if (use_EOS) then pres(1) = 0.0 do k=2,kf(i) - pres(k) = pres(k-1) + Z_to_Pa*Hf(k-1,i) + pres(k) = pres(k-1) + Z_to_pres*Hf(k-1,i) T_int(k) = 0.5*(Tf(k,i)+Tf(k-1,i)) S_int(k) = 0.5*(Sf(k,i)+Sf(k-1,i)) enddo - call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, 2, & - kf(i)-1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, & + tv%eqn_of_state, (/2,kf(i)/) ) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. @@ -567,10 +568,10 @@ end subroutine tdma6 !> Calculates the wave speeds for the first few barolinic modes. subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] @@ -581,7 +582,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real, dimension(SZK_(G)+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] - pres, & ! Interface pressure [Pa] + pres, & ! Interface pressure [R L2 T-2 ~> Pa] T_int, & ! Temperature interpolated to interfaces [degC] S_int, & ! Salinity interpolated to interfaces [ppt] gprime ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. @@ -621,7 +622,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) integer :: numint ! number of widows (intervals) in root searching range integer :: nrootsfound ! number of extra roots found (not including 1st root) real :: min_h_frac - real :: Z_to_Pa ! A conversion factor from thicknesses (in Z) to pressure (in Pa) + real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1] real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses [Z ~> m] H_here, & ! A thickness [Z ~> m] @@ -665,12 +666,13 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) - Z_to_Pa = GV%Z_to_H * GV%H_to_Pa + ! Simplifying the following could change answers at roundoff. + Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) c1_thresh = 0.01*US%m_s_to_L_T min_h_frac = tol1 / real(nz) !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,T,S, & - !$OMP Z_to_Pa,tv,cn,g_Rho0,nmodes) + !$OMP Z_to_pres,tv,cn,g_Rho0,nmodes) do j=js,je ! First merge very thin layers with the one above (or below if they are ! at the top). This also transposes the row order so that columns can @@ -731,12 +733,12 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) if (use_EOS) then pres(1) = 0.0 do k=2,kf(i) - pres(k) = pres(k-1) + Z_to_Pa*Hf(k-1,i) + pres(k) = pres(k-1) + Z_to_pres*Hf(k-1,i) T_int(k) = 0.5*(Tf(k,i)+Tf(k-1,i)) S_int(k) = 0.5*(Sf(k,i)+Sf(k-1,i)) enddo - call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, 2, & - kf(i)-1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, & + tv%eqn_of_state, (/2,kf(i)/) ) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. @@ -879,7 +881,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! Under estimate the first eigenvalue to start with. lam_1 = 1.0 / speed2_tot - ! Find the first eigen value + ! Find the first eigenvalue do itt=1,max_itt ! calculate the determinant of (A-lam_1*I) call tridiag_det(a_diag(1:nrows),b_diag(1:nrows),c_diag(1:nrows), & @@ -902,10 +904,10 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) endif enddo - ! Find other eigen values if c1 is of significant magnitude, > cn_thresh + ! Find other eigenvalues if c1 is of significant magnitude, > cn_thresh nrootsfound = 0 ! number of extra roots found (not including 1st root) if (nmodes>1 .and. kc>=nmodes+1 .and. cn(i,j,1)>c1_thresh) then - ! Set the the range to look for the other desired eigen values + ! Set the the range to look for the other desired eigenvalues ! set min value just greater than the 1st root (found above) lamMin = lam_1*(1.0 + tol2) ! set max value based on a low guess at wavespeed for highest mode diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 68667df71b..632a68e0ce 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -109,7 +109,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(G)+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] - pres, & ! Interface pressure [Pa] + pres, & ! Interface pressure [R L2 T-2 ~> Pa] T_int, & ! Temperature interpolated to interfaces [degC] S_int, & ! Salinity interpolated to interfaces [ppt] gprime ! The reduced gravity across each interface [m2 Z-1 s-2 ~> m s-2]. @@ -131,7 +131,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo htot ! The vertical sum of the thicknesses [Z ~> m] real :: lam real :: min_h_frac - real :: H_to_pres + real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1] real, dimension(SZI_(G)) :: & hmin, & ! Thicknesses [Z ~> m] H_here, & ! A thickness [Z ~> m] @@ -199,7 +199,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo cg_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. use_EOS = associated(tv%eqn_of_state) - H_to_pres = GV%Z_to_H*GV%H_to_Pa + ! Simplifying the following could change answers at roundoff. + Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) ! rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) @@ -272,12 +273,12 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo if (use_EOS) then pres(1) = 0.0 do k=2,kf(i) - pres(k) = pres(k-1) + H_to_pres*Hf(k-1,i) + pres(k) = pres(k-1) + Z_to_pres*Hf(k-1,i) T_int(k) = 0.5*(Tf(k,i)+Tf(k-1,i)) S_int(k) = 0.5*(Sf(k,i)+Sf(k-1,i)) enddo - call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, 2, & - kf(i)-1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, & + tv%eqn_of_state, (/2,kf(i)/) ) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 3d0cb9abc4..49820d7ff8 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -29,8 +29,9 @@ module MOM_EOS use MOM_TFreeze, only : calculate_TFreeze_teos10 use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_hor_index, only : hor_index_type use MOM_string_functions, only : uppercase -use MOM_hor_index, only : hor_index_type +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -39,7 +40,7 @@ module MOM_EOS public calculate_compress, calculate_density, query_compressible public calculate_density_derivs, calculate_specific_vol_derivs public calculate_density_second_derivs -public EOS_init, EOS_manual_init, EOS_end, EOS_allocate +public EOS_init, EOS_manual_init, EOS_end, EOS_allocate, EOS_domain public EOS_use_linear, calculate_spec_vol public int_density_dz, int_specific_vol_dp public int_density_dz_generic_plm, int_density_dz_generic_ppm @@ -58,19 +59,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 + module procedure calculate_density_scalar, calculate_density_array, calculate_density_1d end interface calculate_density !> Calculates specific volume of sea water from T, S and P interface calculate_spec_vol - module procedure calculate_spec_vol_scalar, calculate_spec_vol_array + module procedure calc_spec_vol_scalar, calculate_spec_vol_array, & + 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 + module procedure calculate_density_derivs_scalar, calculate_density_derivs_array, & + 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 +end interface calculate_specific_vol_derivs + !> Calculates the second derivatives of density with various combinations of temperature, !! salinity, and pressure from T, S and P interface calculate_density_second_derivs @@ -96,14 +104,22 @@ module MOM_EOS !! code for the integrals of density. logical :: Compressible = .true. !< If true, in situ density is a function of pressure. ! The following parameters are used with the linear equation of state only. - real :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. + real :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3] real :: dRho_dT !< The partial derivative of density with temperature [kg m-3 degC-1] - real :: dRho_dS !< The partial derivative of density with salinity [kg m-3 ppt-1]. + real :: dRho_dS !< The partial derivative of density with salinity [kg m-3 ppt-1] ! The following parameters are use with the linear expression for the freezing ! point only. - real :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 [degC]. - real :: dTFr_dS !< The derivative of freezing point with salinity [degC ppt-1]. - real :: dTFr_dp !< The derivative of freezing point with pressure [degC Pa-1]. + real :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 [degC] + real :: dTFr_dS !< The derivative of freezing point with salinity [degC ppt-1] + real :: dTFr_dp !< The derivative of freezing point with pressure [degC Pa-1] + +! Unit conversion factors (normally used for dimensional testing but could also allow for +! change of units of arguments to functions) + real :: m_to_Z = 1. !< A constant that translates distances in meters to the units of depth. + real :: kg_m3_to_R = 1. !< A constant that translates kilograms per meter cubed to the units of density. + 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. ! logical :: test_EOS = .true. ! If true, test the equation of state end type EOS_type @@ -134,40 +150,46 @@ module MOM_EOS contains !> 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. +!! 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 +!! 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) :: pressure !< Pressure [Pa] + 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] type(EOS_type), pointer :: 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) :: 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 :: 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] if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_scalar called with an unassociated EOS_type EOS.") + p_scale = EOS%RL2_T2_to_Pa + select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_linear(T, S, pressure, rho, & + 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, pressure, rho, rho_ref) + call calculate_density_unesco(T, S, p_scale*pressure, rho, rho_ref) case (EOS_WRIGHT) - call calculate_density_wright(T, S, pressure, rho, rho_ref) + call calculate_density_wright(T, S, p_scale*pressure, rho, rho_ref) case (EOS_TEOS10) - call calculate_density_teos10(T, S, pressure, rho, rho_ref) + call calculate_density_teos10(T, S, p_scale*pressure, rho, rho_ref) case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho, rho_ref) + 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.") + call MOM_error(FATAL, "calculate_density_scalar: EOS is not valid.") end select - if (present(scale)) then ; if (scale /= 1.0) then - rho = scale * rho - endif ; endif + rho_scale = EOS%kg_m3_to_R + if (present(scale)) rho_scale = rho_scale * scale + rho = rho_scale * rho end subroutine calculate_density_scalar @@ -176,103 +198,111 @@ end subroutine calculate_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] + 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] integer, intent(in) :: start !< Start index for computation integer, intent(in) :: npts !< Number of point to compute type(EOS_type), pointer :: 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) :: 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 if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_linear(T, S, pressure, rho, start, npts, & + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_density_linear(T, S, pressure, rho, start, npts, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_ref) - case (EOS_UNESCO) - call calculate_density_unesco(T, S, pressure, rho, start, npts, rho_ref) - case (EOS_WRIGHT) - call calculate_density_wright(T, S, pressure, rho, start, npts, rho_ref) - case (EOS_TEOS10) - call calculate_density_teos10(T, S, pressure, rho, start, npts, rho_ref) - case (EOS_NEMO) - call calculate_density_nemo (T, S, pressure, rho, start, npts, rho_ref) - case default - call MOM_error(FATAL, & - "calculate_density_array: EOS%form_of_EOS is not valid.") - end select + case (EOS_UNESCO) + call calculate_density_unesco(T, S, pressure, rho, start, npts, rho_ref) + case (EOS_WRIGHT) + call calculate_density_wright(T, S, pressure, rho, start, npts, rho_ref) + case (EOS_TEOS10) + call calculate_density_teos10(T, S, pressure, rho, start, npts, rho_ref) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pressure, rho, start, npts, rho_ref) + case default + call MOM_error(FATAL, "calculate_density_array: EOS%form_of_EOS is not valid.") + end select - if (present(scale)) then ; if (scale /= 1.0) then - do j=start,start+npts-1 ; rho(j) = scale * rho(j) ; enddo - endif ; endif + if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 + rho(j) = scale * rho(j) + enddo ; endif ; endif end subroutine calculate_density_array -!> Calls the appropriate subroutine to calculate specific volume of sea water -!! for scalar inputs. -subroutine calculate_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] - real, intent(out) :: specvol !< In situ? specific volume [m3 kg-1] or [R-1 ~> m3 kg-1] - type(EOS_type), pointer :: 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 from m3 kg-1 to the desired units [kg m-3 R-1] - - real :: rho +!> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs, +!! 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) :: 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), pointer :: 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) :: 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_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 if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_scalar called with an unassociated EOS_type EOS.") + "calculate_density_1d called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_spec_vol_linear(T, S, pressure, specvol, & - EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) - case (EOS_UNESCO) - call calculate_spec_vol_unesco(T, S, pressure, specvol, spv_ref) - case (EOS_WRIGHT) - call calculate_spec_vol_wright(T, S, pressure, specvol, spv_ref) - case (EOS_TEOS10) - call calculate_spec_vol_teos10(T, S, pressure, specvol, spv_ref) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho) - if (present(spv_ref)) then - specvol = 1.0 / rho - spv_ref - else - specvol = 1.0 / rho - endif - case default - call MOM_error(FATAL, & - "calculate_spec_vol_scalar: EOS is not valid.") - end select + 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 - if (present(scale)) then ; if (scale /= 1.0) then - specvol = scale * specvol - endif ; 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 + 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 + 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 + call calculate_density_array(T, S, pres, rho, is, npts, EOS) + endif -end subroutine calculate_spec_vol_scalar + 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 + rho(i) = rho_scale * rho(i) + enddo ; endif +end subroutine calculate_density_1d !> Calls the appropriate subroutine to calculate the specific volume of sea water !! for 1-D array inputs. subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, spv_ref, scale) - real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. - real, dimension(:), intent(in) :: S !< salinity [ppt]. - real, dimension(:), intent(in) :: pressure !< pressure [Pa]. - real, dimension(:), intent(inout) :: specvol !< in situ specific volume [kg m-3] or [R-1 ~> m3 kg-1]. + real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC] + real, dimension(:), intent(in) :: S !< salinity [ppt] + real, dimension(:), intent(in) :: pressure !< pressure [Pa] + real, dimension(:), intent(inout) :: specvol !< in situ specific volume [kg m-3] integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. type(EOS_type), pointer :: 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 - !! from m3 kg-1 to the desired units [kg m-3 R-1] + 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] - real, dimension(size(specvol)) :: rho + real, dimension(size(specvol)) :: rho ! Density [kg m-3] integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & @@ -289,75 +319,193 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s case (EOS_TEOS10) call calculate_spec_vol_teos10(T, S, pressure, specvol, start, npts, spv_ref) case (EOS_NEMO) - call calculate_density_nemo (T, S, pressure, rho, start, npts) + call calculate_density_nemo(T, S, pressure, rho, start, npts) if (present(spv_ref)) then specvol(:) = 1.0 / rho(:) - spv_ref else specvol(:) = 1.0 / rho(:) endif case default - call MOM_error(FATAL, & - "calculate_spec_vol_array: EOS%form_of_EOS is not valid.") + call MOM_error(FATAL, "calculate_spec_vol_array: EOS%form_of_EOS is not valid.") end select if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 specvol(j) = scale * specvol(j) - enddo ; endif ; endif + enddo ; endif ; endif 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) :: 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] + type(EOS_type), pointer :: 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) :: 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 :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] + + if (.not.associated(EOS)) call MOM_error(FATAL, & + "calc_spec_vol_scalar called with an unassociated EOS_type EOS.") + + pres(1) = EOS%RL2_T2_to_Pa*pressure + Ta(1) = T ; Sa(1) = 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) + else + call calculate_spec_vol_array(Ta, Sa, pres, spv, 1, 1, EOS) + endif + specvol = spv(1) + + spv_scale = EOS%R_to_kg_m3 + if (present(scale)) spv_scale = spv_scale * scale + if (spv_scale /= 1.0) then + specvol = spv_scale * specvol + endif + +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) :: pressure !< Pressure [R L2 T-2 ~> Pa] + real, dimension(:), intent(inout) :: specvol !< In situ specific volume [R-1 ~> m3 kg-1] + type(EOS_type), pointer :: 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) :: 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] + ! 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 + + if (.not.associated(EOS)) call MOM_error(FATAL, & + "calc_spec_vol_1d called with an unassociated EOS_type EOS.") + + if (present(dom)) then + is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is + else + 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 + 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 + 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 + call calculate_spec_vol_array(T, S, pres, specvol, is, npts, EOS) + endif + + spv_scale = EOS%R_to_kg_m3 + if (present(scale)) spv_scale = spv_scale * scale + if (spv_scale /= 1.0) then ; do i=is,ie + specvol(i) = spv_scale * specvol(i) + enddo ; endif + +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) +subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure [Pa] + real, intent(in) :: pressure !< Pressure [Pa] or [other] real, intent(out) :: T_fr !< Freezing point potential temperature referenced !! to the surface [degC] type(EOS_type), pointer :: EOS !< Equation of state structure + real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa + + ! Local variables + real :: p_scale ! A factor to convert pressure to units of Pa. if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_TFreeze_scalar called with an unassociated EOS_type EOS.") + p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + select case (EOS%form_of_TFreeze) case (TFREEZE_LINEAR) - call calculate_TFreeze_linear(S, pressure, T_fr, EOS%TFr_S0_P0, & + call calculate_TFreeze_linear(S, p_scale*pressure, T_fr, EOS%TFr_S0_P0, & EOS%dTFr_dS, EOS%dTFr_dp) case (TFREEZE_MILLERO) - call calculate_TFreeze_Millero(S, pressure, T_fr) + call calculate_TFreeze_Millero(S, p_scale*pressure, T_fr) case (TFREEZE_TEOS10) - call calculate_TFreeze_teos10(S, pressure, T_fr) + call calculate_TFreeze_teos10(S, p_scale*pressure, T_fr) case default - call MOM_error(FATAL, & - "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") + call MOM_error(FATAL, "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") end select 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) +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] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [other] 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), pointer :: EOS !< Equation of state structure + real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + + ! Local variables + real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] + real :: p_scale ! A factor to convert pressure to units of Pa. + integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_TFreeze_scalar called with an unassociated EOS_type EOS.") - select case (EOS%form_of_TFreeze) - case (TFREEZE_LINEAR) - call calculate_TFreeze_linear(S, pressure, T_fr, start, npts, & - EOS%TFr_S0_P0, EOS%dTFr_dS, EOS%dTFr_dp) - case (TFREEZE_MILLERO) - call calculate_TFreeze_Millero(S, pressure, T_fr, start, npts) - case (TFREEZE_TEOS10) - call calculate_TFreeze_teos10(S, pressure, T_fr, start, npts) - case default - call MOM_error(FATAL, & - "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") - end select + p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + + if (p_scale == 1.0) then + select case (EOS%form_of_TFreeze) + case (TFREEZE_LINEAR) + call calculate_TFreeze_linear(S, pressure, T_fr, start, npts, & + EOS%TFr_S0_P0, EOS%dTFr_dS, EOS%dTFr_dp) + case (TFREEZE_MILLERO) + call calculate_TFreeze_Millero(S, pressure, T_fr, start, npts) + case (TFREEZE_TEOS10) + call calculate_TFreeze_teos10(S, pressure, T_fr, start, npts) + case default + call MOM_error(FATAL, "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") + end select + else + do j=start,start+npts-1 ; pres(j) = p_scale * pressure(j) ; enddo + select case (EOS%form_of_TFreeze) + case (TFREEZE_LINEAR) + call calculate_TFreeze_linear(S, pres, T_fr, start, npts, & + EOS%TFr_S0_P0, EOS%dTFr_dS, EOS%dTFr_dp) + case (TFREEZE_MILLERO) + call calculate_TFreeze_Millero(S, pres, T_fr, start, npts) + case (TFREEZE_TEOS10) + call calculate_TFreeze_teos10(S, pres, T_fr, start, npts) + case default + call MOM_error(FATAL, "calculate_TFreeze_scalar: form_of_TFreeze is not valid.") + end select + endif end subroutine calculate_TFreeze_array @@ -365,16 +513,18 @@ 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] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> 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 [R degC-1 ~> kg m-3 degC-1] real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 ppt-1] or [R degC-1 ~> kg m-3 ppt-1]. + !! in [kg m-3 ppt-1] or [R degC-1 ~> kg m-3 ppt-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure - 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 density + !! in combination with scaling given by US [various] + + ! Local variables integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & @@ -393,8 +543,7 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star case (EOS_NEMO) call calculate_density_derivs_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) case default - call MOM_error(FATAL, & - "calculate_density_derivs_array: EOS%form_of_EOS is not valid.") + call MOM_error(FATAL, "calculate_density_derivs_array: EOS%form_of_EOS is not valid.") end select if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 @@ -404,40 +553,96 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star 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) :: 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] + real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity + !! [R degC-1 ~> kg m-3 ppt-1] + type(EOS_type), pointer :: 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(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 (.not.associated(EOS)) call MOM_error(FATAL, & + "calculate_density_derivs called with an unassociated EOS_type EOS.") + + if (present(dom)) then + is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is + else + is = 1 ; ie = size(drho_dT) ; npts = 1 + ie - is + endif + + p_scale = EOS%RL2_T2_to_Pa + + if (p_scale == 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 + call calculate_density_derivs_array(T, S, 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) + enddo ; endif + +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) :: pressure !< Pressure [Pa] + real, intent(in) :: pressure !< Pressure [Pa] or [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] 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]. - type(EOS_type), pointer :: EOS !< Equation of state structure + !! in [kg m-3 ppt-1] or [R ppt-1 ~> kg m-3 ppt-1] + type(EOS_type), pointer :: EOS !< Equation of state structure 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] + !! 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] + integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") + p_scale = EOS%RL2_T2_to_Pa + select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, & + call calculate_density_derivs_linear(T, S, p_scale*pressure, drho_dT, drho_dS, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) case (EOS_WRIGHT) - call calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS) + call calculate_density_derivs_wright(T, S, p_scale*pressure, drho_dT, drho_dS) case (EOS_TEOS10) - call calculate_density_derivs_teos10(T, S, pressure, drho_dT, drho_dS) + call calculate_density_derivs_teos10(T, S, p_scale*pressure, drho_dT, drho_dS) case default - call MOM_error(FATAL, & - "calculate_density_derivs_scalar: EOS%form_of_EOS is not valid.") + call MOM_error(FATAL, "calculate_density_derivs_scalar: EOS%form_of_EOS is not valid.") end select - if (present(scale)) then ; if (scale /= 1.0) then - drho_dT = scale * drho_dT - drho_dS = scale * drho_dS - endif ; endif + 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 + endif end subroutine calculate_density_derivs_scalar @@ -446,7 +651,7 @@ 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] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [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] real, dimension(:), intent(inout) :: drho_dS_dT !< Partial derivative of beta with respect to T @@ -458,37 +663,70 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh 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] integer, intent(in) :: start !< Starting index within the array - integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure - 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] + integer, intent(in) :: npts !< The number of values to calculate + type(EOS_type), pointer :: 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, 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 if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - 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) - 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) - 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) - case default - call MOM_error(FATAL, & - "calculate_density_derivs: EOS%form_of_EOS is not valid.") - end select + p_scale = EOS%RL2_T2_to_Pa + + if (p_scale == 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) + 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) + 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) + 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 + 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) + 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) + 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) + case default + call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") + end select + endif - if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 - drho_dS_dS(j) = scale * drho_dS_dS(j) - drho_dS_dT(j) = scale * drho_dS_dT(j) - drho_dT_dT(j) = scale * drho_dT_dT(j) - drho_dS_dP(j) = scale * drho_dS_dP(j) - drho_dT_dP(j) = scale * drho_dT_dP(j) - enddo ; endif ; endif + 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) + 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) + enddo + endif end subroutine calculate_density_second_derivs_array @@ -497,7 +735,7 @@ 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] + real, intent(in) :: pressure !< Pressure [Pa] or [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] real, intent(out) :: drho_dS_dT !< Partial derivative of beta with respect to T @@ -510,57 +748,71 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] type(EOS_type), pointer :: EOS !< Equation of state structure 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] + !! 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 :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa [R L2 T-2 Pa-1 ~> 1] if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") + p_scale = EOS%RL2_T2_to_Pa + select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & + call calculate_density_second_derivs_linear(T, S, p_scale*pressure, 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, pressure, drho_dS_dS, drho_dS_dT, & + call calculate_density_second_derivs_wright(T, S, p_scale*pressure, 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, pressure, drho_dS_dS, drho_dS_dT, & + call calculate_density_second_derivs_teos10(T, S, p_scale*pressure, 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.") + call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") end select - if (present(scale)) then ; if (scale /= 1.0) then - drho_dS_dS = scale * drho_dS_dS - drho_dS_dT = scale * drho_dS_dT - drho_dT_dT = scale * drho_dT_dT - drho_dS_dP = scale * drho_dS_dP - drho_dT_dP = scale * drho_dT_dP - endif ; endif + rho_scale = EOS%kg_m3_to_R + if (present(scale)) rho_scale = rho_scale * scale + if (rho_scale /= 1.0) then + drho_dS_dS = rho_scale * drho_dS_dS + drho_dS_dT = rho_scale * drho_dS_dT + drho_dT_dT = rho_scale * drho_dT_dT + drho_dS_dP = rho_scale * drho_dS_dP + drho_dT_dP = rho_scale * drho_dT_dP + 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 + endif end subroutine calculate_density_second_derivs_scalar !> Calls the appropriate subroutine to calculate specific volume derivatives for an array. -subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS, scale) +subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS) 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] real, dimension(:), intent(inout) :: dSV_dT !< The partial derivative of specific volume with potential - !! temperature [m3 kg-1 degC-1] or [R-1 degC-1 ~> m3 kg-1 degC-1] + !! temperature [m3 kg-1 degC-1] real, dimension(:), intent(inout) :: dSV_dS !< The partial derivative of specific volume with salinity - !! [m3 kg-1 ppt-1] or [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + !! [m3 kg-1 ppt-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific volume - !! from m3 kg-1 to the desired units [kg m-3 R-1] ! Local variables - real, dimension(size(T)) :: dRho_dT, dRho_dS, rho + real, dimension(size(T)) :: press ! Pressure converted to [Pa] + real, dimension(size(T)) :: rho ! In situ density [kg m-3] + real, dimension(size(T)) :: dRho_dT ! Derivative of density with temperature [kg m-3 degC-1] + real, dimension(size(T)) :: dRho_dS ! Derivative of density with salinity [kg m-3 ppt-1] integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") + "calculate_spec_vol_derivs_array called with an unassociated EOS_type EOS.") select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -585,33 +837,84 @@ subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) enddo case default - call MOM_error(FATAL, & - "calculate_density_derivs: EOS%form_of_EOS is not valid.") + call MOM_error(FATAL, "calculate_spec_vol_derivs_array: EOS%form_of_EOS is not valid.") end select - if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 - dSV_dT(j) = scale * dSV_dT(j) - dSV_dS(j) = scale * dSV_dS(j) - enddo ; endif ; endif +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) :: 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] + real, dimension(:), intent(inout) :: dSV_dS !< The partial derivative of specific volume with salinity + !! [R-1 ppt-1 ~> m3 kg-1 ppt-1] + type(EOS_type), pointer :: 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 specific + !! volume in combination with scaling given by US [various] + + ! 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 (.not.associated(EOS)) call MOM_error(FATAL, & + "calculate_spec_vol_derivs_1d called with an unassociated EOS_type EOS.") + + if (present(dom)) then + is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is + 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 + 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 + call calculate_spec_vol_derivs_array(T, S, press, dSV_dT, dSV_dS, is, npts, EOS) + endif + + spv_scale = EOS%R_to_kg_m3 + if (present(scale)) spv_scale = spv_scale * scale + 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) + enddo ; endif -end subroutine calculate_specific_vol_derivs +end subroutine calc_spec_vol_derivs_1d -!> Calls the appropriate subroutine to calculate the density and compressibility for 1-D array inputs. -subroutine calculate_compress_array(T, S, pressure, rho, drho_dp, start, npts, EOS) + +!> 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) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [PSU] - real, dimension(:), intent(in) :: pressure !< Pressure [Pa] - real, dimension(:), intent(inout) :: rho !< In situ density [kg m-3]. + 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(inout) :: drho_dp !< The partial derivative of density with pressure - !! (also the inverse of the square of sound speed) [s2 m-2]. + !! (also the inverse of the square of sound speed) + !! [s2 m-2] or [T2 L-2] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure + ! Local variables + real, dimension(size(press)) :: pressure ! Pressure converted to [Pa] + integer :: i, is, ie + if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_compress called with an unassociated EOS_type EOS.") + 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, & @@ -625,23 +928,31 @@ subroutine calculate_compress_array(T, S, pressure, rho, drho_dp, start, npts, E case (EOS_NEMO) call calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) case default - call MOM_error(FATAL, & - "calculate_compress: EOS%form_of_EOS is not valid.") + call MOM_error(FATAL, "calculate_compress: EOS%form_of_EOS is not valid.") end select + if (EOS%kg_m3_to_R /= 1.0) then ; do i=is,ie + rho(i) = EOS%kg_m3_to_R * rho(i) + enddo ; endif + if (EOS%L_T_to_m_s /= 1.0) then ; do i=is,ie + drho_dp(i) = EOS%L_T_to_m_s**2 * drho_dp(i) + enddo ; endif + end subroutine calculate_compress_array -!> Calculate density and compressibility for a scalar. This just promotes the scalar to an array with a singleton -!! dimension and calls calculate_compress_array +!> 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. 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 (PSU) - real, intent(in) :: pressure !< Pressure (Pa) - real, intent(out) :: rho !< In situ density in kg m-3. - real, intent(out) :: drho_dp !< The partial derivative of density with pressure - !! (also the inverse of the square of sound speed) in s2 m-2. + 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(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] type(EOS_type), pointer :: EOS !< Equation of state structure + ! Local variables real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa if (.not.associated(EOS)) call MOM_error(FATAL, & @@ -652,12 +963,33 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) rho = rhoa(1) ; drho_dp = drho_dpa(1) end subroutine calculate_compress_scalar -!> Calls the appropriate subroutine to alculate analytical and nearly-analytical + + +!> This subroutine returns a two point integer array indicating the domain of i-indices +!! to work on in EOS calls based on information from a hor_index type +function EOS_domain(HI, halo) result(EOSdom) + type(hor_index_type), intent(in) :: HI !< The horizontal index structure + integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. + integer, dimension(2) :: EOSdom !< The index domain that the EOS will work on, taking into account + !! that the arrays inside the EOS routines will start at 1. + + ! Local variables + integer :: halo_sz + + halo_sz = 0 ; if (present(halo)) halo_sz = halo + + EOSdom(1) = HI%isc - (HI%isd-1) - halo_sz + EOSdom(2) = HI%iec - (HI%isd-1) + halo_sz + +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 !! non-Boussinesq model. There are essentially no free assumptions, apart from the !! use of Bode's rule to do the horizontal integrals, and from a truncation in the -!! series for log(1-eps/1+eps) that assumes that |eps| < . +!! series for log(1-eps/1+eps) that assumes that |eps| < 0.34. subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & dza, intp_dza, intx_dza, inty_dza, halo_size, & bathyP, dP_tiny, useMassWghtInterp) @@ -667,36 +999,40 @@ subroutine 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 [Pa]. + intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure at the bottom of the layer [Pa]. + intent(in) :: p_b !< Pressure at the bottom of the layer [R L2 T-2 ~> Pa] or [Pa] real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out - !! to reduce the magnitude of each of the integrals, m3 kg-1. The - !! calculation is mathematically identical with different values of + !! 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. type(EOS_type), pointer :: 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 [m2 s-2]. + !! the layer [L2 T-2 ~> m2 s-2] or [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 [Pa m2 s-2]. + !! 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 [m2 s-2]. + !! the x grid spacing [L2 T-2 ~> m2 s-2] or [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 [m2 s-2]. + !! the y grid spacing [L2 T-2 ~> m2 s-2] or [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 [Pa] + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] real, optional, intent(in) :: dP_tiny !< A miniscule pressure change with - !! the same units as p_t (Pa?) + !! the same units as p_t [R L2 T-2 ~> Pa] or [Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. + ! Local variables + real :: pres_scale ! 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] if (.not.associated(EOS)) call MOM_error(FATAL, & "int_specific_vol_dp called with an unassociated EOS_type EOS.") @@ -707,14 +1043,14 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & bathyP, dP_tiny, useMassWghtInterp) else ; select case (EOS%form_of_EOS) case (EOS_LINEAR) - call int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, EOS%Rho_T0_S0, & - EOS%dRho_dT, EOS%dRho_dS, dza, intp_dza, & - intx_dza, inty_dza, halo_size, & - bathyP, dP_tiny, useMassWghtInterp) + 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, & + 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) + 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) case default call int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & dza, intp_dza, intx_dza, inty_dza, halo_size, & @@ -726,9 +1062,8 @@ end subroutine int_specific_vol_dp !> This subroutine calculates analytical and nearly-analytical integrals of !! pressure anomalies across layers, which are required for calculating the !! finite-volume form pressure accelerations in a Boussinesq model. -subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & - dpa, intz_dpa, intx_dpa, inty_dpa, & - bathyT, dz_neglect, useMassWghtInterp) +subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dpa, & + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) type(hor_index_type), intent(in) :: HII !< Ocean horizontal index structures for the input arrays type(hor_index_type), intent(in) :: HIO !< Ocean horizontal index structures for the output arrays real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & @@ -736,56 +1071,76 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity [ppt] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. + intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to - !! reduce the magnitude of each of the integrals. - real, intent(in) :: rho_0 !< A density [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 [m2 Z-1 s-2 ~> m s-2]. + 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 + !! 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 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] type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - intent(inout) :: dpa !< The change in the pressure anomaly across the layer [Pa]. + intent(inout) :: dpa !< The change in the pressure anomaly + !! across the layer [R L2 T-2 ~> Pa] or [Pa] real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - optional, intent(inout) :: intz_dpa !< The integral through the thickness of the layer of - !! the pressure anomaly relative to the anomaly at the - !! top of the layer [Pa Z ~> Pa m]. + optional, intent(inout) :: 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] real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & - optional, intent(inout) :: 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 [Pa]. + optional, intent(inout) :: 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] real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & - optional, intent(inout) :: 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 [Pa]. + optional, intent(inout) :: 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] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. + optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. + ! 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 :: pres_scale ! A multiplicative factor to convert pressure into Pa [Pa T2 R-1 L-2 ~> 1] if (.not.associated(EOS)) call MOM_error(FATAL, & "int_density_dz called with an unassociated EOS_type EOS.") if (EOS%EOS_quadrature) then - call int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, & - EOS, dpa, intz_dpa, intx_dpa, inty_dpa, & - bathyT, dz_neglect, useMassWghtInterp) + call int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dpa, & + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) else ; select case (EOS%form_of_EOS) case (EOS_LINEAR) - call int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, & - EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, & - dpa, intz_dpa, intx_dpa, inty_dpa, & - bathyT, dz_neglect, useMassWghtInterp) + rho_scale = EOS%kg_m3_to_R + if (rho_scale /= 1.0) then + call int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, & + rho_scale*EOS%Rho_T0_S0, rho_scale*EOS%dRho_dT, rho_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, HII, HIO, & + EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, & + dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) + endif case (EOS_WRIGHT) - call int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, & - dpa, intz_dpa, intx_dpa, inty_dpa, & - bathyT, dz_neglect, useMassWghtInterp) + 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 + call int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, & + dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & + dz_neglect, useMassWghtInterp, rho_scale, pres_scale) + else + call int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, & + dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & + dz_neglect, useMassWghtInterp) + endif case default - call int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, & - EOS, dpa, intz_dpa, intx_dpa, inty_dpa, & - bathyT, dz_neglect, useMassWghtInterp) + call int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dpa, & + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) end select ; endif end subroutine int_density_dz @@ -801,9 +1156,11 @@ logical function query_compressible(EOS) end function query_compressible !> Initializes EOS_type by allocating and reading parameters -subroutine EOS_init(param_file, EOS) +subroutine EOS_init(param_file, EOS, US) type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: EOS !< Equation of state structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + optional :: US ! Local variables #include "version_variable.h" character(len=40) :: mdl = "MOM_EOS" ! This module's name. @@ -897,6 +1254,12 @@ subroutine EOS_init(param_file, EOS) "should only be used along with TFREEZE_FORM = TFREEZE_TEOS10 .") endif + ! Unit conversions + EOS%m_to_Z = 1. ; if (present(US)) EOS%m_to_Z = US%m_to_Z + EOS%kg_m3_to_R = 1. ; if (present(US)) EOS%kg_m3_to_R = US%kg_m3_to_R + 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 end subroutine EOS_init @@ -915,11 +1278,11 @@ subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Co !! in [kg m-3 degC-1] real , optional, intent(in) :: dRho_dS !< Partial derivative of density with salinity !! in [kg m-3 ppt-1] - real , optional, intent(in) :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 [degC]. + real , optional, intent(in) :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 [degC] real , optional, intent(in) :: dTFr_dS !< The derivative of freezing point with salinity - !! in [degC ppt-1]. + !! in [degC ppt-1] real , optional, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure - !! in [degC Pa-1]. + !! in [degC Pa-1] if (present(form_of_EOS )) EOS%form_of_EOS = form_of_EOS if (present(form_of_TFreeze)) EOS%form_of_TFreeze = form_of_TFreeze @@ -983,56 +1346,63 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, type(hor_index_type), intent(in) :: HII !< Horizontal index type for input variables. type(hor_index_type), intent(in) :: HIO !< Horizontal index type for output variables. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: T !< Potential temperature of the layer [degC]. + intent(in) :: T !< Potential temperature of the layer [degC] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: S !< Salinity of the layer [ppt]. + intent(in) :: S !< Salinity of the layer [ppt] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. + intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density [kg m-3], that is + 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 !! subtracted out to reduce the magnitude !! of each of the integrals. - real, intent(in) :: rho_0 !< A density [kg m-3], that is used + real, intent(in) :: rho_0 !< A density [R ~> kg m-3] or [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 [m2 Z-1 s-2 ~> m s-2]. + 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] type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - intent(inout) :: dpa !< The change in the pressure anomaly - !! across the layer [Pa]. + intent(inout) :: dpa !< The change in the pressure anomaly + !! across the layer [R L2 T-2 ~> Pa] or [Pa] real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - optional, intent(inout) :: intz_dpa !< The integral through the thickness of the + optional, intent(inout) :: intz_dpa !< The integral through the thickness of the !! layer of the pressure anomaly relative to the - !! anomaly at the top of the layer [Pa Z ~> Pa m]. + !! anomaly at the top of the layer [R L2 Z T-2 ~> Pa m] real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & - optional, intent(inout) :: intx_dpa !< The integral in x of the difference between + optional, intent(inout) :: 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 [Pa]. + !! layer divided by the x grid spacing [R L2 T-2 ~> Pa] real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & - optional, intent(inout) :: inty_dpa !< The integral in y of the difference between + optional, intent(inout) :: 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 [Pa]. + !! layer divided by the y grid spacing [R L2 T-2 ~> Pa] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. + optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. - real :: T5(5), S5(5), p5(5), r5(5) - real :: rho_anom ! The depth averaged density anomaly [kg m-3]. - real :: w_left, w_right + ! 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 :: w_left, w_right ! Left and right weights [nondim] real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. - real :: GxRho, I_Rho - 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]. - real :: iDenom ! The inverse of the denominator in the weights [Z-2 ~> m-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 :: 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 :: 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 :: hWght ! A pressure-thickness below topography [Z ~> m] + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m] + real :: iDenom ! The inverse of the denominator in the weights [Z-2 ~> m-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 :: intz(5) ! The gravitational acceleration times the integrals of density - ! with height at the 5 sub-column locations [Pa]. + ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] or [Pa] logical :: do_massWeight ! Indicates whether to do mass weighting. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m, n, ioff, joff @@ -1046,7 +1416,9 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, is = HIO%isc + ioff ; ie = HIO%iec + ioff js = HIO%jsc + joff ; je = HIO%jec + joff - GxRho = G_e * rho_0 + rho_scale = EOS%kg_m3_to_R + GxRho = EOS%RL2_T2_to_Pa * G_e * rho_0 + rho_ref_mks = rho_ref * EOS%R_to_kg_m3 I_Rho = 1.0 / rho_0 do_massWeight = .false. @@ -1064,7 +1436,11 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, T5(n) = T(i,j) ; S5(n) = S(i,j) p5(n) = -GxRho*(z_t(i,j) - 0.25*real(n-1)*dz) enddo - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref) + 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 ! Use Bode'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)) @@ -1106,7 +1482,11 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, do n=2,5 T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = p5(n-1) + GxRho*0.25*dz enddo - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref) + 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 ! Use Bode'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))) @@ -1148,7 +1528,11 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, T5(n) = T5(1) ; S5(n) = S5(1) p5(n) = p5(n-1) + GxRho*0.25*dz enddo - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref) + 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 ! Use Bode'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))) @@ -1165,8 +1549,7 @@ end subroutine int_density_dz_generic !! T and S are linear profiles. subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & rho_0, G_e, dz_subroundoff, bathyT, HII, HIO, EOS, dpa, & - intz_dpa, intx_dpa, inty_dpa, & - useMassWghtInterp) + intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp) type(hor_index_type), intent(in) :: HII !< Ocean horizontal index structures for the input arrays type(hor_index_type), intent(in) :: HIO !< Ocean horizontal index structures for the output arrays real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & @@ -1178,35 +1561,35 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S_b !< Salinity at the cell bottom [ppt] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< The geometric height at the top of the layer, - !! in depth units [Z ~> m]. + intent(in) :: z_t !< The geometric height at the top of the layer [Z ~> m] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< The geometric height at the bottom of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to - !! reduce the magnitude of each of the integrals. - real, intent(in) :: rho_0 !< A density [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 [m2 Z-1 s-2 ~> m s-2]. - real, intent(in) :: dz_subroundoff !< A miniscule thickness change [Z ~> m]. + 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] or [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 + !! 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 miniscule thickness change [Z ~> m] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. + intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - intent(inout) :: dpa !< The change in the pressure anomaly across the layer [Pa]. + intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa] real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(inout) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer [Pa Z]. + !! top of the layer [R L2 Z T-2 ~> Pa Z] real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(inout) :: 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 [Pa]. + !! divided by the x grid spacing [R L2 T-2 ~> Pa] real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & optional, intent(inout) :: 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 [Pa]. + !! divided by the y grid spacing [R L2 T-2 ~> Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. + ! This subroutine calculates (by numerical quadrature) integrals of ! pressure anomalies across layers, which are required for calculating the ! finite-volume form pressure accelerations in a Boussinesq model. The one @@ -1219,32 +1602,37 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! a linear interpolation is used to compute intermediate values. ! Local variables - real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Temperatures along a line of subgrid locations [degC]. - real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Salinities along a line of subgrid locations [ppt]. - real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Pressures along a line of subgrid locations [Pa]. - real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Densities along a line of subgrid locations [kg m-3]. - real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Temperatures at an array of subgrid locations [degC]. - real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Salinities at an array of subgrid locations [ppt]. - real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Pressures at an array of subgrid locations [Pa]. - real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Densities at an array of subgrid locations [kg m-3]. - real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim]. - real :: rho_anom ! A density anomaly [kg m-3]. - real :: w_left, w_right ! Left and right weights [nondim]. + real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Temperatures along a line of subgrid locations [degC] + real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Salinities along a line of subgrid locations [ppt] + real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Pressures along a line of subgrid locations, never + ! rescaled from Pa [Pa] + real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Densities anomalies along a line of subgrid + ! locations [R ~> kg m-3] or [kg m-3] + real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Temperatures at an array of subgrid locations [degC] + real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Salinities at an array of subgrid locations [ppt] + real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Pressures at an array of subgrid locations [Pa] + real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Densities at an array of subgrid locations + ! [R ~> kg m-3] or [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 :: 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 [Pa]. - real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim]. - real :: GxRho ! Gravitational acceleration times density [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. - real :: I_Rho ! The inverse of the reference density [m3 kg-1]. - real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points [Z ~> m]. - real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations [Z ~> m]. - real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations [Z ~> m]. - real :: weight_t, weight_b ! Nondimensional weights of the top and bottom. - real :: massWeightToggle ! A nondimensional toggle factor (0 or 1). - 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 :: hWght ! A topographically limited thicknes weight [Z ~> m]. - real :: hL, hR ! Thicknesses to the left and right [Z ~> m]. - real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2]. + ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] or [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 :: 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(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points [Z ~> m] + real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations [Z ~> m] + real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations [Z ~> m] + real :: weight_t, weight_b ! Nondimensional weights of the top and bottom [nondim] + real :: massWeightToggle ! A nondimensional 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 :: hWght ! A topographically limited thicknes weight [Z ~> m] + real :: hL, hR ! Thicknesses to the left and right [Z ~> m] + real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2] integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n integer :: iin, jin, ioff, joff integer :: pos @@ -1254,7 +1642,9 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & Isq = HIO%IscB ; Ieq = HIO%IecB ; Jsq = HIO%JscB ; Jeq = HIO%JecB - GxRho = G_e * rho_0 + rho_scale = EOS%kg_m3_to_R + GxRho = EOS%RL2_T2_to_Pa * G_e * rho_0 + rho_ref_mks = rho_ref * EOS%R_to_kg_m3 I_Rho = 1.0 / rho_0 massWeightToggle = 0. if (present(useMassWghtInterp)) then @@ -1280,7 +1670,11 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & T5(i*5+n) = wt_t(n) * T_t(iin,jin) + wt_b(n) * T_b(iin,jin) enddo enddo - call calculate_density_array(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS, rho_ref ) + if (rho_scale /= 1.0) then + call calculate_density_array(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS, rho_ref=rho_ref_mks, scale=rho_scale) + else + call calculate_density_array(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS, rho_ref=rho_ref_mks) + endif do i=isq,ieq+1 ; iin = i+ioff ! Use Bode's rule to estimate the pressure anomaly change. @@ -1360,7 +1754,11 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & enddo enddo - call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, rho_ref) + 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 do I=Isq,Ieq ; iin = i+ioff intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j) @@ -1439,8 +1837,14 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & enddo enddo - call calculate_density_array(T15(15*HIO%isc+1:), S15(15*HIO%isc+1:), p15(15*HIO%isc+1:), & - r15(15*HIO%isc+1:), 1, 15*(HIO%iec-HIO%isc+1), EOS, rho_ref) + if (rho_scale /= 1.0) then + call calculate_density_array(T15(15*HIO%isc+1:), S15(15*HIO%isc+1:), p15(15*HIO%isc+1:), & + r15(15*HIO%isc+1:), 1, 15*(HIO%iec-HIO%isc+1), EOS, & + rho_ref=rho_ref_mks, scale=rho_scale) + else + call calculate_density_array(T15(15*HIO%isc+1:), S15(15*HIO%isc+1:), p15(15*HIO%isc+1:), & + r15(15*HIO%isc+1:), 1, 15*(HIO%iec-HIO%isc+1), EOS, rho_ref=rho_ref_mks) + endif do i=HIO%isc,HIO%iec ; iin = i+ioff intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1) @@ -1470,19 +1874,23 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t real, intent(in) :: T_b !< Potential temperatue 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) :: 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 to g*rho_ref*z_t [Pa] - real, intent(in) :: P_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out [Pa] - real, intent(in) :: rho_ref !< Reference density with which calculation are anomalous to - real, intent(in) :: G_e !< Gravitational acceleration [m2 Z-1 s-2 ~> m s-2] + 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 to g*rho_ref*z_t [R L2 T-2 ~> Pa] + real, intent(in) :: P_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out [R L2 T-2 ~> Pa] + real, intent(in) :: rho_ref !< Reference density with which calculation are anomalous to [R ~> kg m-3] + real, intent(in) :: G_e !< Gravitational acceleration [L2 Z-1 T-2 ~> m s-2] type(EOS_type), pointer :: EOS !< Equation of state structure - real, intent(out) :: P_b !< Pressure at the bottom of the cell [Pa] - real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt [Z ~> m]. - real, optional, intent(in) :: z_tol !< The tolerance in finding z_out [Z ~> m]. + real, intent(out) :: P_b !< Pressure at the bottom of the cell [R L2 T-2 ~> Pa] + real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt [Z ~> m] + real, optional, intent(in) :: z_tol !< The tolerance in finding z_out [Z ~> m] + ! Local variables - real :: top_weight, bottom_weight, rho_anom, w_left, w_right, GxRho, dz, dp, F_guess, F_l, F_r - real :: Pa, Pa_left, Pa_right, Pa_tol ! Pressure anomalies, P = integral of g*(rho-rho_ref) dz + real :: dp ! Pressure thickness of the layer [R L2 T-2 ~> Pa] + real :: F_guess, F_l, F_r ! Fractional positions [nondim] + real :: GxRho ! The product of the gravitational acceleration and reference density [R L2 Z-1 T-2 ~> Pa m-1] + real :: Pa, Pa_left, Pa_right, Pa_tol ! Pressure anomalies, P = integral of g*(rho-rho_ref) dz [R L2 T-2 ~> Pa] + character(len=240) :: msg GxRho = G_e * rho_ref @@ -1505,9 +1913,10 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t Pa_left = P_t - P_tgt ! Pa_left < 0 F_r = 1. Pa_right = P_b - P_tgt ! Pa_right > 0 - Pa_tol = GxRho * 1.e-5 ! 1e-5 has dimensions of m, but should be converted to the units of z. + Pa_tol = GxRho * 1.0e-5*EOS%m_to_Z if (present(z_tol)) Pa_tol = GxRho * z_tol - F_guess = F_l - Pa_left / ( Pa_right -Pa_left ) * ( F_r - F_l ) + + F_guess = F_l - Pa_left / (Pa_right - Pa_left) * (F_r - F_l) Pa = Pa_right - Pa_left ! To get into iterative loop do while ( abs(Pa) > Pa_tol ) @@ -1515,21 +1924,21 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t Pa = frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, F_guess, EOS) - ( P_tgt - P_t ) if (PaPa_right) then - write(0,*) Pa_left,Pa,Pa_right,P_t-P_tgt,P_b-P_tgt - stop 'Blurgh! Too positive' + write(msg,*) Pa_left,Pa,Pa_right,P_t-P_tgt,P_b-P_tgt + call MOM_error(FATAL, 'find_depth_of_pressure_in_cell out of bounds positive: /n'//msg) elseif (Pa>0.) then Pa_right = Pa F_r = F_guess else ! Pa == 0 return endif - F_guess = F_l - Pa_left / ( Pa_right -Pa_left ) * ( F_r - F_l ) + F_guess = F_l - Pa_left / (Pa_right - Pa_left) * (F_r - F_l) enddo @@ -1544,15 +1953,22 @@ 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, intent(in) :: S_b !< Salinity at the cell bottom [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 [kg m-3], that is subtracted out to + 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) :: G_e !< The Earth's gravitational acceleration [m s-2] - real, intent(in) :: pos !< The fractional vertical position, 0 to 1 [nondim]. + real, intent(in) :: G_e !< The Earth's gravitational acceleration [L2 Z-1 T-2 ~> m s-2] + real, intent(in) :: pos !< The fractional vertical position, 0 to 1 [nondim] type(EOS_type), pointer :: EOS !< Equation of state structure + real :: fract_dp_at_pos !< The change in pressure from the layer top to + !! fractional position pos [R L2 T-2 ~> Pa] ! Local variables - real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. - real :: dz, top_weight, bottom_weight, rho_ave - real, dimension(5) :: T5, S5, p5, rho5 + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] + 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 ! Tempratures at quadrature points [degC] + real, dimension(5) :: S5 ! Salinities at quadrature points [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 do n=1,5 @@ -1564,10 +1980,10 @@ real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EO T5(n) = top_weight * T_t + bottom_weight * T_b p5(n) = ( top_weight * z_t + bottom_weight * z_b ) * ( G_e * rho_ref ) enddo - call calculate_density_array(T5, S5, p5, rho5, 1, 5, EOS) + call calculate_density_1d(T5, S5, p5, rho5, EOS) rho5(:) = rho5(:) !- rho_ref ! Work with anomalies relative to rho_ref - ! Use Boole's rule to estimate the average density + ! Use Bode's rule to estimate the average density rho_ave = C1_90*(7.0*(rho5(1)+rho5(5)) + 32.0*(rho5(2)+rho5(4)) + 12.0*rho5(3)) dz = ( z_t - z_b ) * pos @@ -1578,9 +1994,9 @@ end function frac_dp_at_pos ! ========================================================================== !> Compute pressure gradient force integrals for the case where T and S !! are parabolic profiles -subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & - z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, & - EOS, dpa, intz_dpa, intx_dpa, inty_dpa) +subroutine int_density_dz_generic_ppm(T, T_t, T_b, S, S_t, S_b, & + z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, & + EOS, dpa, intz_dpa, intx_dpa, inty_dpa) type(hor_index_type), intent(in) :: HII !< Ocean horizontal index structures for the input arrays type(hor_index_type), intent(in) :: HIO !< Ocean horizontal index structures for the output arrays @@ -1597,29 +2013,29 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S_b !< Salinity at the cell bottom [ppt] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer [Z ~> m]. + intent(in) :: z_t !< Height at the top of the layer [Z ~> m] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to - !! reduce the magnitude of each of the integrals. - real, intent(in) :: rho_0 !< A density [kg m-3], that is used to calculate the - !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. + 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 + !! 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 + !! 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 [m s-2] type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - intent(inout) :: dpa !< The change in the pressure anomaly across the layer [Pa]. + intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa] real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(inout) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer [Pa Z ~> Pa m]. + !! top of the layer [R L2 Z T-2 ~> Pa m] real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(inout) :: 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 [Pa]. + !! divided by the x grid spacing [R L2 T-2 ~> Pa] real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & optional, intent(inout) :: 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 [Pa]. + !! divided by the y grid spacing [R L2 T-2 ~> Pa] ! This subroutine calculates (by numerical quadrature) integrals of ! pressure anomalies across layers, which are required for calculating the @@ -1632,12 +2048,21 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & ! vertical. The top and bottom values within each layer are provided and ! a linear interpolation is used to compute intermediate values. +!### Please note that this subroutine has not been verified to work properly! + ! Local variables - real :: T5(5), S5(5), p5(5), r5(5) - real :: rho_anom - real :: w_left, w_right, intz(5) + real :: T5(5), S5(5) + 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 :: rho_anom ! The integrated density anomaly [R ~> kg m-3] or [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] real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. - real :: GxRho, I_Rho + 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 :: 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 real :: weight_t, weight_b real :: s0, s1, s2 ! parabola coefficients for S [ppt] @@ -1663,7 +2088,9 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & is = HIO%isc + ioff ; ie = HIO%iec + ioff js = HIO%jsc + joff ; je = HIO%jec + joff - GxRho = G_e * rho_0 + rho_scale = EOS%kg_m3_to_R + GxRho = EOS%RL2_T2_to_Pa * G_e * rho_0 + rho_ref_mks = rho_ref * EOS%R_to_kg_m3 I_Rho = 1.0 / rho_0 ! ============================= @@ -1691,23 +2118,22 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & T5(n) = t0 + t1 * xi + t2 * xi**2 enddo - call calculate_density(T5, S5, p5, r5, 1, 5, EOS) + 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 ! Use Bode'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 + rho_anom = C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) - rho_anom = 1000.0 + S(i,j) - rho_ref dpa(i-ioff,j-joff) = G_e*dz*rho_anom ! Use a Bode's-rule-like fifth-order accurate estimate of ! the double integral of the pressure anomaly. - !r5 = r5 - rho_ref - !if (present(intz_dpa)) intz_dpa(i,j) = 0.5*G_e*dz**2 * & - ! (rho_anom - C1_90*(16.0*(r5(4)-r5(2)) + 7.0*(r5(5)-r5(1))) ) + if (present(intz_dpa)) intz_dpa(i,j) = 0.5*G_e*dz**2 * & + (rho_anom - C1_90*(16.0*(r5(4)-r5(2)) + 7.0*(r5(5)-r5(1))) ) - intz_dpa(i-ioff,j-joff) = 0.5 * G_e * dz**2 * ( 1000.0 - rho_ref + s0 + s1/3.0 + & - s2/6.0 ) enddo ; enddo ! end loops on j and i ! ================================================== @@ -1755,11 +2181,15 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & T5(n) = t0 + t1 * xi + t2 * xi**2 enddo - call calculate_density(T5, S5, p5, r5, 1, 5, EOS) + 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 ! Use Bode'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) + 12.0*r5(3)) ) enddo intx_dpa(i-ioff,j-joff) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & 12.0*intz(3)) @@ -1802,7 +2232,11 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & S_node(9) = 0.5 * ( S_node(6) + S_node(8) ) S_node(7) = 0.5 * ( S_node(3) + S_node(4) ) - call calculate_density( T_node, S_node, p_node, r_node, 1, 9, EOS ) + if (rho_scale /= 1.0) then + call calculate_density( T_node, S_node, p_node, r_node, 1, 9, EOS, rho_ref=rho_ref_mks, scale=rho_scale ) + else + call calculate_density( T_node, S_node, p_node, r_node, 1, 9, EOS, rho_ref=rho_ref_mks) + endif r_node = r_node - rho_ref call compute_integral_quadratic( x, y, r_node, intx_dpa(i-ioff,j-joff) ) @@ -2017,44 +2451,44 @@ end subroutine evaluate_shape_quadratic !! pressure across layers, which are required for calculating the finite-volume !! form pressure accelerations in a non-Boussinesq model. There are essentially !! no free assumptions, apart from the use of Bode's rule quadrature to do the integrals. -subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & - dza, intp_dza, intx_dza, inty_dza, halo_size, & +subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, dza, & + intp_dza, intx_dza, inty_dza, halo_size, & bathyP, dP_neglect, useMassWghtInterp) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: T !< Potential temperature of the layer [degC]. + intent(in) :: T !< Potential temperature of the layer [degC] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity of the layer [ppt]. + intent(in) :: S !< Salinity of the layer [ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_t !< Pressure atop the layer [Pa]. + intent(in) :: p_t !< Pressure atop the layer [R L2 T-2 ~> Pa] or [Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure below the layer [Pa]. - real, intent(in) :: alpha_ref !< A mean specific volume that is - !! subtracted out to reduce the magnitude of each of the - !! integrals [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. + intent(in) :: p_b !< Pressure below the layer [R L2 T-2 ~> Pa] or [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. type(EOS_type), pointer :: 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 [m2 s-2]. + !! across the layer [L2 T-2 ~> m2 s-2] or [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 [Pa m2 s-2]. + 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 [m2 s-2]. + 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] 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 [m2 s-2]. + 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] 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 [Pa] + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t (Pa?) + !! the same units as p_t [R L2 T-2 ~> Pa] or [Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -2065,19 +2499,26 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & ! Bode'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), S5(5), p5(5), a5(5) - real :: alpha_anom ! The depth averaged specific density anomaly [m3 kg-1]. - real :: dp ! The pressure change through a layer [Pa]. -! real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [Pa]. - real :: hWght ! A pressure-thickness below topography [Pa]. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. - real :: iDenom ! The inverse of the denominator in the weights [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]. + ! 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 :: a5(5) ! Specific volumes at five quadrature points [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 :: 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] + 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 [m2 s-2]. + ! 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 @@ -2088,6 +2529,10 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & 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 = EOS%R_to_kg_m3 + RL2_T2_to_Pa = EOS%RL2_T2_to_Pa + alpha_ref_mks = alpha_ref * EOS%kg_m3_to_R + do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then do_massWeight = .true. @@ -2101,9 +2546,14 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & 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) = p_b(i,j) - 0.25*real(n-1)*dp + p5(n) = RL2_T2_to_Pa * (p_b(i,j) - 0.25*real(n-1)*dp) enddo - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref) + + 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 ! Use Bode'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)) @@ -2139,15 +2589,19 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & ! T, S, and p are interpolated in the horizontal. The p interpolation ! is linear, but for T and S it may be thickness wekghted. - p5(1) = wt_L*p_b(i,j) + wt_R*p_b(i+1,j) + p5(1) = RL2_T2_to_Pa * (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) - 0.25*dp + T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = p5(n-1) - RL2_T2_to_Pa * 0.25*dp enddo - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref) + 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 ! Use Bode'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)) + & @@ -2183,14 +2637,18 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & ! T, S, and p are interpolated in the horizontal. The p interpolation ! is linear, but for T and S it may be thickness wekghted. - p5(1) = wt_L*p_b(i,j) + wt_R*p_b(i,j+1) + p5(1) = RL2_T2_to_Pa * (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) = p5(n-1) - 0.25*dp + T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = RL2_T2_to_Pa * (p5(n-1) - 0.25*dp) enddo - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref) + 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 ! Use Bode'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)) + & @@ -2212,42 +2670,42 @@ 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(HI%isd:HI%ied,HI%jsd:HI%jed), & - 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 [degC] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - 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 [degC] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S_t !< Salinity at the top the layer [ppt]. + intent(in) :: S_t !< Salinity at the top the layer [ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S_b !< Salinity at the bottom the layer [ppt]. + intent(in) :: S_b !< Salinity at the bottom the layer [ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_t !< Pressure atop the layer [Pa]. + intent(in) :: p_t !< Pressure atop the layer [R L2 T-2 ~> Pa] or [Pa] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure below the layer [Pa]. - real, intent(in) :: alpha_ref !< A mean specific volume that is - !! subtracted out to reduce the magnitude of each of the - !! integrals [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 !< A miniscule pressure change with - !! the same units as p_t (Pa?) + intent(in) :: p_b !< Pressure below the layer [R L2 T-2 ~> Pa] or [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] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: bathyP !< The pressure at the bathymetry [Pa] + intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] type(EOS_type), pointer :: 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 [m2 s-2]. + !! across 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 [Pa m2 s-2]. + 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 [m2 s-2]. + 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] 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 [m2 s-2]. + 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] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -2258,23 +2716,33 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, ! Bode'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, dimension(5) :: T5, S5, p5, a5 - real, dimension(15) :: T15, S15, p15, a15 - real :: wt_t(5), wt_b(5) + 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 :: 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 :: wt_t(5), wt_b(5) ! Weights of top and bottom values at quadrature points [nondim] real :: T_top, T_bot, S_top, S_bot, P_top, P_bot - real :: alpha_anom ! The depth averaged specific density anomaly [m3 kg-1]. - real :: dp ! The pressure change through a layer [Pa]. - real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [Pa]. - real :: hWght ! A pressure-thickness below topography [Pa]. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. - real :: iDenom ! The inverse of the denominator in the weights [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 :: alpha_anom ! The depth averaged specific density anomaly [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] + 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 [m2 s-2]. + ! 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. logical :: do_massWeight ! Indicates whether to do mass weighting. integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n, pos @@ -2284,6 +2752,10 @@ 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 = EOS%R_to_kg_m3 + RL2_T2_to_Pa = EOS%RL2_T2_to_Pa + alpha_ref_mks = alpha_ref * EOS%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) @@ -2295,11 +2767,15 @@ 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) = wt_t(n) * p_t(i,j) + wt_b(n) * p_b(i,j) + p5(n) = RL2_T2_to_Pa * (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 - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref) + 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 ! Use Bode'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)) @@ -2350,13 +2826,17 @@ 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) = wt_t(n) * P_top + wt_b(n) * P_bot + p15(pos+n) = RL2_T2_to_Pa * (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 - call calculate_spec_vol(T15, S15, p15, a15, 1, 15, EOS, alpha_ref) + 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 intp(1) = dza(i,j) ; intp(5) = dza(i+1,j) do m=2,4 @@ -2409,13 +2889,17 @@ 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) = wt_t(n) * P_top + wt_b(n) * P_bot + p15(pos+n) = RL2_T2_to_Pa * (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 - call calculate_spec_vol(T15, S15, p15, a15, 1, 15, EOS, alpha_ref) + 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 intp(1) = dza(i,j) ; intp(5) = dza(i,j+1) do m=2,4 @@ -2433,21 +2917,18 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, end subroutine int_spec_vol_dp_generic_plm !> Convert T&S to Absolute Salinity and Conservative Temperature if using TEOS10 -subroutine convert_temp_salt_for_TEOS10(T, S, press, G, kd, mask_z, EOS) - use MOM_grid, only : ocean_grid_type - - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & +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] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & intent(inout) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: press !< Pressure at the top of the layer [Pa]. - type(EOS_type), pointer :: EOS !< Equation of state structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & intent(in) :: mask_z !< 3d mask regulating which points to convert. - integer, intent(in) :: kd !< The number of layers to work on + type(EOS_type), pointer :: EOS !< Equation of state structure - integer :: i,j,k + integer :: i, j, k real :: gsw_sr_from_sp, gsw_ct_from_pt, gsw_sa_from_sp real :: p @@ -2456,12 +2937,14 @@ subroutine convert_temp_salt_for_TEOS10(T, S, press, G, kd, mask_z, EOS) if ((EOS%form_of_EOS /= EOS_TEOS10) .and. (EOS%form_of_EOS /= EOS_NEMO)) return - do k=1,kd ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + 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)) -! p=press(k)/10000. !convert pascal to dbar -! S(i,j,k) = gsw_sa_from_sp(S(i,j,k),p,G%geoLonT(i,j),G%geoLatT(i,j)) - T(i,j,k) = gsw_ct_from_pt(S(i,j,k),T(i,j,k)) +! Get absolute salnity 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)) endif enddo ; enddo ; enddo end subroutine convert_temp_salt_for_TEOS10 @@ -2481,11 +2964,11 @@ subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, !! in [kg m-3 degC-1] real , optional, intent(out) :: dRho_dS !< Partial derivative of density with salinity !! in [kg m-3 ppt-1] - real , optional, intent(out) :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 [degC]. + real , optional, intent(out) :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 [degC] real , optional, intent(out) :: dTFr_dS !< The derivative of freezing point with salinity - !! [degC PSU-1]. + !! [degC PSU-1] real , optional, intent(out) :: dTFr_dp !< The derivative of freezing point with pressure - !! [degC Pa-1]. + !! [degC Pa-1] if (present(form_of_EOS )) form_of_EOS = EOS%form_of_EOS if (present(form_of_TFreeze)) form_of_TFreeze = EOS%form_of_TFreeze diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index bc490ca361..cd590aa611 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -408,7 +408,7 @@ end subroutine calculate_compress_wright !! 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, HII, HIO, & dpa, intz_dpa, intx_dpa, inty_dpa, & - bathyT, dz_neglect, useMassWghtInterp) + bathyT, dz_neglect, useMassWghtInterp, rho_scale, pres_scale) type(hor_index_type), intent(in) :: HII !< The horizontal index type for the input arrays. type(hor_index_type), intent(in) :: HIO !< The horizontal index type for the output arrays. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & @@ -420,40 +420,48 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out - !! to reduce the magnitude of each of the integrals. + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3] or [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 [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 [m2 Z-1 s-2 ~> m s-2]. + real, intent(in) :: rho_0 !< Density [R ~> kg m-3] or [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]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(inout) :: dpa !< The change in the pressure anomaly across the - !! layer [Pa]. + !! layer [R L2 T-2 ~> Pa] or [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(inout) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer [Pa Z ~> Pa m]. + !! at the top of the layer [R Z L2 T-2 ~> Pa m]. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(inout) :: 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 [Pa]. + !! layer divided by the x grid spacing [R L2 T-2 ~> Pa]. real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & optional, intent(inout) :: 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 [Pa]. + !! layer divided by the y grid spacing [R L2 T-2 ~> Pa]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. + real, optional, intent(in) :: rho_scale !< A multiplicative factor by which to scale density + !! 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]. ! Local variables real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed) :: al0_2d, p0_2d, lambda_2d real :: al0, p0, lambda real :: rho_anom ! The density anomaly from rho_ref [kg m-3]. real :: eps, eps2, rem - real :: GxRho, I_Rho + 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 :: p_ave, I_al0, I_Lzz real :: dz ! The layer thickness [Z ~> m]. real :: hWght ! A pressure-thickness below topography [Z ~> m]. @@ -464,7 +472,9 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, 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 [Pa]. + ! 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]. 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. @@ -480,8 +490,19 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, is = HIO%isc + ioff ; ie = HIO%iec + ioff js = HIO%jsc + joff ; je = HIO%jec + joff - GxRho = G_e * rho_0 - I_Rho = 1.0 / rho_0 + if (present(pres_scale)) then + GxRho = pres_scale * G_e * rho_0 ; g_Earth = pres_scale * G_e + Pa_to_RL2_T2 = 1.0 / pres_scale + else + GxRho = G_e * rho_0 ; g_Earth = G_e + Pa_to_RL2_T2 = 1.0 + endif + if (present(rho_scale)) then + g_Earth = g_Earth * rho_scale + rho_ref_mks = rho_ref / rho_scale ; I_Rho = rho_scale / rho_0 + else + rho_ref_mks = rho_ref ; I_Rho = 1.0 / rho_0 + endif do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then @@ -508,12 +529,12 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, ! rho(j) = (pressure(j) + p0) / (lambda + al0*(pressure(j) + p0)) - rho_anom = (p0 + p_ave)*(I_Lzz*I_al0) - rho_ref + rho_anom = (p0 + p_ave)*(I_Lzz*I_al0) - rho_ref_mks rem = I_Rho * (lambda * I_al0**2) * eps2 * & (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) - dpa(i-ioff,j-joff) = G_e*rho_anom*dz - 2.0*eps*rem + dpa(i-ioff,j-joff) = Pa_to_RL2_T2 * (g_Earth*rho_anom*dz - 2.0*eps*rem) if (present(intz_dpa)) & - intz_dpa(i-ioff,j-joff) = 0.5*G_e*rho_anom*dz**2 - dz*(1.0+eps)*rem + intz_dpa(i-ioff,j-joff) = Pa_to_RL2_T2 * (0.5*g_Earth*rho_anom*dz**2 - dz*(1.0+eps)*rem) enddo ; enddo if (present(intx_dpa)) then ; do j=js,je ; do I=Isq,Ieq @@ -551,13 +572,11 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, I_Lzz = 1.0 / (p0 + (lambda * I_al0) + p_ave) eps = 0.5*GxRho*dz*I_Lzz ; eps2 = eps*eps - intz(m) = G_e*dz*((p0 + p_ave)*(I_Lzz*I_al0) - rho_ref) - 2.0*eps * & - I_Rho * (lambda * I_al0**2) * eps2 * & - (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) + intz(m) = Pa_to_RL2_T2 * ( g_Earth*dz*((p0 + p_ave)*(I_Lzz*I_al0) - rho_ref_mks) - 2.0*eps * & + I_Rho * (lambda * I_al0**2) * eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) ) enddo ! Use Bode's rule to integrate the values. - intx_dpa(i-ioff,j-joff) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & - 12.0*intz(3)) + intx_dpa(i-ioff,j-joff) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3)) enddo ; enddo ; endif if (present(inty_dpa)) then ; do J=Jsq,Jeq ; do i=is,ie @@ -595,14 +614,13 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, I_Lzz = 1.0 / (p0 + (lambda * I_al0) + p_ave) eps = 0.5*GxRho*dz*I_Lzz ; eps2 = eps*eps - intz(m) = G_e*dz*((p0 + p_ave)*(I_Lzz*I_al0) - rho_ref) - 2.0*eps * & - I_Rho * (lambda * I_al0**2) * eps2 * & - (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) + intz(m) = Pa_to_RL2_T2 * ( g_Earth*dz*((p0 + p_ave)*(I_Lzz*I_al0) - rho_ref_mks) - 2.0*eps * & + I_Rho * (lambda * I_al0**2) * eps2 * (C1_3 + eps2*(0.2 + eps2*(C1_7 + C1_9*eps2))) ) enddo ! Use Bode's rule to integrate the values. - inty_dpa(i-ioff,j-joff) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & - 12.0*intz(3)) + inty_dpa(i-ioff,j-joff) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3)) enddo ; enddo ; endif + end subroutine int_density_dz_wright !> This subroutine calculates analytical and nearly-analytical integrals in @@ -613,7 +631,7 @@ end subroutine int_density_dz_wright !! 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) + bathyP, dP_neglect, useMassWghtInterp, SV_scale, pres_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 @@ -621,53 +639,66 @@ 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 [Pa]. + intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [Pa]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure at the top of the layer [Pa]. + intent(in) :: p_b !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [Pa]. real, intent(in) :: spv_ref !< A mean specific volume that is subtracted out - !! to reduce the magnitude of each of the integrals [m3 kg-1]. The calculation is - !! mathematically identical with different values of spv_ref, but this reduces the - !! effects of roundoff. + !! 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 [m2 s-2]. + !! the layer [T-2 ~> m2 s-2] or [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 [Pa m2 s-2]. + !! 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 [m2 s-2]. + !! the layer divided by the x grid spacing + !! [L2 T-2 ~> m2 s-2] or [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 [m2 s-2]. + !! the layer divided by the y grid spacing + !! [L2 T-2 ~> m2 s-2] or [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 [Pa] + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t [Pa] + !! the same units as p_t [R L2 T-2 ~> Pa] or [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 + !! 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]. ! Local variables real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d, p0_2d, lambda_2d - real :: al0, p0, lambda - real :: p_ave - real :: rem, eps, eps2 - real :: alpha_anom ! The depth averaged specific volume anomaly [m3 kg-1]. - real :: dp ! The pressure change through a layer [Pa]. - real :: hWght ! A pressure-thickness below topography [Pa]. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. - real :: iDenom ! The inverse of the denominator in the weights [Pa-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] + real :: al0_scale ! Scaling factor to convert al0 from MKS units [R-1 kg m-3 ~> 1] + real :: p0_scale ! Scaling factor to convert p0 from MKS units [R L2 T-2 Pa-1 ~> 1] + real :: lam_scale ! Scaling factor to convert lambda from MKS units [L2 s2 T-2 m-2 ~> 1] + real :: p_ave ! The layer average pressure [R L2 T-2 ~> Pa] + real :: rem ! [L2 T-2 ~> m2 s-2] + real :: eps, eps2 ! A nondimensional ratio and its square [nondim] + real :: alpha_anom ! The depth averaged specific volume 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 :: 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 [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_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. @@ -679,6 +710,14 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & 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 + + al0_scale = 1.0 ; if (present(SV_scale)) al0_scale = SV_scale + p0_scale = 1.0 + if (present(pres_scale)) then ; if (pres_scale /= 1.0) then + p0_scale = 1.0 / pres_scale + endif ; endif + lam_scale = al0_scale * p0_scale + do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then do_massWeight = .true. @@ -688,10 +727,11 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & ! "dP_neglect must be present if useMassWghtInterp is present and true.") endif ; endif + ! alpha(j) = (lambda + al0*(pressure(j) + p0)) / (pressure(j) + p0) do j=jsh,jeh ; do i=ish,ieh - 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) = 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 = 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 55b3835681..623db27ad3 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -339,42 +339,43 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted - !! out to reduce the magnitude of each of the - !! integrals. - real, intent(in) :: rho_0_pres !< A density [kg m-3], that is used to calculate + real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3] or [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 - !! here. - real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. + !! 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]. real, intent(in) :: dRho_dT !< The derivative of density with temperature, - !! [kg m-3 degC-1]. + !! [R degC-1 ~> kg m-3 degC-1] or [kg m-3 degC-1]. real, intent(in) :: dRho_dS !< The derivative of density with salinity, - !! in [kg m-3 ppt-1]. + !! in [R ppt-1 ~> kg m-3 ppt-1] or [kg m-3 ppt-1]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the - !! layer [Pa]. + !! layer [R L2 T-2 ~> Pa] or [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%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 [Pa Z]. + !! at the top of the layer [R L2 Z T-2 ~> Pa Z] or [Pa Z]. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%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 [Pa]. + !! layer divided by the x grid spacing [R L2 T-2 ~> Pa] or [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%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 [Pa]. + !! layer divided by the y grid spacing [R L2 T-2 ~> Pa] or [Pa]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. + ! Local variables - real :: rho_anom ! The density anomaly from rho_ref [kg m-3]. - real :: raL, raR ! rho_anom to the left and right [kg m-3]. + real :: rho_anom ! The density anomaly from rho_ref [R ~> kg m-3]. + real :: raL, raR ! rho_anom to the left and right [R ~> kg m-3]. real :: dz, dzL, dzR ! Layer thicknesses [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]. @@ -384,7 +385,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, 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 [Pa]. + ! 5 sub-column locations [R L2 T-2 ~> Pa] or [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, ioff, joff, m @@ -509,56 +510,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 [Pa]. + intent(in) :: p_t !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [Pa]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure at the top of the layer [Pa]. - real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out - !! to reduce the magnitude of each of the integrals, 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 [kg m-3]. + intent(in) :: p_b !< Pressure at the top of the layer [R L2 T-2 ~> Pa] or [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) :: dRho_dT !< The derivative of density with temperature - !! [kg m-3 degC-1]. + !! [R degC-1 ~> kg m-3 degC-1] or [kg m-3 degC-1]. real, intent(in) :: dRho_dS !< The derivative of density with salinity, - !! in [kg m-3 ppt-1]. + !! in [R ppt-1 ~> kg m-3 ppt-1] or [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 [m2 s-2]. + !! the layer [L2 T-2 ~> m2 s-2] or [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 [Pa m2 s-2]. + 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]. 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 - !! [m2 s-2]. + !! [L2 T-2 ~> m2 s-2] or [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 - !! [m2 s-2]. + !! [L2 T-2 ~> m2 s-2] or [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 [Pa] + optional, intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t [Pa] + !! the same units as p_t [R L2 T-2 ~> Pa] or [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 [kg m-3]. - real :: alpha_anom ! The specific volume anomaly from 1/rho_ref [m3 kg-1]. - real :: aaL, aaR ! rho_anom to the left and right [kg m-3]. - real :: dp, dpL, dpR ! Layer pressure thicknesses [Pa]. - real :: hWght ! A pressure-thickness below topography [Pa]. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. - real :: iDenom ! The inverse of the denominator in the weights [Pa-2]. + 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-2 ~> Pa-2] or [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 [m2 s-2]. + ! 5 sub-column locations [L2 T-2 ~> m2 s-2] or [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 diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index 30e9c49850..ffd2452c19 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -24,20 +24,23 @@ module MOM_unit_scaling real :: J_kg_to_Q !< A constant that translates Joules per kilogram to the units of enthalpy. ! These are useful combinations of the fundamental scale conversion factors above. - real :: Z_to_L !< Convert vertical distances to lateral lengths - real :: L_to_Z !< Convert vertical distances to lateral lengths - real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1. - real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1. - real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2. - real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1. - real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1. - real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1. - real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2. + real :: Z_to_L !< Convert vertical distances to lateral lengths + real :: L_to_Z !< Convert lateral lengths to vertical distances + real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1. + real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1. + real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2. + real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1. + real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1. + real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1. + real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2. ! Not used enough: real :: kg_m2_to_RZ !< Convert mass loads from kg m-2 to R Z. - real :: RZ_to_kg_m2 !< Convert mass loads from R Z to kg m-2. + real :: RZ_to_kg_m2 !< Convert mass loads from R Z to kg m-2. real :: kg_m2s_to_RZ_T !< Convert mass fluxes from kg m-2 s-1 to R Z T-1. real :: RZ_T_to_kg_m2s !< Convert mass fluxes from R Z T-1 to kg m-2 s-1. real :: RZ3_T3_to_W_m2 !< Convert turbulent kinetic energy fluxes from R Z3 T-3 to W m-2. + real :: W_m2_to_RZ3_T3 !< Convert turbulent kinetic energy fluxes from W m-2 to R Z3 T-3. + real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa. + ! Not used enough: real :: Pa_to_RL2_T2 !< Convert pressures from Pa to R L2 T-2. ! These are used for changing scaling across restarts. real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. @@ -51,8 +54,8 @@ module MOM_unit_scaling !> Allocates and initializes the ocean model unit scaling type subroutine unit_scaling_init( param_file, US ) - type(param_file_type), intent(in) :: param_file !< Parameter file handle/type - type(unit_scale_type), pointer :: US !< A dimensional unit scaling type + type(param_file_type), optional, intent(in) :: param_file !< Parameter file handle/type + type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type ! This routine initializes a unit_scale_type structure (US). @@ -63,33 +66,40 @@ subroutine unit_scaling_init( param_file, US ) # include "version_variable.h" character(len=16) :: mdl = "MOM_unit_scaling" + if (.not.present(US)) return + if (associated(US)) call MOM_error(FATAL, & 'unit_scaling_init: called with an associated US pointer.') allocate(US) - ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, & - "Parameters for doing unit scaling of variables.") - call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & + if (present(param_file)) then + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, & + "Parameters for doing unit scaling of variables.") + call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & "An integer power of 2 that is used to rescale the model's "//& - "intenal units of depths and heights. Valid values range from -300 to 300.", & + "internal units of depths and heights. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) - call get_param(param_file, mdl, "L_RESCALE_POWER", L_power, & + call get_param(param_file, mdl, "L_RESCALE_POWER", L_power, & "An integer power of 2 that is used to rescale the model's "//& - "intenal units of lateral distances. Valid values range from -300 to 300.", & + "internal units of lateral distances. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) - call get_param(param_file, mdl, "T_RESCALE_POWER", T_power, & + call get_param(param_file, mdl, "T_RESCALE_POWER", T_power, & "An integer power of 2 that is used to rescale the model's "//& - "intenal units of time. Valid values range from -300 to 300.", & + "internal units of time. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) - call get_param(param_file, mdl, "R_RESCALE_POWER", R_power, & + call get_param(param_file, mdl, "R_RESCALE_POWER", R_power, & "An integer power of 2 that is used to rescale the model's "//& - "intenal units of density. Valid values range from -300 to 300.", & + "internal units of density. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) - call get_param(param_file, mdl, "Q_RESCALE_POWER", Q_power, & + call get_param(param_file, mdl, "Q_RESCALE_POWER", Q_power, & "An integer power of 2 that is used to rescale the model's "//& - "intenal 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.) + else + Z_power = 0 ; L_power = 0 ; T_power = 0 ; R_power = 0 ; Q_power = 0 + endif + 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.") if (abs(L_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& @@ -129,19 +139,31 @@ subroutine unit_scaling_init( param_file, US ) ! These are useful combinations of the fundamental scale conversion factors set above. US%Z_to_L = US%Z_to_m * US%m_to_L US%L_to_Z = US%L_to_m * US%m_to_Z + ! Horizontal velocities: US%L_T_to_m_s = US%L_to_m * US%s_to_T US%m_s_to_L_T = US%m_to_L * US%T_to_s + ! Horizontal accelerations: US%L_T2_to_m_s2 = US%L_to_m * US%s_to_T**2 - ! It does not look like US%m_s2_to_L_T2 would be used, so it does not exist. + ! It does not look like US%m_s2_to_L_T2 would be used, so it does not exist. + ! Vertical diffusivities and viscosities: US%Z2_T_to_m2_s = US%Z_to_m**2 * US%s_to_T US%m2_s_to_Z2_T = US%m_to_Z**2 * US%T_to_s - ! It does not seem like US%kg_m2_to_RZ would be used enough in MOM6 to justify its existence. + ! Column mass loads: US%RZ_to_kg_m2 = US%R_to_kg_m3 * US%Z_to_m + ! It does not seem like US%kg_m2_to_RZ would be used enough in MOM6 to justify its existence. + ! Vertical mass fluxes: US%kg_m2s_to_RZ_T = US%kg_m3_to_R * US%m_to_Z * US%T_to_s US%RZ_T_to_kg_m2s = US%R_to_kg_m3 * US%Z_to_m * US%s_to_T + ! Turbulent kinetic energy vertical fluxes: US%RZ3_T3_to_W_m2 = US%R_to_kg_m3 * US%Z_to_m**3 * US%s_to_T**3 + US%W_m2_to_RZ3_T3 = US%kg_m3_to_R * US%m_to_Z**3 * US%T_to_s**3 + ! Vertical heat fluxes: US%W_m2_to_QRZ_T = US%J_kg_to_Q * US%kg_m3_to_R * US%m_to_Z * US%T_to_s US%QRZ_T_to_W_m2 = US%Q_to_J_kg * US%R_to_kg_m3 * US%Z_to_m * US%s_to_T + ! Pressures: + US%RL2_T2_to_Pa = US%R_to_kg_m3 * US%L_T_to_m_s**2 + ! It does not seem like US%Pa_to_RL2_T2 would be used enough in MOM6 to justify its existence. + ! US%Pa_to_RL2_T2 = US%kg_m3_to_R * US%m_s_to_L_T**2 end subroutine unit_scaling_init diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 733245b1ce..59adfae2a8 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -35,7 +35,7 @@ module MOM_ice_shelf use MOM_forcing_type, only : mech_forcing, allocate_mech_forcing, MOM_mech_forcing_chksum use MOM_forcing_type, only : copy_common_forcing_fields use MOM_get_input, only : directories, Get_MOM_input -use MOM_EOS, only : calculate_density, calculate_density_derivs, calculate_TFreeze +use MOM_EOS, only : calculate_density, calculate_density_derivs, calculate_TFreeze, EOS_domain use MOM_EOS, only : EOS_type, EOS_init use MOM_ice_shelf_dynamics, only : ice_shelf_dyn_CS, update_ice_shelf use MOM_ice_shelf_dynamics, only : register_ice_shelf_dyn_restarts, initialize_ice_shelf_dyn @@ -92,7 +92,7 @@ module MOM_ice_shelf real :: ustar_bg !< A minimum value for ustar under ice shelves [Z T-1 ~> m s-1]. real :: cdrag !< drag coefficient under ice shelves [nondim]. - real :: g_Earth !< The gravitational acceleration [Z T-2 ~> m s-2] + 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 :: 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]. @@ -158,7 +158,8 @@ module MOM_ice_shelf 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 :: dTFr_dp !< Partial derivative of freezing temperature with pressure [degC Pa-1] + real :: dTFr_dp !< Partial derivative of freezing temperature with + !! pressure [degC 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, & @@ -196,28 +197,28 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) !! describe the surface state of the ocean. The !! intent is only inout to allow for halo updates. type(forcing), intent(inout) :: fluxes !< structure containing pointers to any possible - !! thermodynamic or mass-flux forcing fields. + !! 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 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. + real, intent(in) :: time_step !< 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. type(mech_forcing), optional, intent(inout) :: forces !< A structure with the driving mechanical forces - type(ocean_grid_type), pointer :: G => NULL() ! The grid structure used by the ice shelf. - type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing - ! various unit conversion factors + ! Local variables + type(ocean_grid_type), pointer :: G => NULL() !< The grid structure used by the ice shelf. + type(unit_scale_type), pointer :: US => NULL() !< Pointer to a structure containing + !! various unit conversion factors type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe - !! the ice-shelf state + !! the ice-shelf state real, dimension(SZI_(CS%grid)) :: & - Rhoml, & !< Ocean mixed layer density [kg m-3]. + Rhoml, & !< Ocean mixed layer density [R ~> kg m-3]. dR0_dT, & !< Partial derivative of the mixed layer density - !< with temperature [kg m-3 degC-1]. + !< with temperature [R degC-1 ~> kg m-3 degC-1]. dR0_dS, & !< Partial derivative of the mixed layer density - !< with salinity [kg m-3 ppt-1]. - p_int !< The pressure at the ice-ocean interface [Pa]. + !< with salinity [R ppt-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)) :: & exch_vel_t, & !< Sub-shelf thermal exchange velocity [Z T-1 ~> m s-1] @@ -234,8 +235,8 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) !! viscosity is linearly increasing [nondim]. (Was 1/8. Why?) real, parameter :: RC = 0.20 ! critical flux Richardson number. real :: I_ZETA_N !< The inverse of ZETA_N [nondim]. - real :: I_LF !< The inverse of the latent Heat of fusion [Q-1 ~> kg J-1]. - real :: I_VK !< The inverse of VK. + real :: I_LF !< The inverse of the latent heat of fusion [Q-1 ~> kg J-1]. + real :: I_VK !< The inverse of the Von Karman constant [nondim]. real :: PR, SC !< The Prandtl number and Schmidt number [nondim]. ! 3 equations formulation variables @@ -262,7 +263,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) ! boundary layer salinity times the friction velocity [ppt 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 + 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 :: ln_neut real :: mass_exch ! A mass exchange rate [R Z T-1 ~> kg m-2 s-1] @@ -286,6 +287,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) real, parameter :: c2_3 = 2.0/3.0 character(len=160) :: mesg ! The text of an error message + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je, ied, jed, it1, it3 if (.not. associated(CS)) call MOM_error(FATAL, "shelf_calc_flux: "// & @@ -305,8 +307,8 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) RhoCp = CS%Rho_ocn * CS%Cp !first calculate molecular component - Gam_mol_t = 12.5 * (PR**c2_3) - 6 - Gam_mol_s = 12.5 * (SC**c2_3) - 6 + Gam_mol_t = 12.5 * (PR**c2_3) - 6.0 + Gam_mol_s = 12.5 * (SC**c2_3) - 6.0 ! GMM, zero some fields of the ice shelf structure (ice_shelf_CS) ! these fields are already set to zero during initialization @@ -368,16 +370,17 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) fluxes%ustar_shelf(i,j) = 0.0 endif ; enddo ; enddo + EOSdom(:) = EOS_domain(G%HI) do j=js,je ! Find the pressure at the ice-ocean interface, averaged only over the ! part of the cell covered by ice shelf. - do i=is,ie ; p_int(i) = US%RZ_to_kg_m2*US%Z_to_m*US%s_to_T**2*CS%g_Earth * ISS%mass_shelf(i,j) ; enddo + 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(state%sst(:,j), state%sss(:,j), p_int, & - Rhoml(:), is, ie-is+1, CS%eqn_of_state) - call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, & - dR0_dT, dR0_dS, is, ie-is+1, CS%eqn_of_state) + call calculate_density(state%sst(:,j), state%sss(:,j), p_int, Rhoml(:), & + CS%eqn_of_state, EOSdom) + call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, dR0_dT, dR0_dS, & + CS%eqn_of_state, EOSdom) do i=is,ie if ((state%ocean_mass(i,j) > US%RZ_to_kg_m2*CS%col_mass_melt_threshold) .and. & @@ -399,8 +402,8 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) 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 = (CS%g_Earth / Rhoml(i)) * dR0_dS(i) - dB_dT = (CS%g_Earth / Rhoml(i)) * 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 @@ -445,7 +448,8 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) 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) + call calculate_TFreeze(Sbdry(i,j), p_int(i), ISS%tfreeze(i,j), CS%eqn_of_state, & + pres_scale=US%RL2_T2_to_Pa) dT_ustar = (ISS%tfreeze(i,j) - state%sst(i,j)) * ustar_h dS_ustar = (Sbdry(i,j) - state%sss(i,j)) * ustar_h @@ -588,7 +592,8 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) ! is specified and large enough that the ocean salinity at the interface ! is about the same as the boundary layer salinity. - call calculate_TFreeze(state%sss(i,j), p_int(i), ISS%tfreeze(i,j), CS%eqn_of_state) + call calculate_TFreeze(state%sss(i,j), p_int(i), ISS%tfreeze(i,j), CS%eqn_of_state, & + pres_scale=US%RL2_T2_to_Pa) exch_vel_t(i,j) = CS%gamma_t ISS%tflux_ocn(i,j) = RhoCp * exch_vel_t(i,j) * (ISS%tfreeze(i,j) - state%sst(i,j)) @@ -776,7 +781,7 @@ subroutine add_shelf_forces(G, US, CS, forces, do_shelf_area) logical, optional, intent(in) :: do_shelf_area !< If true find the shelf-covered areas. real :: kv_rho_ice ! The viscosity of ice divided by its density [m3 s-1 R-1 Z-1 ~> m5 kg-1 s-1]. - real :: press_ice ! The pressure of the ice shelf per unit area of ocean (not ice) [Pa]. + real :: press_ice ! The pressure of the ice shelf per unit area of ocean (not ice) [R L2 T-2 ~> Pa]. logical :: find_area ! If true find the shelf areas at u & v points. type(ice_shelf_state), pointer :: ISS => NULL() ! A structure with elements that describe ! the ice-shelf state @@ -811,8 +816,7 @@ subroutine add_shelf_forces(G, US, CS, forces, do_shelf_area) endif do j=js,je ; do i=is,ie - press_ice = (ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * & - US%RZ_to_kg_m2*US%Z_to_m*US%s_to_T**2*(CS%g_Earth * ISS%mass_shelf(i,j)) + press_ice = (ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) if (associated(forces%p_surf)) then if (.not.forces%accumulate_p_surf) forces%p_surf(i,j) = 0.0 forces%p_surf(i,j) = forces%p_surf(i,j) + press_ice @@ -855,7 +859,7 @@ subroutine add_shelf_pressure(G, US, CS, fluxes) type(ice_shelf_CS), intent(in) :: CS !< This module's control structure. type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be updated. - real :: press_ice !< The pressure of the ice shelf per unit area of ocean (not ice) [Pa]. + real :: press_ice !< The pressure of the ice shelf per unit area of ocean (not ice) [R L2 T-2 ~> Pa]. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -864,8 +868,7 @@ subroutine add_shelf_pressure(G, US, CS, fluxes) call MOM_error(FATAL,"add_shelf_pressure: Incompatible ocean and ice shelf grids.") do j=js,je ; do i=is,ie - press_ice = (CS%ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * & - US%RZ_to_kg_m2*US%Z_to_m*US%s_to_T**2*(CS%g_Earth * CS%ISS%mass_shelf(i,j)) + press_ice = (CS%ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) if (associated(fluxes%p_surf)) then if (.not.fluxes%accumulate_p_surf) fluxes%p_surf(i,j) = 0.0 fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + press_ice @@ -890,7 +893,6 @@ subroutine add_shelf_flux(G, US, CS, state, fluxes) real :: frac_shelf !< The fractional area covered by the ice shelf [nondim]. real :: frac_open !< The fractional area of the ocean that is not covered by the ice shelf [nondim]. real :: delta_mass_shelf!< Change in ice shelf mass over one time step [kg s-1] - real :: press_ice !< The pressure of the ice shelf per unit area of ocean (not ice) [Pa]. real :: balancing_flux !< The fresh water flux that balances the integrated melt flux [R Z T-1 ~> kg m-2 s-1] real :: balancing_area !< total area where the balancing flux is applied [m2] type(time_type) :: dTime !< The time step as a time_type @@ -1275,17 +1277,16 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "this is the freezing potential temperature at "//& "S=0, P=0.", units="degC", default=0.0, 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.) + "this is the derivative of the freezing potential temperature with salinity.", & + units="degC psu-1", default=-0.054, 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, do_not_log=.true.) + "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.) endif call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_to_Z*US%T_to_s**2) + units="m s-2", default = 9.80, scale=US%m_s_to_L_T**2*US%Z_to_m) 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.", & diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 63461df157..58f58fe828 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -89,7 +89,7 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept case ("linear") call set_coord_linear(GV%Rlay, GV%g_prime, GV, US, PF) case ("ts_ref") - call set_coord_from_ts_ref(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_ref(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) case ("ts_profile") call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) case ("ts_range") @@ -141,7 +141,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) + 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) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true., scale=US%m_s_to_L_T**2*US%Z_to_m) @@ -176,7 +176,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) + 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) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=US%R_to_kg_m3*GV%Rho0, scale=US%kg_m3_to_R) @@ -198,8 +198,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) end subroutine set_coord_from_layer_density !> Sets the layer densities (Rlay) and the interface reduced gravities (g) from a profile of g'. -subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state, & - P_Ref) +subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces @@ -209,7 +208,8 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters type(EOS_type), pointer :: eqn_of_state !< integer selecting the equation of state. - real, intent(in) :: P_Ref !< The coordinate-density reference pressure [Pa]. + real, intent(in) :: P_Ref !< The coordinate-density reference pressure + !! [R L2 T-2 ~> Pa]. ! Local variables real :: T_ref ! Reference temperature real :: S_ref ! Reference salinity @@ -228,7 +228,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state "The initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) + 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) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true., scale=US%m_s_to_L_T**2*US%Z_to_m) @@ -240,7 +240,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state ! The uppermost layer's density is set here. Subsequent layers' ! ! densities are determined from this value and the g values. ! ! T0 = 28.228 ; S0 = 34.5848 ; Pref = P_Ref - call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state) ! These statements set the layer densities. ! do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo @@ -249,8 +249,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state end subroutine set_coord_from_TS_ref !> Sets the layer densities (Rlay) and the interface reduced gravities (g) from a T-S profile. -subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & - eqn_of_state, P_Ref) +subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces @@ -260,7 +259,9 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters type(EOS_type), pointer :: eqn_of_state !< integer that selects equation of state. - real, intent(in) :: P_Ref !< The coordinate-density reference pressure [Pa]. + real, intent(in) :: P_Ref !< The coordinate-density reference pressure + !! [R L2 T-2 ~> Pa]. + ! Local variables real, dimension(GV%ke) :: T0, S0, Pref real :: g_fs ! Reduced gravity across the free surface [L2 Z-1 T-2 ~> m s-2]. @@ -273,7 +274,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) + 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) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and "//& "salinities are read.", fail_if_missing=.true.) @@ -289,16 +290,15 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & " set_coord_from_TS_profile: Unable to open " //trim(filename)) ! These statements set the interface reduced gravities. ! g_prime(1) = g_fs - do k=1,nz ; Pref(k) = P_ref ; enddo - call calculate_density(T0, S0, Pref, Rlay, 1, nz, eqn_of_state, scale=US%kg_m3_to_R) + do k=1,nz ; Pref(k) = P_Ref ; enddo + call calculate_density(T0, S0, Pref, Rlay, eqn_of_state, (/1,nz/) ) do k=2,nz; g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile !> Sets the layer densities (Rlay) and the interface reduced gravities (g) from a linear T-S profile. -subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & - eqn_of_state, P_Ref) +subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [R ~> kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces @@ -308,7 +308,8 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters type(EOS_type), pointer :: eqn_of_state !< integer that selects equation of state - real, intent(in) :: P_Ref !< The coordinate-density reference pressure [Pa] + real, intent(in) :: P_Ref !< The coordinate-density reference pressure + !! [R L2 T-2 ~> Pa]. ! Local variables real, dimension(GV%ke) :: T0, S0, Pref @@ -354,7 +355,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) + 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) k_light = GV%nk_rho_varies + 1 @@ -369,8 +370,8 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & enddo g_prime(1) = g_fs - do k=1,nz ; Pref(k) = P_ref ; enddo - call calculate_density(T0, S0, Pref, Rlay, k_light, nz-k_light+1, eqn_of_state, scale=US%kg_m3_to_R) + do k=1,nz ; Pref(k) = P_Ref ; enddo + call calculate_density(T0, S0, Pref, Rlay, eqn_of_state, (/k_light,nz/) ) ! Extrapolate target densities for the variable density mixed and buffer layers. do k=k_light-1,1,-1 Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2) @@ -401,7 +402,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) + 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) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -457,7 +458,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) units="kg m-3", default=2.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) + 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) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -495,7 +496,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) + 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) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index afadae1a1b..aa22f3cea0 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -41,7 +41,7 @@ module MOM_state_initialization use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : setVerticalGridAxes, verticalGrid_type use MOM_ALE, only : pressure_gradient_plm -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type, EOS_domain use MOM_EOS, only : int_specific_vol_dp, convert_temp_salt_for_TEOS10 use user_initialization, only : user_initialize_thickness, user_initialize_velocity use user_initialization, only : user_init_temperature_salinity @@ -932,59 +932,58 @@ subroutine convert_thickness(h, G, GV, US, tv) !! thermodynamic variables ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - p_top, p_bot - real :: dz_geo(SZI_(G),SZJ_(G)) ! The change in geopotential height - ! across a layer [m2 s-2]. - real :: rho(SZI_(G)) - real :: I_gEarth - real :: Hm_rho_to_Pa ! A conversion factor from the input geometric thicknesses times the - ! layer densities into Pa [Pa m3 H-1 kg-1 ~> s-2 m2 or s-2 m5 kg-1]. - logical :: Boussinesq + p_top, p_bot ! Pressure at the interfaces above and below a layer [R L2 T-2 ~> Pa] + real :: dz_geo(SZI_(G),SZJ_(G)) ! The change in geopotential height across a layer [L2 T-2 ~> m2 s-2] + real :: rho(SZI_(G)) ! The in situ density [R ~> kg m-3] + real :: I_gEarth ! Unit conversion factors divided by the gravitational acceleration + ! [H T2 R-1 L-2 ~> s2 m2 kg-1 or s2 m-1] + real :: HR_to_pres ! A conversion factor from the input geometric thicknesses times the layer + ! densities into pressure units [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2]. + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: itt, max_itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB max_itt = 10 - Boussinesq = GV%Boussinesq - I_gEarth = 1.0 / (GV%mks_g_Earth) - Hm_rho_to_Pa = GV%mks_g_Earth * GV%H_to_m ! = GV%H_to_Pa / (US%R_to_kg_m3*GV%Rho0) - if (Boussinesq) then + if (GV%Boussinesq) then call MOM_error(FATAL,"Not yet converting thickness with Boussinesq approx.") else + I_gEarth = GV%RZ_to_H / GV%g_Earth + HR_to_pres = GV%g_Earth * GV%H_to_Z + if (associated(tv%eqn_of_state)) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 p_bot(i,j) = 0.0 ; p_top(i,j) = 0.0 enddo ; enddo + EOSdom(:) = EOS_domain(G%HI) do k=1,nz do j=js,je do i=is,ie ; p_top(i,j) = p_bot(i,j) ; enddo call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_top(:,j), rho, & - is, ie-is+1, tv%eqn_of_state) + tv%eqn_of_state, EOSdom) do i=is,ie - p_bot(i,j) = p_top(i,j) + Hm_rho_to_Pa * (h(i,j,k) * rho(i)) + p_bot(i,j) = p_top(i,j) + HR_to_pres * (h(i,j,k) * rho(i)) enddo enddo do itt=1,max_itt - call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p_top, p_bot, & - 0.0, G%HI, tv%eqn_of_state, dz_geo) + call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p_top, p_bot, 0.0, G%HI, & + tv%eqn_of_state, dz_geo) if (itt < max_itt) then ; do j=js,je call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_bot(:,j), rho, & - is, ie-is+1, tv%eqn_of_state) + tv%eqn_of_state, EOSdom) ! Use Newton's method to correct the bottom value. - ! The hydrostatic equation is linear to such a - ! high degree that no bounds-checking is needed. + ! The hydrostatic equation is sufficiently linear that no bounds-checking is needed. do i=is,ie - p_bot(i,j) = p_bot(i,j) + rho(i) * & - (Hm_rho_to_Pa*h(i,j,k) - dz_geo(i,j)) + p_bot(i,j) = p_bot(i,j) + rho(i) * (HR_to_pres*h(i,j,k) - dz_geo(i,j)) enddo enddo ; endif enddo do j=js,je ; do i=is,ie - h(i,j,k) = (p_bot(i,j) - p_top(i,j)) * GV%kg_m2_to_H * I_gEarth + h(i,j,k) = (p_bot(i,j) - p_top(i,j)) * I_gEarth enddo ; enddo enddo else @@ -1094,12 +1093,12 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) !! only read parameters without changing h. ! Local variables character(len=200) :: mdl = "trim_for_ice" - real, dimension(SZI_(G),SZJ_(G)) :: p_surf ! Imposed pressure on ocean at surface [Pa] + 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_(G)) :: S_t, S_b ! Top and bottom edge values for reconstructions - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_t, T_b ! of salinity and temperature within each layer. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_t, T_b ! of salinity [ppt] and temperature [degC] within each layer. character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path - real :: scale_factor ! A file-dependent scaling vactor for the input pressurs. - real :: min_thickness ! The minimum layer thickness, recast into Z units. + 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]. integer :: i, j, k logical :: default_2018_answers, remap_answers_2018 logical :: just_read ! If true, just read parameters but set nothing. @@ -1113,7 +1112,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(PF, mdl, "SURFACE_PRESSURE_VAR", p_surf_var, & "The initial condition variable for the surface height.", & - units="kg m-2", default="", do_not_log=just_read) + units="kg m-2", default="", do_not_log=just_read) !### The units here should be Pa? call get_param(PF, mdl, "INPUTDIR", inputdir, default=".", do_not_log=.true.) filename = trim(slasher(inputdir))//trim(p_surf_file) if (.not.just_read) call log_param(PF, mdl, "!INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) @@ -1140,7 +1139,8 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, p_surf_var, p_surf, G%Domain, scale=scale_factor) + call MOM_read_data(filename, p_surf_var, p_surf, G%Domain, & + scale=scale_factor*US%kg_m3_to_R*US%m_s_to_L_T**2) if (use_remapping) then allocate(remap_CS) @@ -1159,7 +1159,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV, US, GV%mks_g_Earth*US%Z_to_m, G%bathyT(i,j), & + call cut_off_column_top(GV%ke, tv, GV, US, GV%g_Earth, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & z_tol=1.0e-5*US%m_to_Z, remap_answers_2018=remap_answers_2018) @@ -1175,8 +1175,8 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, integer, intent(in) :: nk !< Number of layers type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics 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, intent(in) :: G_earth !< Gravitational acceleration [m2 Z-1 s-2 ~> m s-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + 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] @@ -1185,7 +1185,7 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, 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, intent(in) :: p_surf !< Imposed pressure on ocean at surface [Pa] + 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, !! if associated @@ -1197,9 +1197,10 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, !! forms of the same expressions. ! Local variables - real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions + real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions [Z ~> m] real, dimension(nk) :: h0, S0, T0, h1, S1, T1 - real :: P_t, P_b, z_out, e_top + real :: P_t, P_b ! Top and bottom pressures [R L2 T-2 ~> Pa] + real :: z_out, e_top logical :: answers_2018 integer :: k @@ -1216,7 +1217,7 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, e_top = e(1) do k=1,nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, p_surf, US%R_to_kg_m3*GV%Rho0, G_earth, tv%eqn_of_state, & + P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, & P_b, z_out, z_tol=z_tol) if (z_out>=e(K)) then ! Imposed pressure was less that pressure at top of cell @@ -1561,7 +1562,7 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P !! parameters. type(EOS_type), pointer :: eqn_of_state !< Integer that selects the equatio of state. real, intent(in) :: P_Ref !< The coordinate-density reference pressure - !! [Pa]. + !! [R L2 T-2 ~> Pa]. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables @@ -1569,7 +1570,7 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P real :: S0(SZK_(G)) ! Layer salinities [degC] real :: T_Ref ! Reference Temperature [degC] real :: S_Ref ! Reference Salinity [ppt] - real :: pres(SZK_(G)) ! An array of the reference pressure [Pa]. + real :: pres(SZK_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. @@ -1601,8 +1602,8 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P T0(k) = T_Ref enddo - call calculate_density(T0(1),S0(1),pres(1),rho_guess(1),eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T0(1), S0(1), pres(1), rho_guess(1), eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, (/1,1/) ) if (fit_salin) then ! A first guess of the layers' temperatures. @@ -1611,8 +1612,8 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P enddo ! Refine the guesses for each layer. do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state) do k=1,nz S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS(k)) enddo @@ -1623,8 +1624,8 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT(1) enddo do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -1734,8 +1735,9 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, C tmp_2d ! A temporary array for tracers. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. - real :: pres(SZI_(G)) ! An array of the reference pressure [Pa]. + real :: pres(SZI_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed integer, dimension(4) :: siz @@ -1865,13 +1867,13 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, C ! mixed layer density, which is used in determining which layers can be ! inflated without causing static instabilities. do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo + 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) do j=js,je - call calculate_density(tmp(:,j,1), tmp2(:,j,1), pres, tmp_2d(:,j), & - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tmp(:,j,1), tmp2(:,j,1), pres, tmp_2d(:,j), tv%eqn_of_state, EOSdom) enddo call set_up_sponge_ML_density(tmp_2d, G, CSp) @@ -1978,6 +1980,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param # include "version_variable.h" character(len=40) :: mdl = "MOM_initialize_layers_from_Z" ! This module's name. + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: is, ie, js, je, nz ! compute domain indices integer :: isc,iec,jsc,jec ! global compute domain indices integer :: isg, ieg, jsg, jeg ! global extent @@ -2016,7 +2019,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param real, dimension(:,:,:), allocatable :: rho_z ! Densities in Z-space [R ~> kg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights [Z ~> m]. integer, dimension(SZI_(G),SZJ_(G)) :: nlevs - real, dimension(SZI_(G)) :: press ! Pressures [Pa]. + real, dimension(SZI_(G)) :: press ! Pressures [R L2 T-2 ~> Pa]. ! Local variables for ALE remapping real, dimension(:), allocatable :: hTarget ! Target thicknesses [Z ~> m]. @@ -2185,14 +2188,13 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param allocate(area_shelf_h(isd:ied,jsd:jed)) allocate(frac_shelf_h(isd:ied,jsd:jed)) - press(:) = tv%p_ref - ! Convert T&S to Absolute Salinity and Conservative Temperature if using TEOS10 or NEMO - call convert_temp_salt_for_TEOS10(temp_z, salt_z, press, G, kd, mask_z, eos) + 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(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), is, ie, & - eos, scale=US%kg_m3_to_R) + call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), eos, EOSdom) enddo ; enddo call pass_var(temp_z,G%Domain) @@ -2399,8 +2401,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param if (adjust_temperature .and. .not. useALEremapping) then call determine_temperature(tv%T(is:ie,js:je,:), tv%S(is:ie,js:je,:), & - GV%Rlay(1:nz), tv%p_ref, niter, missing_value, h(is:ie,js:je,:), ks, US, eos) - + GV%Rlay(1:nz), tv%P_Ref, niter, missing_value, h(is:ie,js:je,:), ks, US, eos) endif deallocate(z_in, z_edges_in, temp_z, salt_z, mask_z) @@ -2421,51 +2422,60 @@ subroutine MOM_state_init_tests(G, GV, US, tv) 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(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + ! Local variables integer, parameter :: nk=5 - real, dimension(nk) :: T, T_t, T_b, S, S_t, S_b, rho, h, z - real, dimension(nk+1) :: e + real, dimension(nk) :: T, T_t, T_b ! Temperatures [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 :: P_tot, P_t, P_b, z_out + 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] type(remapping_CS), pointer :: remap_CS => NULL() + I_z_scale = 1.0 / (500.0*US%m_to_Z) do k = 1, nk - h(k) = 100. + h(k) = 100.0*GV%m_to_H enddo e(1) = 0. do K = 1, nk - e(K+1) = e(K) - h(k) + e(K+1) = e(K) - GV%H_to_Z * h(k) enddo P_tot = 0. do k = 1, nk z(k) = 0.5 * ( e(K) + e(K+1) ) - T_t(k) = 20.+(0./500.)*e(k) - T(k) = 20.+(0./500.)*z(k) - T_b(k) = 20.+(0./500.)*e(k+1) - S_t(k) = 35.-(0./500.)*e(k) - S(k) = 35.+(0./500.)*z(k) - S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -US%R_to_kg_m3*GV%Rho0*GV%mks_g_Earth*z(k), & + 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) + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*US%m_to_Z*z(k), & rho(k), tv%eqn_of_state) - P_tot = P_tot + GV%mks_g_Earth * rho(k) * h(k) + P_tot = P_tot + GV%g_Earth * rho(k) * GV%H_to_Z*h(k) enddo P_t = 0. do k = 1, nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), P_t, 0.5*P_tot, & - US%R_to_kg_m3*GV%Rho0, GV%mks_g_Earth, tv%eqn_of_state, P_b, z_out) - write(0,*) k,P_t,P_b,0.5*P_tot,e(K),e(K+1),z_out + GV%Rho0, GV%g_Earth, tv%eqn_of_state, P_b, z_out) + write(0,*) k, US%RL2_T2_to_Pa*P_t, US%RL2_T2_to_Pa*P_b, 0.5*US%RL2_T2_to_Pa*P_tot, & + US%Z_to_m*e(K), US%Z_to_m*e(K+1), US%Z_to_m*z_out P_t = P_b enddo - write(0,*) P_b,P_tot + write(0,*) US%RL2_T2_to_Pa*P_b, US%RL2_T2_to_Pa*P_tot write(0,*) '' write(0,*) ' ==================================================================== ' write(0,*) '' - write(0,*) h - call cut_off_column_top(nk, tv, GV, US, GV%mks_g_Earth, -e(nk+1), GV%Angstrom_H, & + write(0,*) GV%H_to_m*h + call cut_off_column_top(nk, tv, GV, US, GV%g_Earth, -e(nk+1), GV%Angstrom_Z, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) - write(0,*) h + write(0,*) GV%H_to_m*h end subroutine MOM_state_init_tests diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 3ef9bd308a..c1b608b16b 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -19,7 +19,7 @@ module MOM_mixed_layer_restrat 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 +use MOM_EOS, only : calculate_density, EOS_domain implicit none ; private @@ -149,7 +149,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var Rml_av_slow ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] real :: g_Rho0 ! G_Earth/Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3] - real :: p0(SZI_(G)) ! A pressure of 0 [Pa] + real :: p0(SZI_(G)) ! A pressure of 0 [R L2 T-2 ~> Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] @@ -173,16 +173,18 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D arrays ! for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK ! Densities [R ~> kg m-3] real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers [H ~> m or kg m-2]. - real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer densities [Pa]. + real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer + ! densities [R L2 T-2 ~> Pa]. real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 real :: aFac, bFac ! Nondimensional ratios [nondim] real :: ddRho ! A density difference [R ~> kg m-3] real :: hAtVel, zpa, zpb, dh, res_scaling_fac real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] logical :: proper_averaging, line_is_empty, keep_going, res_upscale + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz real :: PSI, PSI1, z, BOTTOP, XP, DD ! For the following statement functions ! Stream function as a function of non-dimensional position within mixed-layer (F77 statement function) @@ -204,10 +206,10 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%MLE_density_diff > 0.) then ! We need to calculate a mixed layer depth, MLD. !! TODO: use derivatives and mid-MLD pressure. Currently this is sigma-0. -AJA pRef_MLD(:) = 0. + EOSdom(:) = EOS_domain(G%HI, halo=1) do j = js-1, je+1 dK(:) = 0.5 * h(:,j,1) ! Depth of center of surface layer - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, is-1, ie-is+3, & - tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, tv%eqn_of_state, EOSdom) deltaRhoAtK(:) = 0. MLD_fast(:,j) = 0. do k = 2, nz @@ -215,8 +217,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var dK(:) = dK(:) + 0.5 * ( h(:,j,k) + h(:,j,k-1) ) ! Depth of center of layer K ! Mixed-layer depth, using sigma-0 (surface reference pressure) deltaRhoAtKm1(:) = deltaRhoAtK(:) ! Store value from previous iteration of K - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, is-1, ie-is+3, & - tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, tv%eqn_of_state, EOSdom) do i = is-1,ie+1 deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface enddo @@ -299,8 +300,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var endif p0(:) = 0.0 + EOSdom(:) = EOS_domain(G%HI, halo=1) !$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot_fast,Rml_av_fast,tv,p0,h,h_avail,& -!$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & +!$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr,EOSdom, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & !$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_LFront, & !$OMP res_upscale, & @@ -321,7 +323,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo if (keep_going) then - call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,rho_ml(:),is-1,ie-is+3,tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml(:), tv%eqn_of_state, EOSdom) line_is_empty = .true. do i=is-1,ie+1 if (htot_fast(i,j) < MLD_fast(i,j)) then @@ -353,7 +355,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(forces%ustar,'mixed_layer_restrat: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T) call hchksum(MLD_fast,'mixed_layer_restrat: MLD', G%HI, haloshift=1, scale=GV%H_to_m) call hchksum(Rml_av_fast,'mixed_layer_restrat: rml', G%HI, haloshift=1, & - scale=US%m_to_Z*US%L_to_m**2*US%s_to_T**2) + scale=US%m_to_Z*US%L_T_to_m_s**2) endif ! TO DO: @@ -585,7 +587,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) Rml_av ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] real :: g_Rho0 ! G_Earth/Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] real :: Rho0(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3] - real :: p0(SZI_(G)) ! A pressure of 0 [Pa] + real :: p0(SZI_(G)) ! A pressure of 0 [R L2 T-2 ~> Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] @@ -611,6 +613,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkml is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nkml = GV%nkml @@ -632,7 +635,8 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! Fix this later for nkml >= 3. p0(:) = 0.0 -!$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot,Rml_av,tv,p0,h,h_avail, & + EOSdom(:) = EOS_domain(G%HI, halo=1) +!$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot,Rml_av,tv,p0,h,h_avail,EOSdom, & !$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & !$OMP uDml_diag,vDml_diag,nkml) & @@ -645,7 +649,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) htot(i,j) = 0.0 ; Rml_av(i,j) = 0.0 enddo do k=1,nkml - call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,Rho0(:),is-1,ie-is+3,tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, Rho0(:), tv%eqn_of_state, EOSdom) do i=is-1,ie+1 Rml_av(i,j) = Rml_av(i,j) + h(i,j,k)*Rho0(i) htot(i,j) = htot(i,j) + h(i,j,k) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 6796da5b57..d988f2bbd5 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -9,7 +9,7 @@ module MOM_thickness_diffuse use MOM_diag_mediator, only : diag_update_remap_grids use MOM_domains, only : pass_var, CORNER, pass_vector use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe -use MOM_EOS, only : calculate_density, calculate_density_derivs +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_interface_heights, only : find_eta @@ -595,7 +595,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV hN2_x_PE ! thickness in m times Brunt-Vaisala freqeuncy at u-points [L2 Z-1 T-2 ~> m s-2], ! used for calculating PE release real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & - pres, & ! The pressure at an interface [Pa]. + 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] @@ -608,11 +608,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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]. - pres_u ! Pressure on the interface at the u-point [Pa]. + 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]. - pres_v ! Pressure on the interface at the v-point [Pa]. + 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 ] real :: Work_h ! The work averaged over an h-cell [R Z L2 T-3 ~> W m-2]. @@ -672,6 +672,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics logical :: present_int_slope_u, present_int_slope_v logical :: present_slope_x, present_slope_y, calc_derivatives + integer, dimension(2) :: EOSdom_u ! The shifted i-computational domain to use for equation of + ! state calculations at u-points. + integer, dimension(2) :: EOSdom_v ! The shifted I-computational domain to use for equation of + ! state calculations at v-points. integer :: is, ie, js, je, nz, IsdB integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ; IsdB = G%IsdB @@ -721,7 +725,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_avail(i,j,1) = max(I4dt*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,2) = h_avail(i,j,1) h_frac(i,j,1) = 1.0 - pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) + pres(i,j,2) = pres(i,j,1) + (GV%g_Earth*GV%H_to_RZ) * h(i,j,1) enddo ; enddo !$OMP do do j=js-1,je+1 @@ -730,7 +734,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_avail_rsum(i,j,k+1) = h_avail_rsum(i,j,k) + h_avail(i,j,k) h_frac(i,j,k) = 0.0 ; if (h_avail(i,j,k) > 0.0) & h_frac(i,j,k) = h_avail(i,j,k) / h_avail_rsum(i,j,k+1) - pres(i,j,K+1) = pres(i,j,K) + GV%H_to_Pa*h(i,j,k) + pres(i,j,K+1) = pres(i,j,K) + (GV%g_Earth*GV%H_to_RZ) * h(i,j,k) enddo ; enddo enddo !$OMP do @@ -747,12 +751,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo ; enddo !$OMP end parallel + EOSdom_u(1) = (is-1) - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect, & !$OMP I_slope_max2,h_neglect2,present_int_slope_u, & !$OMP int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & !$OMP uhD,h_avail,G_scale,Work_u,CS,slope_x,cg1, & -!$OMP diag_sfn_x, diag_sfn_unlim_x,N2_floor, & +!$OMP diag_sfn_x, diag_sfn_unlim_x,N2_floor,EOSdom_u, & !$OMP present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & @@ -778,8 +783,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV T_u(I) = 0.25*((T(i,j,k) + T(i+1,j,k)) + (T(i,j,k-1) + T(i+1,j,k-1))) S_u(I) = 0.25*((S(i,j,k) + S(i+1,j,k)) + (S(i,j,k-1) + S(i+1,j,k-1))) enddo - call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, & - drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, drho_dS_u, & + tv%eqn_of_state, EOSdom_u) endif do I=is-1,ie @@ -1000,13 +1005,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo ! end of j-loop ! Calculate the meridional fluxes and gradients. + EOSdom_v(:) = EOS_domain(G%HI) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect, & !$OMP I_slope_max2,h_neglect2,present_int_slope_v, & !$OMP int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & !$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1, & -!$OMP diag_sfn_y, diag_sfn_unlim_y,N2_floor, & -!$OMP present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) & +!$OMP diag_sfn_y,diag_sfn_unlim_y,N2_floor,EOSdom_v,& +!$OMP present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & @@ -1029,8 +1035,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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, is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + 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 (calc_derivatives) then @@ -1253,6 +1259,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do j=js,je ; do I=is-1,ie ; uhD(I,j,1) = -uhtot(I,j) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; vhD(i,J,1) = -vhtot(i,J) ; enddo ; enddo else + EOSdom_u(1) = (is-1) - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) !$OMP parallel do default(shared) private(pres_u,T_u,S_u,drho_dT_u,drho_dS_u,drdiB) do j=js,je if (use_EOS) then @@ -1261,8 +1268,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV T_u(I) = 0.5*(T(i,j,1) + T(i+1,j,1)) S_u(I) = 0.5*(S(i,j,1) + S(i+1,j,1)) enddo - call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, & - drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, drho_dS_u, & + tv%eqn_of_state, EOSdom_u ) endif do I=is-1,ie uhD(I,j,1) = -uhtot(I,j) @@ -1283,6 +1290,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo enddo + EOSdom_v(:) = EOS_domain(G%HI) !$OMP parallel do default(shared) private(pres_v,T_v,S_v,drho_dT_v,drho_dS_v,drdjB) do J=js-1,je if (use_EOS) then @@ -1291,8 +1299,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV T_v(i) = 0.5*(T(i,j,1) + T(i,j+1,1)) S_v(i) = 0.5*(S(i,j,1) + S(i,j+1,1)) enddo - call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, & - drho_dS_v, is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + 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 vhD(i,J,1) = -vhtot(i,J) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 4eaf895d9b..ea187f86f9 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -148,7 +148,7 @@ module MOM_CVMix_KPP real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL [m] real, allocatable, dimension(:,:) :: La_SL !< Langmuir number used in KPP - real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density [kg m-3] + real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density [R ~> kg m-3] real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity [m2 s-2] real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer (dimensionless) real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) @@ -188,7 +188,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS ! Local variables -#include "version_variable.h" +# include "version_variable.h" character(len=40) :: mdl = 'MOM_CVMix_KPP' !< name of this module character(len=20) :: string !< local temporary string logical :: CS_IS_ONE=.false. !< Logical for setting Cs based on Non-local @@ -475,7 +475,8 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') endif CS%id_BulkDrho = register_diag_field('ocean_model', 'KPP_BulkDrho', diag%axesTL, Time, & - 'Bulk difference in density used in Bulk Richardson number, as used by [CVMix] KPP', 'kg/m3') + 'Bulk difference in density used in Bulk Richardson number, as used by [CVMix] KPP', & + 'kg/m3', conversion=US%R_to_kg_m3) CS%id_BulkUz2 = register_diag_field('ocean_model', 'KPP_BulkUz2', diag%axesTL, Time, & 'Square of bulk difference in resolved velocity used in Bulk Richardson number via [CVMix] KPP', 'm2/s2') CS%id_BulkRi = register_diag_field('ocean_model', 'KPP_BulkRi', diag%axesTL, Time, & @@ -908,20 +909,21 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [s-2] real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars [m s-1] - real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number + real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number [R ~> kg m-3] real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2] real, dimension( G%ke ) :: surfBuoyFlux2 real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer ! for EOS calculation - real, dimension( 3*G%ke ) :: rho_1D - real, dimension( 3*G%ke ) :: pres_1D + real, dimension( 3*G%ke ) :: rho_1D ! A column of densities [R ~> kg m-3] + real, dimension( 3*G%ke ) :: pres_1D ! A column of pressures [R L2 T-2 ~> Pa] real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D real :: surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] - real :: pRef, rho1, rhoK, Uk, Vk, sigma, sigmaRatio + real :: GoRho ! Gravitational acceleration divided by density in MKS units [m R-1 s-2 ~> m4 kg-1 s-2] + real :: pRef ! The interface pressure [R L2 T-2 ~> Pa] + real :: rho1, rhoK, Uk, Vk, sigma, sigmaRatio real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. @@ -958,7 +960,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF #endif ! some constants - GoRho = GV%mks_g_Earth / (US%R_to_kg_m3*GV%Rho0) + GoRho = US%L_T_to_m_s**2*US%m_to_Z * GV%g_Earth / GV%Rho0 buoy_scale = US%L_to_m**2*US%s_to_T**3 ! loop over horizontal points on processor @@ -1084,9 +1086,9 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF Salt_1D(kk+2) = Salt(i,j,k) Salt_1D(kk+3) = Salt(i,j,km1) - ! pRef is pressure at interface between k and km1. + ! pRef is pressure at interface between k and km1 [R L2 T-2 ~> Pa]. ! iterate pRef for next pass through k-loop. - pRef = pRef + GV%H_to_Pa * h(i,j,k) + pRef = pRef + (GV%g_Earth * GV%H_to_RZ) * h(i,j,k) ! this difference accounts for penetrating SW surfBuoyFlux2(k) = buoy_scale * (buoyFlux(i,j,1) - buoyFlux(i,j,k+1)) @@ -1102,7 +1104,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! compute in-situ density - call calculate_density(Temp_1D, Salt_1D, pres_1D, rho_1D, 1, 3*G%ke, EOS) + call calculate_density(Temp_1D, Salt_1D, pres_1D, rho_1D, EOS) ! N2 (can be negative) and N (non-negative) on interfaces. ! deltaRho is non-local rho difference used for bulk Richardson number. @@ -1215,86 +1217,6 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) -!************************************************************************* -! smg: remove code below - -! Following "correction" step has been found to be unnecessary. -! Code should be removed after further testing. -! BGR: 03/15/2018-> Restructured code (Vt2 changed to compute from call in MOM_CVMix_KPP now) -! I have not taken this restructuring into account here. -! Do we ever run with correctSurfLayerAvg? -! smg's suggested testing and removal is advised, in the meantime -! I have added warning if correctSurfLayerAvg is attempted. - ! if (CS%correctSurfLayerAvg) then - - ! SLdepth_0d = CS%surf_layer_ext * CS%OBLdepth(i,j) - ! hTot = h(i,j,1) - ! surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot - ! surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot - ! surfU = 0.5*US%L_T_to_m_s*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot - ! surfV = 0.5*US%L_T_to_m_s*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot - ! pRef = 0.0 - - ! do k = 2, G%ke - - ! ! Recalculate differences with surface layer - ! Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU - ! Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV - ! deltaU2(k) = Uk**2 + Vk**2 - ! pRef = pRef + GV%H_to_Pa * h(i,j,k) - ! call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) - ! call calculate_density(Temp(i,j,k), Salt(i,j,k), pRef, rhoK, EOS) - ! deltaRho(k) = rhoK - rho1 - - ! ! Surface layer averaging (needed for next k+1 iteration of this loop) - ! if (hTot < SLdepth_0d) then - ! delH = min( max(0., SLdepth_0d - hTot), h(i,j,k)*GV%H_to_m ) - ! hTot = hTot + delH - ! surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot - ! surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot - ! surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot - ! surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot - ! endif - - ! enddo - - ! BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & - ! cellHeight(1:G%ke), & ! Depth of cell center [m] - ! GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [s-1] - ! deltaU2, & ! Square of resolved velocity difference [m2 s-2] - ! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] - ! N_iface=CS%N ) ! Buoyancy frequency [s-1] - - ! surfBuoyFlux = buoy_scale*buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit - ! ! h to Monin-Obukov (default is false, ie. not used) - - ! call CVMix_kpp_compute_OBL_depth( & - ! BulkRi_1d, & ! (in) Bulk Richardson number - ! iFaceHeight, & ! (in) Height of interfaces [m] - ! CS%OBLdepth(i,j), & ! (out) OBL depth [m] - ! CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - ! zt_cntr=cellHeight, & ! (in) Height of cell centers [m] - ! surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - ! surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] - ! Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] - ! CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - - ! if (CS%deepOBLoffset>0.) then - ! zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - ! CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) - ! CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - ! endif - - ! ! apply some constraints on OBLdepth - ! if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value - ! CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer - ! CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deep than bottom - ! CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - - ! endif ! endif for "correction" step - -! smg: remove code above -! ********************************************************************** ! recompute wscale for diagnostics, now that we in fact know boundary layer depth !BGR consider if LTEnhancement is wanted for diagnostics @@ -1359,7 +1281,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real :: wc, ww, we, wn, ws ! averaging weights for smoothing real :: dh ! The local thickness used for calculating interface positions [m] real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] - real :: pref +!### real :: pref integer :: i, j, k, s do s=1,CS%n_smooth @@ -1378,7 +1300,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) if (G%mask2dT(i,j)==0.) cycle iFaceHeight(1) = 0.0 ! BBL is all relative to the surface - pRef = 0. +!### pRef = 0. hcorr = 0. do k=1,G%ke diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index ce6a40dad2..0bd312d95d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -168,11 +168,14 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces [m] real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers [m] integer :: kOBL !< level of OBL extent - real :: g_o_rho0 ! Gravitational acceleration divided by density in MKS units [m4 s-2] - real :: pref, rhok, rhokm1, dz, dh, hcorr + real :: g_o_rho0 ! Gravitational acceleration divided by density times unit convserion factors + ! [Z s-2 R-1 ~> m4 s-2 kg-1] + real :: pref ! Interface pressures [R L2 T-2 ~> Pa] + real :: rhok, rhokm1 ! In situ densities of the layers above and below at the interface pressure [R ~> kg m-3] + real :: dz, dh, hcorr integer :: i, j, k - g_o_rho0 = GV%mks_g_Earth / (US%R_to_kg_m3*GV%Rho0) + g_o_rho0 = US%L_to_Z**2*US%s_to_T**2 * GV%g_Earth / GV%Rho0 ! initialize dummy variables rho_lwr(:) = 0.0; rho_1d(:) = 0.0 @@ -196,12 +199,12 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) ! Compute Brunt-Vaisala frequency (static stability) on interfaces do k=2,G%ke - ! pRef is pressure at interface between k and km1. - pRef = pRef + GV%H_to_Pa * h(i,j,k) - call calculate_density(tv%t(i,j,k), tv%s(i,j,k), pref, rhok, tv%eqn_of_state) - call calculate_density(tv%t(i,j,k-1), tv%s(i,j,k-1), pref, rhokm1, tv%eqn_of_state) + ! pRef is pressure at interface between k and km1 [R L2 T-2 ~> Pa]. + pRef = pRef + (GV%H_to_RZ*GV%g_Earth) * h(i,j,k) + call calculate_density(tv%t(i,j,k), tv%s(i,j,k), pRef, rhok, tv%eqn_of_state) + call calculate_density(tv%t(i,j,k-1), tv%s(i,j,k-1), pRef, rhokm1, tv%eqn_of_state) - dz = ((0.5*(h(i,j,k-1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) + dz = ((0.5*(h(i,j,k-1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_Z) CS%N2(i,j,k) = g_o_rho0 * (rhok - rhokm1) / dz ! Can be negative enddo diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 1bcb6a1266..dd398cae6f 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -182,13 +182,13 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) ! Local variables real, dimension(SZK_(G)) :: & cellHeight, & !< Height of cell centers [m] - dRho_dT, & !< partial derivatives of density wrt temp [kg m-3 degC-1] - dRho_dS, & !< partial derivatives of density wrt saln [kg m-3 ppt-1] - pres_int, & !< pressure at each interface [Pa] + 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] + 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] - alpha_dT, & !< alpha*dT across interfaces - beta_dS, & !< beta*dS across interfaces + 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] real, dimension(SZK_(G)+1) :: & @@ -197,7 +197,7 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces [m] integer :: kOBL !< level of OBL extent - real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr + real :: dh, hcorr integer :: i, k ! initialize dummy variables @@ -219,32 +219,29 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) ! skip calling at land points if (G%mask2dT(i,j) == 0.) cycle - pRef = 0. - pres_int(1) = pRef + pres_int(1) = 0. ! we don't have SST and SSS, so let's use values at top-most layer temp_int(1) = TV%T(i,j,1); salt_int(1) = TV%S(i,j,1) - do k=2,G%ke + do K=2,G%ke ! pressure at interface - pres_int(k) = pRef + GV%H_to_Pa * h(i,j,k-1) + pres_int(K) = pres_int(K-1) + (GV%g_Earth * GV%H_to_RZ) * h(i,j,k-1) ! temp and salt at interface ! for temp: (t1*h1 + t2*h2)/(h1+h2) - temp_int(k) = (TV%T(i,j,k-1)*h(i,j,k-1) + TV%T(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) - salt_int(k) = (TV%S(i,j,k-1)*h(i,j,k-1) + TV%S(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) + temp_int(K) = (TV%T(i,j,k-1)*h(i,j,k-1) + TV%T(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) + salt_int(K) = (TV%S(i,j,k-1)*h(i,j,k-1) + TV%S(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) ! dT and dS - dT(k) = (TV%T(i,j,k-1)-TV%T(i,j,k)) - dS(k) = (TV%S(i,j,k-1)-TV%S(i,j,k)) - pRef = pRef + GV%H_to_Pa * h(i,j,k-1) + dT(K) = (TV%T(i,j,k-1)-TV%T(i,j,k)) + dS(K) = (TV%S(i,j,k-1)-TV%S(i,j,k)) enddo ! k-loop finishes - call calculate_density_derivs(temp_int(:), salt_int(:), pres_int(:), drho_dT(:), drho_dS(:), 1, & - G%ke, TV%EQN_OF_STATE) + call calculate_density_derivs(temp_int, salt_int, pres_int, drho_dT, drho_dS, tv%eqn_of_state) ! The "-1.0" below is needed so that the following criteria is satisfied: ! if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then "salt finger" ! if ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then "diffusive convection" do k=1,G%ke - alpha_dT(k) = -1.0*drho_dT(k) * dT(k) - beta_dS(k) = drho_dS(k) * dS(k) + alpha_dT(k) = -1.0*US%R_to_kg_m3*drho_dT(k) * dT(k) + beta_dS(k) = US%R_to_kg_m3*drho_dS(k) * dS(k) enddo if (CS%id_R_rho > 0.0) then diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 6aa01d50e5..d1e2668c62 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -13,7 +13,7 @@ module MOM_CVMix_shear 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, EOS_type +use MOM_EOS, only : calculate_density use CVMix_shear, only : CVMix_init_shear, CVMix_coeffs_shear use MOM_kappa_shear, only : kappa_shear_is_used implicit none ; private @@ -36,8 +36,8 @@ module MOM_CVMix_shear real :: Nu_zero !< LMD94 maximum interior diffusivity real :: KPP_exp !< Exponent of unitless factor of diff. !! for KPP internal shear mixing scheme. - real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] - real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency [s-2] + real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [T-2 ~> s-2] + real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency [T-2 ~> s-2] real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number real, allocatable, dimension(:,:,:) :: ri_grad_smooth !< Gradient Richardson number !! after smoothing @@ -73,16 +73,25 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) !! call to CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 - real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] - real :: pref, DU, DV, dRho, DZ, N2, S2, dummy - real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d - real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number + real :: GoRho ! Gravitational acceleration divided by density [Z T-2 R-1 ~> m4 s-2 kg-2] + real :: pref ! Interface pressures [R L2 T-2 ~> Pa] + real :: DU, DV ! Velocity differences [L T-1 ~> m s-1] + real :: DZ ! Grid spacing around an interface [Z ~> m] + real :: N2 ! Buoyancy frequency at an interface [T-2 ~> s-2] + real :: S2 ! Shear squared at an interface [T-2 ~> s-2] + real :: dummy ! A dummy variable [nondim] + real :: dRho ! Buoyancy differences [Z T-2 ~> m s-2] + real, dimension(2*(G%ke)) :: pres_1d ! A column of interface pressures [R L2 T-2 ~> Pa] + real, dimension(2*(G%ke)) :: temp_1d ! A column of temperatures [degC] + real, dimension(2*(G%ke)) :: salt_1d ! A column of salinities [ppt] + real, dimension(2*(G%ke)) :: rho_1d ! A column of densities at interface pressures [R ~> kg m-3] + real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number [nondim] real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces [m2 s-1] real, dimension(G%ke+1) :: Kdiff !< Diapycnal diffusivity at interfaces [m2 s-1] - real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers + real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers [m] ! some constants - GoRho = GV%mks_g_Earth / (US%R_to_kg_m3*GV%Rho0) + GoRho = US%L_to_Z**2 * GV%g_Earth / GV%Rho0 do j = G%jsc, G%jec do i = G%isc, G%iec @@ -108,24 +117,24 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) ! pRef is pressure at interface between k and km1. ! iterate pRef for next pass through k-loop. - pRef = pRef + GV%H_to_Pa * h(i,j,k) + pRef = pRef + (GV%g_Earth * GV%H_to_RZ) * h(i,j,k) enddo ! k-loop finishes - ! compute in-situ density - call calculate_density(Temp_1D, Salt_1D, pres_1D, rho_1D, 1, 2*G%ke, TV%EQN_OF_STATE) + ! compute in-situ density [R ~> kg m-3] + call calculate_density(Temp_1D, Salt_1D, pres_1D, rho_1D, tv%eqn_of_state) ! N2 (can be negative) on interface do k = 1, G%ke km1 = max(1, k-1) kk = 2*(k-1) - DU = US%L_T_to_m_s*(u_h(i,j,k) - u_h(i,j,km1)) - DV = US%L_T_to_m_s*(v_h(i,j,k) - v_h(i,j,km1)) - DRHO = (GoRho * (rho_1D(kk+1) - rho_1D(kk+2)) ) - DZ = ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) - N2 = DRHO/DZ - S2 = (DU*DU+DV*DV)/(DZ*DZ) - Ri_Grad(k) = max(0.,N2)/max(S2,1.e-10) + DU = u_h(i,j,k) - u_h(i,j,km1) + DV = v_h(i,j,k) - v_h(i,j,km1) + DRHO = GoRho * (rho_1D(kk+1) - rho_1D(kk+2)) + DZ = (0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_Z + N2 = DRHO / DZ + S2 = US%L_to_Z**2*(DU*DU+DV*DV)/(DZ*DZ) + Ri_Grad(k) = max(0., N2) / max(S2, 1.e-10*US%T_to_s**2) ! fill 3d arrays, if user asks for diagsnostics if (CS%id_N2 > 0) CS%N2(i,j,k) = N2 @@ -139,8 +148,9 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) if (CS%smooth_ri) then ! 1) fill Ri_grad in vanished layers with adjacent value + !### For dimensional consistency, epsln needs to be epsln*GV%m_to_H. do k = 2, G%ke - if (h(i,j,k) .le. epsln) Ri_grad(k) = Ri_grad(k-1) + if (h(i,j,k) <= epsln) Ri_grad(k) = Ri_grad(k-1) enddo Ri_grad(G%ke+1) = Ri_grad(G%ke) @@ -265,13 +275,13 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag CS%id_N2 = register_diag_field('ocean_model', 'N2_shear', diag%axesTi, Time, & - 'Square of Brunt-Vaisala frequency used by MOM_CVMix_shear module', '1/s2') + 'Square of Brunt-Vaisala frequency used by MOM_CVMix_shear module', '1/s2', conversion=US%s_to_T**2) if (CS%id_N2 > 0) then allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%N2(:,:,:) = 0. endif CS%id_S2 = register_diag_field('ocean_model', 'S2_shear', diag%axesTi, Time, & - 'Square of vertical shear used by MOM_CVMix_shear module','1/s2') + 'Square of vertical shear used by MOM_CVMix_shear module','1/s2', conversion=US%s_to_T**2) if (CS%id_S2 > 0) then allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%S2(:,:,:) = 0. endif diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 00686c2bbe..1082bb74e4 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -15,7 +15,7 @@ module MOM_bulk_mixed_layer 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, calculate_density_derivs, EOS_domain implicit none ; private @@ -291,9 +291,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Net_salt, & ! The surface salt flux into the ocean over a time step, ppt H. 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) Pa. + ! 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 [Pa]. + ! 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]. dRcv_dT, & ! Partial derivative of the coordinate variable potential @@ -352,6 +352,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: dt__diag ! A recaled copy of dt_diag (if present) or dt [T ~> s]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz, nkmb, n integer :: nsw ! The number of bands of penetrating shortwave radiation. @@ -437,6 +438,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C do k=1,nz ; do i=is,ie ; dKE_CA(i,k) = 0.0 ; cTKE(i,k) = 0.0 ; enddo ; enddo endif max_BL_det(:) = -1 + EOSdom(:) = EOS_domain(G%HI) !$OMP parallel default(shared) firstprivate(dKE_CA,cTKE,h_CA,max_BL_det,p_ref,p_ref_cv) & !$OMP private(h,u,v,h_orig,eps,T,S,opacity_band,d_ea,d_eb,R0,Rcv,ksort, & @@ -461,20 +463,16 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C enddo ; enddo if (id_clock_EOS>0) call cpu_clock_begin(id_clock_EOS) - ! Calculate an estimate of the mid-mixed layer pressure [Pa] + ! Calculate an estimate of the mid-mixed layer pressure [R L2 T-2 ~> Pa] do i=is,ie ; p_ref(i) = 0.0 ; enddo do k=1,CS%nkml ; do i=is,ie - p_ref(i) = p_ref(i) + 0.5*GV%H_to_Pa*h(i,k) + p_ref(i) = p_ref(i) + 0.5*(GV%H_to_RZ*GV%g_Earth)*h(i,k) enddo ; enddo - call calculate_density_derivs(T(:,1), S(:,1), p_ref, dR0_dT, dR0_dS, & - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, & - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T(:,1), S(:,1), p_ref, dR0_dT, dR0_dS, tv%eqn_of_state, EOSdom) + call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, tv%eqn_of_state, EOSdom) do k=1,nz - call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), is, ie-is+1, & - tv%eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), is, & - ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), tv%eqn_of_state, EOSdom) + call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo if (id_clock_EOS>0) call cpu_clock_end(id_clock_EOS) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index b17f6e4323..92288db846 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -9,7 +9,7 @@ module MOM_diabatic_aux use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type -use MOM_EOS, only : calculate_density, calculate_TFreeze +use MOM_EOS, only : calculate_density, calculate_TFreeze, EOS_domain use MOM_EOS, only : calculate_specific_vol_derivs, calculate_density_derivs use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -111,16 +111,17 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) 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)), & - optional, intent(in) :: p_surf !< The pressure at the ocean surface [Pa]. + optional, intent(in) :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa]. integer, optional, intent(in) :: halo !< Halo width over which to calculate frazil ! 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]. - ps ! pressure + ps ! Surface pressure [R L2 T-2 ~> Pa] real, dimension(SZI_(G),SZK_(G)) :: & - pressure ! The pressure at the middle of each layer [Pa]. + 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]. logical :: T_fr_set ! True if the freezing point has been calculated for a ! row of points. @@ -135,10 +136,11 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) if (.not.CS%pressure_dependent_frazil) then do k=1,nz ; do i=is,ie ; pressure(i,k) = 0.0 ; enddo ; enddo + else + H_to_RL2_T2 = GV%H_to_RZ * GV%g_Earth endif -!$OMP parallel do default(none) shared(is,ie,js,je,CS,G,GV,h,nz,tv,p_surf) & -!$OMP private(fraz_col,T_fr_set,T_freeze,hc,ps) & -!$OMP firstprivate(pressure) !pressure might be set above, so should be firstprivate + !$OMP parallel do default(shared) private(fraz_col,T_fr_set,T_freeze,hc,ps) & + !$OMP firstprivate(pressure) ! pressure might be set above, so should be firstprivate do j=js,je ps(:) = 0.0 if (PRESENT(p_surf)) then ; do i=is,ie @@ -149,11 +151,11 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) if (CS%pressure_dependent_frazil) then do i=is,ie - pressure(i,1) = ps(i) + (0.5*GV%H_to_Pa)*h(i,j,1) + pressure(i,1) = ps(i) + (0.5*H_to_RL2_T2)*h(i,j,1) enddo do k=2,nz ; do i=is,ie pressure(i,k) = pressure(i,k-1) + & - (0.5*GV%H_to_Pa) * (h(i,j,k) + h(i,j,k-1)) + (0.5*H_to_RL2_T2) * (h(i,j,k) + h(i,j,k-1)) enddo ; enddo endif @@ -162,7 +164,7 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) 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) + 1, ie-i+1, tv%eqn_of_state, pres_scale=US%RL2_T2_to_Pa) T_fr_set = .true. endif @@ -188,7 +190,7 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) ((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) + 1, ie-i+1, tv%eqn_of_state, pres_scale=US%RL2_T2_to_Pa) T_fr_set = .true. endif @@ -405,12 +407,13 @@ subroutine insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS, dt, id_brine_lay) real :: dzbr(SZI_(G)) ! Cumulative depth over which brine is distributed [H ~> m to kg m-2] real :: inject_layer(SZI_(G),SZJ_(G)) ! diagnostic - real :: p_ref_cv(SZI_(G)) + real :: p_ref_cv(SZI_(G)) ! The pressure used to calculate the coordinate density [R L2 T-2 ~> Pa] real :: T(SZI_(G),SZK_(G)) real :: S(SZI_(G),SZK_(G)) real :: h_2d(SZI_(G),SZK_(G)) ! A 2-d slice of h with a minimum thickness [H ~> m to kg m-2] - real :: Rcv(SZI_(G),SZK_(G)) + real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density [R ~> kg m-3] real :: s_new,R_new,t0,scale, cdz + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz, ks real :: brine_dz ! minumum thickness over which to distribute brine [H ~> m or kg m-2] @@ -424,7 +427,8 @@ subroutine insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS, dt, id_brine_lay) ! because it is not convergent when resolution becomes very fine. I think that this whole ! subroutine needs to be revisited.- RWH - p_ref_cv(:) = tv%P_ref + p_ref_cv(:) = tv%P_Ref + EOSdom(:) = EOS_domain(G%HI) brine_dz = 1.0*GV%m_to_H inject_layer(:,:) = nz @@ -444,8 +448,7 @@ subroutine insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS, dt, id_brine_lay) h_2d(i,k) = MAX(h(i,j,k), GV%Angstrom_H) enddo - call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), is, & - ie-is+1, tv%eqn_of_state) + call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo ! First, try to find an interior layer where inserting all the salt @@ -516,9 +519,9 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hold !< The layer thicknesses before entrainment, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: ea !< The amount of fluid entrained from the layer - !! above within this time step [H ~> m or kg m-2]. + !! above within this time step [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< The amount of fluid entrained from the layer - !! below within this time step [H ~> m or kg m-2]. + !! below within this time step [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: T !< Layer potential temperatures [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: S !< Layer salinities [ppt]. @@ -735,7 +738,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! Local variables real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences [R ~> kg m-3]. - real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures [Pa]. + 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]. @@ -751,6 +754,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, real :: dH_subML ! Depth below ML over which to diagnose stratification [H ~> m]. real :: aFac ! A nondimensional factor [nondim] real :: ddRho ! A density difference [R ~> kg m-3] + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML @@ -763,10 +767,10 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke pRef_MLD(:) = 0.0 + EOSdom(:) = EOS_domain(G%HI) do j=js,je do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_Z ; enddo ! Depth of center of surface layer - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, is, ie-is+1, & - tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, tv%eqn_of_state, EOSdom) do i=is,ie deltaRhoAtK(i) = 0. MLD(i,j) = 0. @@ -807,8 +811,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! Mixed-layer depth, using sigma-0 (surface reference pressure) do i=is,ie ; deltaRhoAtKm1(i) = deltaRhoAtK(i) ; enddo ! Store value from previous iteration of K - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, is, ie-is+1, & - tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, tv%eqn_of_state, EOSdom) do i = is, ie deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface ddRho = deltaRhoAtK(i) - deltaRhoAtKm1(i) @@ -825,16 +828,14 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, enddo if (id_N2>0) then ! Now actually calculate stratification, N2, below the mixed layer. - do i=is,ie ; pRef_N2(i) = GV%H_to_Pa * (H_subML(i) + 0.5*dH_N2(i)) ; enddo + do i=is,ie ; pRef_N2(i) = (GV%g_Earth * GV%H_to_RZ) * (H_subML(i) + 0.5*dH_N2(i)) ; enddo ! if ((.not.N2_region_set(i)) .and. (dH_N2(i) > 0.5*dH_subML)) then ! ! Use whatever stratification we can, measured over whatever distance is available? ! T_deeper(i) = tv%T(i,j,nz) ; S_deeper(i) = tv%S(i,j,nz) ! N2_region_set(i) = .true. ! endif - call calculate_density(T_subML, S_subML, pRef_N2, rho_subML, is, ie-is+1, & - tv%eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density(T_deeper, S_deeper, pRef_N2, rho_deeper, is, ie-is+1, & - tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T_subML, S_subML, pRef_N2, rho_subML, tv%eqn_of_state, EOSdom) + call calculate_density(T_deeper, S_deeper, pRef_N2, rho_deeper, tv%eqn_of_state, EOSdom) do i=is,ie ; if ((G%mask2dT(i,j)>0.5) .and. N2_region_set(i)) then subMLN2(i,j) = gE_rho0 * (rho_deeper(i) - rho_subML(i)) / (GV%H_to_z * dH_N2(i)) endif ; enddo @@ -895,9 +896,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t real :: RivermixConst ! A constant used in implementing river mixing [R Z2 T-1 ~> Pa s]. real, dimension(SZI_(G)) :: & - d_pres, & ! pressure change across a layer [Pa] - p_lay, & ! average pressure in a layer [Pa] - pres, & ! pressure at an interface [Pa] + d_pres, & ! pressure change across a layer [R L2 T-2 ~> Pa] + p_lay, & ! average pressure in a layer [R L2 T-2 ~> Pa] + pres, & ! pressure at an interface [R L2 T-2 ~> Pa] netMassInOut, & ! surface water fluxes [H ~> m or kg m-2] over time step 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 @@ -907,7 +908,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! [ppt 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] - SurfPressure, & ! Surface pressure (approximated as 0.0) [Pa] + 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] @@ -939,8 +940,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! [Z T-2 R-1 ~> m4 s-2 kg-1] logical :: calculate_energetics logical :: calculate_buoyancy + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je, k, nz, n, nb - integer :: start, npts character(len=45) :: mesg is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -955,13 +956,12 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 g_Hconv2 = (US%L_to_Z**2*GV%g_Earth * GV%H_to_RZ) * GV%H_to_RZ + EOSdom(:) = EOS_domain(G%HI) if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then - SurfPressure(:) = 0.0 + SurfPressure(:) = 0.0 !### Add fluxes%p_surf_full? GoRho = US%L_to_Z**2*GV%g_Earth / GV%Rho0 - start = 1 + G%isc - G%isd - npts = 1 + G%iec - G%isc endif ! H_limit_fluxes is used by extractFluxes1d to scale down fluxes if the total @@ -978,8 +978,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,tv,nsw,G,GV,US,optics,fluxes, & !$OMP H_limit_fluxes,numberOfGroundings,iGround,jGround,& !$OMP nonPenSW,hGrounding,CS,Idt,aggregate_FW_forcing, & - !$OMP minimum_forcing_depth,evap_CFL_limit,dt, & - !$OMP calculate_buoyancy,netPen_rate,SkinBuoyFlux,GoRho, & + !$OMP minimum_forcing_depth,evap_CFL_limit,dt,EOSdom, & + !$OMP calculate_buoyancy,netPen_rate,SkinBuoyFlux,GoRho, & !$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2) & !$OMP private(opacityBand,h2d,T2d,netMassInOut,netMassOut, & !$OMP netHeat,netSalt,Pen_SW_bnd,fractionOfForcing, & @@ -989,7 +989,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !$OMP netmassinout_rate,netheat_rate,netsalt_rate, & !$OMP drhodt,drhods,pen_sw_bnd_rate, & !$OMP pen_TKE_2d,Temp_in,Salin_in,RivermixConst) & - !$OMP firstprivate(start,npts,SurfPressure) + !$OMP firstprivate(SurfPressure) do j=js,je ! Work in vertical slices for efficiency @@ -1004,15 +1004,15 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! The partial derivatives of specific volume with temperature and ! salinity need to be precalculated to avoid having heating of ! tiny layers give nonsensical values. - do i=is,ie ; pres(i) = 0.0 ; enddo ! Add surface pressure? + do i=is,ie ; pres(i) = 0.0 ; enddo ! ###Add surface pressure? do k=1,nz do i=is,ie - d_pres(i) = GV%H_to_Pa * h2d(i,k) + d_pres(i) = (GV%g_Earth * GV%H_to_RZ) * h2d(i,k) p_lay(i) = pres(i) + 0.5*d_pres(i) pres(i) = pres(i) + d_pres(i) enddo - call calculate_specific_vol_derivs(T2d(:,k), tv%S(:,j,k), p_lay(:),& - dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state, scale=US%R_to_kg_m3) + call calculate_specific_vol_derivs(T2d(:,k), tv%S(:,j,k), p_lay(:), & + dSV_dT(:,j,k), dSV_dS(:,j,k), tv%eqn_of_state, EOSdom) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo enddo pen_TKE_2d(:,:) = 0.0 @@ -1353,8 +1353,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t do i=is,ie ; do nb=1,nsw ; netPen_rate(i) = netPen_rate(i) + pen_SW_bnd_rate(nb,i) ; enddo ; enddo ! Density derivatives - call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, & - dRhodT, dRhodS, start, npts, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, dRhodT, dRhodS, & + tv%eqn_of_state, EOSdom) ! 1. Adjust netSalt to reflect dilution effect of FW flux ! 2. Add in the SW heating for purposes of calculating the net ! surface buoyancy flux affecting the top layer. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 256ec63ffd..1ee10cebec 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -34,8 +34,7 @@ module MOM_diabatic_driver use MOM_energetic_PBL, only : energetic_PBL_get_MLD use MOM_entrain_diffusive, only : entrainment_diffusive, entrain_diffusive_init use MOM_entrain_diffusive, only : entrain_diffusive_end, entrain_diffusive_CS -use MOM_EOS, only : calculate_density, calculate_TFreeze -use MOM_EOS, only : calculate_specific_vol_derivs +use MOM_EOS, only : calculate_density, calculate_TFreeze, EOS_domain use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery,MOM_mesg use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, log_version, param_file_type, read_param @@ -1979,9 +1978,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser ! than the buffer layer [nondim] - real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential - ! density which defines the coordinate - ! variable, set to P_Ref [Pa]. + real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential density that defines the + ! coordinate variable, set to P_Ref [R L2 T-2 ~> Pa]. logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that @@ -2014,6 +2012,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) @@ -2682,10 +2681,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Layer mode sponge if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo + EOSdom(:) = EOS_domain(G%HI) !$OMP parallel do default(shared) do j=js,je - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & + tv%eqn_of_state, EOSdom) enddo call apply_sponge(h, dt, G, GV, US, ea, eb, CS%sponge_CSp, Rcv_ml) else diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index fd8d19aa61..a83b18bf2f 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -130,7 +130,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & !! [Z2 T-1 ~> m2 s-1]. real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]. real, intent(out) :: energy_Kd !< The column-integrated rate of energy - !! consumption by diapycnal diffusion [W m-2]. + !! consumption by diapycnal diffusion [R Z L2 T-3 ~> W m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. !! Absent fields have NULL ptrs. @@ -147,9 +147,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! for other bits of code. real, dimension(GV%ke) :: & - p_lay, & ! Average pressure of a layer [Pa]. - dSV_dT, & ! Partial derivative of specific volume with temperature [m3 kg-1 degC-1]. - dSV_dS, & ! Partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. + 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]. @@ -166,8 +166,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. Sh_b, & ! An effective salinity times a thickness in the layer below, including implicit ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. - dT_to_dPE, & ! Partial derivative of column potential energy with the temperature - dS_to_dPE, & ! and salinity changes within a layer [J m-2 degC-1] and [J m-2 ppt-1]. + 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]. dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt, & ! and salinity changes within a layer [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature @@ -179,11 +179,11 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in - ! units of [J m-2 degC-1] and [J m-2 ppt-1]. + ! 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]. 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 [J m-2 degC-1] and [J m-2 ppt-1]. + ! 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]. 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. @@ -195,9 +195,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & h_tr ! h_tr is h at tracer points with a h_neglect added to ! ensure positive definiteness [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & - pres, & ! Interface pressures [Pa]. + pres, & ! Interface pressures [R L2 T-2 ~> Pa]. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height - ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. + ! movements into changes in column potential energy [R L2 T-2 m Z-1 ~> J m-3]. z_Int, & ! Interface heights relative to the surface [H ~> m or kg m-2]. N2, & ! An estimate of the buoyancy frequency [T-2 ~> s-2]. Kddt_h, & ! The diapycnal diffusivity times a timestep divided by the @@ -211,9 +211,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke+1,4) :: & PE_chg_k, & ! The integrated potential energy change within a timestep due ! to the diffusivity at interface K for 4 different orders of - ! accumulating the diffusivities [J m-2]. + ! accumulating the diffusivities [R Z L2 T-2 ~> J m-2]. ColHt_cor_k ! The correction to the potential energy change due to - ! changes in the net column height [J m-2]. + ! changes in the net column height [R Z L2 T-2 ~> J m-2]. real :: & b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: & @@ -227,17 +227,17 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & 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]. 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 [kg m-2]. - real :: dPres ! The hydrostatic pressure change across a layer [Pa]. + 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]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of - ! the water above the interface [J m-2 = kg s-2]. - real :: rho_here ! The in-situ density [kg m-3]. + ! the water above the interface [R Z L2 T-2 ~> J m-2 = kg s-2]. + real :: rho_here ! The in-situ density [R ~> kg m-3]. real :: PE_change ! The change in column potential energy from applying Kddt_h at the - ! present interface [J m-2]. + ! present interface [R L2 Z T-2 ~> J m-2]. real :: ColHt_cor ! The correction to PE_chg that is made due to a net - ! change in the column height [J m-2]. + ! change in the column height [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]. @@ -280,8 +280,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & T0(k) = T_in(k) ; S0(k) = S_in(k) h_tr(k) = h_in(k) htot = htot + h_tr(k) - pres(K+1) = pres(K) + GV%H_to_Pa * h_tr(k) - pres_Z(K+1) = US%Z_to_m * pres(K+1) + pres(K+1) = pres(K) + (GV%g_Earth * GV%H_to_RZ) * h_tr(k) + pres_Z(K+1) = pres(K+1) p_lay(k) = 0.5*(pres(K) + pres(K+1)) Z_int(K+1) = Z_int(K) - h_tr(k) enddo @@ -298,15 +298,15 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! Solve the tridiagonal equations for new temperatures. - call calculate_specific_vol_derivs(T0, S0, p_lay, dSV_dT, dSV_dS, 1, nz, tv%eqn_of_state) + call calculate_specific_vol_derivs(T0, S0, p_lay, dSV_dT, dSV_dS, tv%eqn_of_state) do k=1,nz - dMass = GV%H_to_kg_m2 * h_tr(k) - dPres = GV%H_to_Pa * h_tr(k) + dMass = GV%H_to_RZ * h_tr(k) + dPres = (GV%g_Earth * GV%H_to_RZ) * h_tr(k) dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(k) dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(k) - dT_to_dColHt(k) = dMass * US%m_to_Z * dSV_dT(k) * CS%ColHt_scaling - dS_to_dColHt(k) = dMass * US%m_to_Z * dSV_dS(k) * CS%ColHt_scaling + dT_to_dColHt(k) = dMass * dSV_dT(k) * CS%ColHt_scaling + dS_to_dColHt(k) = dMass * dSV_dS(k) * CS%ColHt_scaling enddo ! PE_chg_k(1) = 0.0 ; PE_chg_k(nz+1) = 0.0 @@ -404,7 +404,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & (PE_chg(5)-Pe_chg(1))/(0.04*Kddt_h(K)) dPEa_dKd_err(k) = (dPEa_dKd_est(k) - dPEa_dKd(k)) dPEa_dKd_err_norm(k) = (dPEa_dKd_est(k) - dPEa_dKd(k)) / & - (abs(dPEa_dKd_est(k)) + abs(dPEa_dKd(k)) + 1e-100) + (abs(dPEa_dKd_est(k)) + abs(dPEa_dKd(k)) + 1e-100*US%RZ_to_kg_m2*US%L_T_to_m_s**2) endif ! At this point, the final value of Kddt_h(K) is known, so the estimated @@ -550,7 +550,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & (PE_chg(5)-Pe_chg(1))/(0.04*Kddt_h(K)) dPEb_dKd_err(k) = (dPEb_dKd_est(k) - dPEb_dKd(k)) dPEb_dKd_err_norm(k) = (dPEb_dKd_est(k) - dPEb_dKd(k)) / & - (abs(dPEb_dKd_est(k)) + abs(dPEb_dKd(k)) + 1e-100) + (abs(dPEb_dKd_est(k)) + abs(dPEb_dKd(k)) + 1e-100*US%RZ_to_kg_m2*US%L_T_to_m_s**2) endif ! At this point, the final value of Kddt_h(K) is known, so the estimated @@ -917,7 +917,6 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & energy_Kd = 0.0 ; do K=2,nz ; energy_Kd = energy_Kd + PE_chg_k(K,1) ; enddo energy_Kd = energy_Kd / dt - K=nz if (do_print) then if (CS%id_ERt>0) call post_data(CS%id_ERt, PE_chg_k(:,1), CS%diag) @@ -997,22 +996,22 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above [J m-2 degC-1]. + !! in the temperatures of all the layers above [R Z L2 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above [J m-2 ppt-1]. + !! in the salinities of all the layers above [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below [J m-2 degC-1]. + !! in the temperatures of all the layers below [R Z L2 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below [J m-2 ppt-1]. + !! in the salinities of all the layers below [R Z L2 T-2 ppt-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 [J m-2 Z-1 ~> J m-3]. + !! as gravity waves and unavailable to drive mixing [R L2 T-2 m Z-1 ~> 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 @@ -1031,25 +1030,25 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [J m-2]. + !! Kddt_h at the present interface [R Z L2 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h, - !! [J m-2 H-1 ~> J m-3 or J kg-1]. + !! [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the - !! present interface [J m-2]. + !! present interface [R Z L2 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. + !! limit where Kddt_h = 0 [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net - !! change in the column height [J m-2]. + !! change in the column height [R Z L2 T-2 ~> J m-2]. real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. real :: dT_c ! The core term in the expressions for the temperature changes [degC H2 ~> degC m2 or degC kg2 m-4]. real :: dS_c ! The core term in the expressions for the salinity changes [psu H2 ~> psu m2 or psu kg2 m-4]. real :: PEc_core ! The diffusivity-independent core term in the expressions - ! for the potential energy changes [J m-3]. + ! for the potential energy changes [R L2 T-2 ~> J m-3]. real :: ColHt_core ! The diffusivity-independent core term in the expressions - ! for the column height changes [J m-3]. + ! for the column height changes [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. @@ -1136,23 +1135,23 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! salinity change in the layer above the interface [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 [J m-2 Z-1 ~> J m-3]. + !! 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 [J m-2 degC-1]. + !! in the temperatures of all the layers below [R Z L2 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below [J m-2 ppt-1]. + !! in the salinities of all the layers below [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above [J m-2 degC-1]. + !! in the temperatures of all the layers above [R Z L2 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above [J m-2 ppt-1]. + !! in the salinities of all the layers above [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes @@ -1171,14 +1170,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [J m-2]. + !! Kddt_h at the present interface [R Z L2 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h, - !! [J m-2 H-1 ~> J m-3 or J kg-1]. + !! [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realized by applying a huge value of Kddt_h at the - !! present interface [J m-2]. + !! present interface [R Z L2 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. + !! limit where Kddt_h = 0 [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. ! This subroutine determines the total potential energy change due to mixing ! at an interface, including all of the implicit effects of the prescribed @@ -1302,13 +1301,17 @@ subroutine diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS) "place of any that might be passed in as an argument.", default=.false.) CS%id_ERt = register_diag_field('ocean_model', 'EnReqTest_ERt', diag%axesZi, Time, & - "Diffusivity Energy Requirements, top-down", "J m-2") + "Diffusivity Energy Requirements, top-down", & + "J m-2", conversion=US%RZ_to_kg_m2*US%L_T_to_m_s**2) CS%id_ERb = register_diag_field('ocean_model', 'EnReqTest_ERb', diag%axesZi, Time, & - "Diffusivity Energy Requirements, bottom-up", "J m-2") + "Diffusivity Energy Requirements, bottom-up", & + "J m-2", conversion=US%RZ_to_kg_m2*US%L_T_to_m_s**2) CS%id_ERc = register_diag_field('ocean_model', 'EnReqTest_ERc', diag%axesZi, Time, & - "Diffusivity Energy Requirements, center-last", "J m-2") + "Diffusivity Energy Requirements, center-last", & + "J m-2", conversion=US%RZ_to_kg_m2*US%L_T_to_m_s**2) CS%id_ERh = register_diag_field('ocean_model', 'EnReqTest_ERh', diag%axesZi, Time, & - "Diffusivity Energy Requirements, halves", "J m-2") + "Diffusivity Energy Requirements, halves", & + "J m-2", conversion=US%RZ_to_kg_m2*US%L_T_to_m_s**2) CS%id_Kddt = register_diag_field('ocean_model', 'EnReqTest_Kddt', diag%axesZi, Time, & "Implicit diffusive coupling coefficient", "m", conversion=GV%H_to_m) CS%id_Kd = register_diag_field('ocean_model', 'EnReqTest_Kd', diag%axesZi, Time, & @@ -1318,13 +1321,17 @@ subroutine diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS) CS%id_zInt = register_diag_field('ocean_model', 'EnReqTest_z_int', diag%axesZi, Time, & "Test column layer interface heights", "m", conversion=GV%H_to_m) CS%id_CHCt = register_diag_field('ocean_model', 'EnReqTest_CHCt', diag%axesZi, Time, & - "Column Height Correction to Energy Requirements, top-down", "J m-2") + "Column Height Correction to Energy Requirements, top-down", & + "J m-2", conversion=US%RZ_to_kg_m2*US%L_T_to_m_s**2) CS%id_CHCb = register_diag_field('ocean_model', 'EnReqTest_CHCb', diag%axesZi, Time, & - "Column Height Correction to Energy Requirements, bottom-up", "J m-2") + "Column Height Correction to Energy Requirements, bottom-up", & + "J m-2", conversion=US%RZ_to_kg_m2*US%L_T_to_m_s**2) CS%id_CHCc = register_diag_field('ocean_model', 'EnReqTest_CHCc', diag%axesZi, Time, & - "Column Height Correction to Energy Requirements, center-last", "J m-2") + "Column Height Correction to Energy Requirements, center-last", & + "J m-2", conversion=US%RZ_to_kg_m2*US%L_T_to_m_s**2) CS%id_CHCh = register_diag_field('ocean_model', 'EnReqTest_CHCh', diag%axesZi, Time, & - "Column Height Correction to Energy Requirements, halves", "J m-2") + "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") CS%id_Tf = register_diag_field('ocean_model', 'EnReqTest_Tf', diag%axesZL, Time, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7ba477466e..48b265a0e2 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -17,8 +17,6 @@ module MOM_energetic_PBL use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only: wave_parameters_CS, Get_Langmuir_Number -! use MOM_EOS, only : calculate_density, calculate_density_derivs - implicit none ; private #include @@ -658,7 +656,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: dMass ! The mass per unit area within a layer [Z R ~> kg m-2]. - real :: dPres ! The hydrostatic pressure change across a layer [R Z2 T-2 ~> kg m-1 s-2 = Pa = J m-3]. + real :: dPres ! The hydrostatic pressure change across a layer [R Z2 T-2 ~> Pa = J m-3]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of @@ -805,7 +803,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs pres_Z(1) = 0.0 do k=1,nz dMass = GV%H_to_RZ * h(k) - dPres = US%L_to_Z**2 * GV%g_Earth * dMass ! Equivalent to GV%H_to_Pa * h(k) with rescaling + dPres = US%L_to_Z**2 * GV%g_Earth * dMass dT_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dT(k) dS_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dS(k) dT_to_dColHt(k) = dMass * dSV_dT(k) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 0fd691e7ab..4e30756f7b 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -12,7 +12,7 @@ module MOM_entrain_diffusive 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, calculate_density_derivs, EOS_domain implicit none ; private @@ -123,7 +123,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & htot, & ! The total thickness above or below a layer [H ~> m or kg m-2]. Rcv, & ! Value of the coordinate variable (potential density) ! based on the simulated T and S and P_Ref [R ~> kg m-3]. - pres, & ! Reference pressure (P_Ref) [Pa]. + pres, & ! Reference pressure (P_Ref) [R L2 T-2 ~> Pa]. eakb, & ! The entrainment from above by the layer below the buffer ! layer (i.e. layer kb) [H ~> m or kg m-2]. ea_kbp1, & ! The entrainment from above by layer kb+1 [H ~> m or kg m-2]. @@ -174,7 +174,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors ! [m3 H-2 s-2 T-1 ~> m s-3 or m7 kg-2 s-3]. real, dimension(SZI_(G)) :: & - pressure, & ! The pressure at an interface [Pa]. + 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]. dRho_dT, dRho_dS ! The partial derivatives of potential density with temperature and @@ -199,6 +199,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & logical :: do_any logical :: do_entrain_eakb ! True if buffer layer is entrained logical :: do_i(SZI_(G)), did_i(SZI_(G)), reiterate, correct_density + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: it, i, j, k, is, ie, js, je, nz, K2, kmb integer :: kb(SZI_(G)) ! The value of kb in row j. integer :: kb_min ! The minimum value of kb in the current j-row. @@ -247,10 +248,11 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & else pres(:) = 0.0 endif + EOSdom(:) = EOS_domain(G%HI) !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_Lay,G,GV,US,dt,CS,h,tv, & !$OMP kmb,Angstrom,fluxes,K2,h_neglect,tolerance, & - !$OMP ea,eb,correct_density,Kd_int,Kd_eff, & + !$OMP ea,eb,correct_density,Kd_int,Kd_eff,EOSdom, & !$OMP diff_work,g_2dt, kb_out) & !$OMP firstprivate(kb,ds_dsp1,dsp1_ds,pres,kb_min) & !$OMP private(dtKd,dtKd_int,do_i,Ent_bl,dtKd_kb,h_bl, & @@ -700,8 +702,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & call determine_dSkb(h_bl, Sref, Ent_bl, eakb, is, ie, kmb, G, GV, & .true., dS_kb, dS_anom_lim=dS_anom_lim) do k=nz-1,kb_min,-1 - call calculate_density(tv%T(is:ie,j,k), tv%S(is:ie,j,k), pres(is:ie), & - Rcv(is:ie), 1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, tv%eqn_of_state, EOSdom) do i=is,ie if ((k>kb(i)) .and. (F(i,k) > 0.0)) then ! Within a time step, a layer may entrain no more than its @@ -784,9 +785,8 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & enddo else ! not bulkmixedlayer - do k=K2,nz-1 - call calculate_density(tv%T(is:ie,j,k), tv%S(is:ie,j,k), pres(is:ie), & - Rcv(is:ie), 1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + do k=K2,nz-1; + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, tv%eqn_of_state, EOSdom) do i=is,ie ; if (F(i,k) > 0.0) then ! Within a time step, a layer may entrain no more than ! its thickness for correction. This limitation should @@ -841,7 +841,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & do i=is,ie ; pressure(i) = 0.0 ; enddo endif do K=2,nz - do i=is,ie ; pressure(i) = pressure(i) + GV%H_to_Pa*h(i,j,k-1) ; enddo + do i=is,ie ; pressure(i) = pressure(i) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1) ; enddo do i=is,ie if (k==kb(i)) then T_eos(i) = 0.5*(tv%T(i,j,kmb) + tv%T(i,j,k)) @@ -851,8 +851,8 @@ 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, is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + 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-1 or m2 kg-1] and [nondim]. Rcv, & ! Value of the coordinate variable (potential density) ! based on the simulated T and S and P_Ref [R ~> kg m-3]. - pres, & ! Reference pressure (P_Ref) [Pa]. + pres, & ! Reference pressure (P_Ref) [R L2 T-2 ~> Pa]. frac_rem, & ! The fraction of the diffusion remaining [nondim]. h_interior ! The interior thickness available for entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G), SZK_(G)) :: & @@ -1077,6 +1077,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, ! entrained [H2 ~> m2 or kg2 m-4]. 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]. + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke @@ -1085,9 +1086,9 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, h_neglect = GV%H_subroundoff do i=is,ie ; pres(i) = tv%P_Ref ; enddo + EOSdom(:) = EOS_domain(G%HI) do k=1,kmb - call calculate_density(tv%T(is:ie,j,k), tv%S(is:ie,j,k), pres(is:ie), & - Rcv(is:ie), 1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, tv%eqn_of_state, EOSdom) do i=is,ie h_bl(i,k) = h(i,j,k) + h_neglect Sref(i,k) = Rcv(i) - CS%Rho_sig_off diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index daf41a1ad3..1783955d53 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -7,7 +7,7 @@ module MOM_full_convection 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_derivs +use MOM_EOS, only : calculate_density_derivs, EOS_domain implicit none ; private @@ -31,7 +31,7 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, intent(out) :: T_adj !< Adjusted potential temperature [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: S_adj !< Adjusted salinity [ppt]. - real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [Pa] (or NULL). + 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]. real, optional, intent(in) :: Kddt_convect !< A large convecting vertical @@ -335,7 +335,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h !! potential density with salinity [R degC-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 [Pa]. + real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa]. integer, optional, intent(in) :: halo !< Halo width over which to compute ! Local variables @@ -345,13 +345,14 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real :: T_f(SZI_(G),SZK_(G)) ! Filtered temperatures [degC] real :: S_f(SZI_(G),SZK_(G)) ! Filtered salinities [ppt] - real :: pres(SZI_(G)) ! Interface pressures [Pa]. + 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 :: 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]. real :: h_tr ! The thickness at tracer points, plus h_neglect [H ~> m or kg m-2]. + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz if (present(halo)) then @@ -407,21 +408,19 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h else do i=is,ie ; pres(i) = 0.0 ; enddo endif - call calculate_density_derivs(T_f(:,1), S_f(:,1), pres, dR_dT(:,1), dR_dS(:,1), & - is-G%isd+1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) - do i=is,ie ; pres(i) = pres(i) + h(i,j,1)*GV%H_to_Pa ; enddo + EOSdom(:) = EOS_domain(G%HI) + call calculate_density_derivs(T_f(:,1), S_f(:,1), pres, dR_dT(:,1), dR_dS(:,1), tv%eqn_of_state, EOSdom) + do i=is,ie ; pres(i) = pres(i) + h(i,j,1)*(GV%H_to_RZ*GV%g_Earth) ; enddo do K=2,nz do i=is,ie T_EOS(i) = 0.5*(T_f(i,k-1) + T_f(i,k)) S_EOS(i) = 0.5*(S_f(i,k-1) + S_f(i,k)) enddo - call calculate_density_derivs(T_EOS, S_EOS, pres, dR_dT(:,K), dR_dS(:,K), & - is-G%isd+1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) - do i=is,ie ; pres(i) = pres(i) + h(i,j,k)*GV%H_to_Pa ; enddo + call calculate_density_derivs(T_EOS, S_EOS, pres, dR_dT(:,K), dR_dS(:,K), tv%eqn_of_state, EOSdom) + do i=is,ie ; pres(i) = pres(i) + h(i,j,k)*(GV%H_to_RZ*GV%g_Earth) ; enddo enddo call calculate_density_derivs(T_f(:,nz), S_f(:,nz), pres, dR_dT(:,nz+1), dR_dS(:,nz+1), & - is-G%isd+1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) - + tv%eqn_of_state, EOSdom) end subroutine smoothed_dRdT_dRdS diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index e26e126db8..66116575d5 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -77,7 +77,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) heat_rem, & ! remaining heat [H degC ~> 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 ! coordiante densities reference pressure [Pa] + 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] @@ -198,8 +198,8 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) iej = is-1 ; do i=ie,is,-1 ; if (do_i(i)) then ; iej = i ; exit ; endif ; enddo if (nkmb > 0) then - call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_Ref(:), & - Rcv_BL(:), isj, iej-isj+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_Ref(:), Rcv_BL(:), & + tv%eqn_of_state, (/isj-(G%isd-1),iej-(G%isd-1)/) ) else Rcv_BL(:) = -1.0 endif @@ -245,11 +245,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) Rcv = 0.0 ; dRcv_dT = 0.0 ! Is this OK? else call calculate_density(tv%T(i,j,k), tv%S(i,j,k), tv%P_Ref, & - Rcv, tv%eqn_of_state, scale=US%kg_m3_to_R) + Rcv, tv%eqn_of_state) T2(1) = tv%T(i,j,k) ; S2(1) = tv%S(i,j,k) T2(2) = tv%T(i,j,k_tgt) ; S2(2) = tv%S(i,j,k_tgt) - call calculate_density_derivs(T2(:), S2(:), p_Ref(:), & - dRcv_dT_, dRcv_dS_, 1, 2, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T2(:), S2(:), p_Ref(:), dRcv_dT_, dRcv_dS_, & + tv%eqn_of_state, (/1,2/) ) dRcv_dT = 0.5*(dRcv_dT_(1) + dRcv_dT_(2)) endif diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 7a0f517020..f5b9e7dbb7 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -18,7 +18,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 +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain implicit none ; private @@ -137,7 +137,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) if (CS%debug) then call hchksum(N2_bot,"N2_bot",G%HI,haloshift=0, scale=US%s_to_T**2) call hchksum(itide%TKE_itidal_input,"TKE_itidal_input",G%HI,haloshift=0, & - scale=US%R_to_kg_m3*US%Z_to_m**3*US%s_to_T**3) + scale=US%RZ3_T3_to_W_m2) endif if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, itide%TKE_itidal_input, CS%diag) @@ -167,7 +167,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) real, dimension(SZI_(G),SZK_(G)+1) :: & dRho_int ! The unfiltered density differences across interfaces [R ~> kg m-3]. real, dimension(SZI_(G)) :: & - pres, & ! The pressure at each interface [Pa]. + 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]. drho_bot, & ! The density difference at the bottom of a layer [R ~> kg m-3] @@ -181,17 +181,19 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq ! density [Z T-2 R-1 ~> m4 s-2 kg-1]. logical :: do_i(SZI_(G)), do_any + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke G_Rho0 = (US%L_to_Z**2*GV%g_Earth) / GV%Rho0 + EOSdom(:) = EOS_domain(G%HI) ! Find the (limited) density jump across each interface. do i=is,ie dRho_int(i,1) = 0.0 ; dRho_int(i,nz+1) = 0.0 enddo !$OMP parallel do default(none) shared(is,ie,js,je,nz,tv,fluxes,G,GV,US,h,T_f,S_f, & -!$OMP h2,N2_bot,G_Rho0) & +!$OMP h2,N2_bot,G_Rho0,EOSdom) & !$OMP private(pres,Temp_Int,Salin_Int,dRho_dT,dRho_dS, & !$OMP hb,dRho_bot,z_from_bot,do_i,h_amp, & !$OMP do_any,dz_int) & @@ -205,12 +207,12 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) endif do K=2,nz do i=is,ie - pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) + pres(i) = pres(i) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1) Temp_Int(i) = 0.5 * (T_f(i,j,k) + T_f(i,j,k-1)) Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1)) enddo - call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(Temp_int, Salin_int, pres, dRho_dT(:), dRho_dS(:), & + tv%eqn_of_state, EOSdom) do i=is,ie dRho_int(i,K) = max(dRho_dT(i)*(T_f(i,j,k) - T_f(i,j,k-1)) + & dRho_dS(i)*(S_f(i,j,k) - S_f(i,j,k-1)), 0.0) @@ -349,7 +351,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & "The maximum internal tide energy source available to mix "//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & - units="W m-2", default=1.0e3, scale=US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3) + units="W m-2", default=1.0e3, scale=US%W_m2_to_RZ3_T3) call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & "If true, read a file (given by TIDEAMP_FILE) containing "//& diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 0cbcf235de..107a80b058 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -14,7 +14,7 @@ module MOM_kappa_shear 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 @@ -119,7 +119,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. - real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [Pa] (or NULL). + real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa] (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. Initially this is the @@ -160,7 +160,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. - real :: surface_pres ! The top surface pressure [Pa]. + real :: surface_pres ! The top surface pressure [R L2 T-2 ~> Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. @@ -389,7 +389,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. - real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [Pa] + real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa] !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: kappa_io !< The diapycnal diffusivity at each interface @@ -430,7 +430,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. - real :: surface_pres ! The top surface pressure [Pa]. + real :: surface_pres ! The top surface pressure [R L2 T-2 ~> Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. @@ -661,7 +661,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ if (CS%debug) then call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s) - call Bchksum(tke_io, "tke", G%HI) + call Bchksum(tke_io, "tke", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif if (CS%id_Kd_shear > 0) call post_data(CS%id_Kd_shear, kappa_io, CS%diag) @@ -679,7 +679,6 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)+1), & intent(inout) :: kappa !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & @@ -687,7 +686,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & !! an interface [Z2 T-2 ~> m2 s-2]. integer, intent(in) :: nzc !< The number of active layers in the column. real, intent(in) :: f2 !< The square of the Coriolis parameter [T-2 ~> s-2]. - real, intent(in) :: surface_pres !< The surface pressure [Pa]. + real, intent(in) :: surface_pres !< The surface pressure [R L2 T-2 ~> Pa]. real, dimension(SZK_(GV)), & intent(in) :: dz !< The layer thickness [Z ~> m]. real, dimension(SZK_(GV)), & @@ -708,6 +707,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & !! have NULL ptrs. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)+1), & optional, intent(out) :: I_Ld2_1d !< The inverse of the squared mixing length [Z-2 ~> m-2]. real, dimension(SZK_(GV)+1), & @@ -741,15 +741,15 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 T-1 ~> m2 s-1]. tke_pred, & ! The value of TKE from a predictor step [Z2 T-2 ~> m2 s-2]. kappa_pred, & ! The value of kappa from a predictor step [Z2 T-1 ~> m2 s-1]. - pressure, & ! The pressure at an interface [Pa]. + 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]. 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]. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean ! distance to the top and bottom boundaries [Z-2 ~> m-2]. - K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s2 T-1 ~> s]. - K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [Z2 m-2 s2 T-1 ~> s]. + K_Q, & ! Diffusivity divided by TKE [T ~> s]. + K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [T ~> s]. local_src_avg, & ! The time-integral of the local source [nondim]. tol_min, & ! Minimum tolerated ksrc for the corrector step [T-1 ~> s-1]. tol_max, & ! Maximum tolerated ksrc for the corrector step [T-1 ~> s-1]. @@ -762,8 +762,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: b1 ! The inverse of the pivot in the tridiagonal equations. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. - real :: gR0 ! A conversion factor from Z to Pa equal to Rho_0 times g - ! [Pa Z-1 = kg m-1 s-2 Z-1 ~> kg m-2 s-2]. + real :: gR0 ! A conversion factor from Z to pressure, given by Rho_0 times g + ! [R L2 T-2 Z-1 ~> kg m-2 s-2]. real :: g_R0 ! g_R0 is a rescaled version of g/Rho [Z R-1 T-2 ~> m4 kg-1 s-2]. real :: Norm ! A factor that normalizes two weights to 1 [Z-2 ~> m-2]. real :: tol_dksrc ! Tolerance for the change in the kappa source within an iteration @@ -813,7 +813,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & #endif Ri_crit = CS%Rino_crit - gR0 = GV%z_to_H*GV%H_to_Pa + gR0 = GV%Rho0 * GV%g_Earth g_R0 = (US%L_to_Z**2 * GV%g_Earth) / (GV%Rho0) k0dt = dt*CS%kappa_0 @@ -910,8 +910,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & T_int(K) = 0.5*(T(k-1) + T(k)) Sal_int(K) = 0.5*(Sal(k-1) + Sal(k)) enddo - call calculate_density_derivs(T_int, Sal_int, pressure, dbuoy_dT, & - dbuoy_dS, 2, nzc-1, tv%eqn_of_state, scale=-g_R0*US%kg_m3_to_R) + call calculate_density_derivs(T_int, Sal_int, pressure, dbuoy_dT, dbuoy_dS, & + tv%eqn_of_state, (/2,nzc/), scale=-g_R0 ) else do K=1,nzc+1 ; dbuoy_dT(K) = -g_R0 ; dbuoy_dS(K) = 0.0 ; enddo endif @@ -1388,7 +1388,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by !! the turbulent kinetic energy per unit mass at - !! interfaces [Z2 m-2 s2 T-1 ~> s]. + !! interfaces [T ~> s]. real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at !! interfaces [Z2 T-2 ~> m2 s-2]. real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index a4a4723092..00c8258fb7 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 +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain implicit none ; private @@ -179,7 +179,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) ! d_ea mean a net gain in mass by a layer from downward motion. real, dimension(SZI_(G)) :: & p_ref_cv, & ! Reference pressure for the potential density which defines - ! the coordinate variable, set to P_Ref [Pa]. + ! the coordinate variable, set to P_Ref [R L2 T-2 ~> Pa]. Rcv_tol, & ! A tolerence, relative to the target density differences ! between layers, for detraining into the interior [nondim]. h_add_tgt, h_add_tot, & @@ -215,6 +215,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) logical :: debug = .false. logical :: fatal_error character(len=256) :: mesg ! Message for error messages. + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz, nkmb, nkml, k1, k2, k3, ks, nz_filt, kmax_d_ea is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -241,6 +242,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) I_dtol34 = 1.0 / max(CS%h_def_tol4 - CS%h_def_tol3, 1e-40) p_ref_cv(:) = tv%P_Ref + EOSdom(:) = EOS_domain(G%HI) do j=js-1,je+1 ; do i=is-1,ie+1 e(i,j,1) = 0.0 @@ -308,12 +310,11 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) ! Now restructure the layers. !$OMP parallel do default(private) shared(is,ie,js,je,nz,do_j,def_rat_h,CS,nkmb,G,GV,US, & !$OMP e,I_dtol,h,tv,debug,h_neglect,p_ref_cv,ea, & - !$OMP eb,id_clock_EOS,nkml) + !$OMP eb,id_clock_EOS,nkml,EOSdom) do j=js,je ; if (do_j(j)) then ! call cpu_clock_begin(id_clock_EOS) -! call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, & -! is, ie-is+1, tv%eqn_of_state) +! call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, tv%eqn_of_state, EOSdom) ! call cpu_clock_end(id_clock_EOS) do k=1,nz ; do i=is,ie ; d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 ; enddo ; enddo @@ -445,8 +446,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) if (det_any) then call cpu_clock_begin(id_clock_EOS) do k=1,nkmb - call calculate_density(T_2d(:,k),S_2d(:,k),p_ref_cv,Rcv(:,k), & - is,ie-is+1,tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T_2d(:,k), S_2d(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo call cpu_clock_end(id_clock_EOS) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index d7dfcea090..2ee3f38233 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -8,7 +8,7 @@ module MOM_set_diffusivity use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_diag_mediator, only : post_data, register_diag_field use MOM_debugging, only : hchksum, uvchksum, Bchksum, hchksum_pair -use MOM_EOS, only : calculate_density, calculate_density_derivs +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_error_handler, only : callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -662,11 +662,10 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the ! integrated thickness in the BBL [Z ~> m]. - mFkb, & ! total thickness in the mixed and buffer layers - ! times ds_dsp1 [Z ~> m]. - p_ref, & ! array of tv%P_Ref pressures + mFkb, & ! total thickness in the mixed and buffer layers times ds_dsp1 [Z ~> m]. + p_ref, & ! array of tv%P_Ref pressures [R L2 T-2 ~> Pa] Rcv_kmb, & ! coordinate density in the lowest buffer layer [R ~> kg m-3] - p_0 ! An array of 0 pressures + p_0 ! An array of 0 pressures [R L2 T-2 ~> Pa] real :: dh_max ! maximum amount of entrainment a layer could ! undergo before entraining all fluid in the layers @@ -681,6 +680,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & real :: hN2pO2 ! h (N^2 + Omega^2), in [Z T-2 ~> m s-2]. logical :: do_i(SZI_(G)) + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz, i_rem, kmb, kb_min is = G%isc ; ie = G%iec ; nz = G%ke @@ -714,12 +714,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & if (CS%bulkmixedlayer) then kmb = GV%nk_rho_varies do i=is,ie ; p_0(i) = 0.0 ; p_ref(i) = tv%P_Ref ; enddo + EOSdom(:) = EOS_domain(G%HI) do k=1,nz - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_0, rho_0(:,k), & - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_0, rho_0(:,k), tv%eqn_of_state, EOSdom) enddo - call calculate_density(tv%T(:,j,kmb), tv%S(:,j,kmb), p_ref, Rcv_kmb, & - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,kmb), tv%S(:,j,kmb), p_ref, Rcv_kmb, tv%eqn_of_state, EOSdom) kb_min = kmb+1 do i=is,ie @@ -869,7 +868,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & dRho_dS ! partial derivative of density wrt saln [R ppt-1 ~> kg m-3 ppt-1] real, dimension(SZI_(G)) :: & - pres, & ! pressure at each interface [Pa] + pres, & ! pressure at each interface [R L2 T-2 ~> Pa] Temp_int, & ! temperature at each interface [degC] Salin_int, & ! salinity at each interface [ppt] drho_bot, & ! A density difference [R ~> kg m-3] @@ -884,6 +883,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & real :: H_neglect ! negligibly small thickness, in the same units as h. logical :: do_i(SZI_(G)), do_any + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke @@ -901,14 +901,15 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & else do i=is,ie ; pres(i) = 0.0 ; enddo endif + EOSdom(:) = EOS_domain(G%HI) do K=2,nz do i=is,ie - pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) + pres(i) = pres(i) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1) Temp_Int(i) = 0.5 * (T_f(i,j,k) + T_f(i,j,k-1)) Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1)) enddo - call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:,K), dRho_dS(:,K), is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(Temp_int, Salin_int, pres, dRho_dT(:,K), dRho_dS(:,K), & + tv%eqn_of_state, EOSdom) do i=is,ie dRho_int(i,K) = max(dRho_dT(i,K)*(T_f(i,j,k) - T_f(i,j,k-1)) + & dRho_dS(i,K)*(S_f(i,j,k) - S_f(i,j,k-1)), 0.0) @@ -1038,7 +1039,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) 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] - pres, & ! pressure at each interface [Pa] + pres, & ! pressure at each interface [R L2 T-2 ~> Pa] Temp_int, & ! temperature at interfaces [degC] Salin_int ! Salinity at interfaces [ppt] @@ -1052,22 +1053,24 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio [nondim] + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke if (associated(tv%eqn_of_state)) then - do i=is,ie + do i=is,ie !### Add surface pressure. pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 Kd_T_dd(i,nz+1) = 0.0 ; Kd_S_dd(i,nz+1) = 0.0 enddo + EOSdom(:) = EOS_domain(G%HI) do K=2,nz do i=is,ie - pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) + pres(i) = pres(i) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1) Temp_Int(i) = 0.5 * (T_f(i,j,k-1) + T_f(i,j,k)) Salin_Int(i) = 0.5 * (S_f(i,j,k-1) + S_f(i,j,k)) enddo - call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(Temp_int, Salin_int, pres, dRho_dT, dRho_dS, & + tv%eqn_of_state, EOSdom) do i=is,ie alpha_dT = -1.0*dRho_dT(i) * (T_f(i,j,k-1) - T_f(i,j,k)) @@ -1795,10 +1798,11 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) real :: g_R0 ! g_R0 is a rescaled version of g/Rho [L2 Z-1 R-1 T-2 ~> m4 kg-1 s-2] real :: eps, tmp ! nondimensional temproray variables real :: a(SZK_(G)), a_0(SZK_(G)) ! nondimensional temporary variables - real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures + real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures [R L2 T-2 ~> Pa] real :: Rcv(SZI_(G),SZK_(G)) ! coordinate density in the mixed and buffer layers [R ~> kg m-3] real :: I_Drho ! temporary variable [R-1 ~> m3 kg-1] + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, k3, is, ie, nz, kmb is = G%isc ; ie = G%iec ; nz = G%ke @@ -1819,9 +1823,9 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) kmb = GV%nk_rho_varies eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo + EOSdom(:) = EOS_domain(G%HI) do k=1,kmb - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), & - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo do i=is,ie if (kb(i) <= nz-1) then @@ -2076,7 +2080,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ call get_param(param_file, mdl, "KD_SMOOTH", CS%Kd_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) + units="m2 s-1", default=1.0e-6, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & @@ -2087,18 +2091,18 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, & "The minimum dissipation by which to determine a lower "//& - "bound of Kd (a floor).", units="W m-3", default=0.0, & - scale=US%kg_m3_to_R*US%m2_s_to_Z2_T*(US%T_to_s**2)) + "bound of Kd (a floor).", & + units="W m-3", default=0.0, scale=US%W_m2_to_RZ3_T3*US%Z_to_m) call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, & "The intercept when N=0 of the N-dependent expression "//& "used to set a minimum dissipation by which to determine "//& "a lower bound of Kd (a floor): A in eps_min = A + B*N.", & - units="W m-3", default=0.0, scale=US%kg_m3_to_R*US%m2_s_to_Z2_T*(US%T_to_s**2)) + units="W m-3", default=0.0, scale=US%W_m2_to_RZ3_T3*US%Z_to_m) call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, & "The coefficient multiplying N, following Gargett, used to "//& "set a minimum dissipation by which to determine a lower "//& "bound of Kd (a floor): B in eps_min = A + B*N", & - units="J m-3", default=0.0, scale=US%kg_m3_to_R*US%m2_s_to_Z2_T*US%T_to_s) + units="J m-3", default=0.0, scale=US%W_m2_to_RZ3_T3*US%Z_to_m*US%s_to_T) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 062642c3da..be16133ed1 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -147,7 +147,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! layer with temperature [R degC-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]. - press ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. + 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]. @@ -212,7 +212,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: & Rml ! The mixed layer coordinate density [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density [Pa] (usually set to 2e7 Pa = 2000 dbar). + ! density [R L2 T-2 ~> Pa] (usually set to 2e7 Pa = 2000 dbar). real :: D_vel ! The bottom depth at a velocity point [H ~> m or kg m-2]. real :: Dp, Dm ! The depths at the edges of a velocity cell [H ~> m or kg m-2]. @@ -273,6 +273,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! accuracy of a single L(:) Newton iteration logical :: use_L0, do_one_L_iter ! Control flags for L(:) Newton iteration logical :: use_BBL_EOS, do_i(SZIB_(G)) + integer, dimension(2) :: EOSdom ! The computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, m, n, K2, nkmb, nkml integer :: itt, maxitt=20 type(ocean_OBC_type), pointer :: OBC => NULL() @@ -312,11 +313,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel if ((nkml>0) .and. .not.use_BBL_EOS) then - do i=Isq,Ieq+1 ; p_ref(i) = tv%P_ref ; enddo + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) + do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo !$OMP parallel do default(shared) - do j=Jsq,Jeq+1 ; do k=1,nkmb - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, & - Rml(:,j,k), Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) + do k=1,nkmb ; do j=Jsq,Jeq+1 + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rml(:,j,k), tv%eqn_of_state, & + EOSdom) enddo ; enddo endif @@ -566,14 +568,14 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (use_BBL_EOS) then do i=is,ie - press(i) = 0.0 ! or = forces%p_surf(i,j) + press(i) = 0.0 ! or = forces%p_surf(i) !### if (.not.do_i(i)) then ; T_EOS(i) = 0.0 ; S_EOS(i) = 0.0 ; endif enddo do k=1,nz ; do i=is,ie - press(i) = press(i) + GV%H_to_Pa * h_vel(i,k) + press(i) = press(i) + (GV%H_to_RZ*GV%g_Earth) * h_vel(i,k) enddo ; enddo - call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, & - is-G%IsdB+1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, tv%eqn_of_state, & + (/is-G%IsdB+1,ie-G%IsdB+1/) ) endif do i=is,ie ; if (do_i(i)) then @@ -1087,7 +1089,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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]. ustar, & ! The surface friction velocity under ice shelves [Z T-1 ~> m s-1]. - press, & ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. + 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]. real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -1270,14 +1272,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if (use_EOS .and. (k==nkml+1)) then ! Find dRho/dT and dRho_dS. do I=Isq,Ieq - press(I) = GV%H_to_Pa * htot(I) + press(I) = (GV%H_to_RZ*GV%g_Earth) * htot(I) k2 = max(1,nkml) I_2hlay = 1.0 / (h(i,j,k2) + h(i+1,j,k2) + h_neglect) T_EOS(I) = (h(i,j,k2)*tv%T(i,j,k2) + h(i+1,j,k2)*tv%T(i+1,j,k2)) * I_2hlay S_EOS(I) = (h(i,j,k2)*tv%S(i,j,k2) + h(i+1,j,k2)*tv%S(i+1,j,k2)) * I_2hlay enddo - call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, & - Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, tv%eqn_of_state, & + (/Isq-G%IsdB+1,Ieq-G%IsdB+1/) ) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1397,8 +1399,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri endif ; enddo ! I-loop if (use_EOS) then - call calculate_density_derivs(T_EOS, S_EOS, forces%p_surf(:,j), & - dR_dT, dR_dS, Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T_EOS, S_EOS, forces%p_surf(:,j), dR_dT, dR_dS, & + tv%eqn_of_state, (/Isq-G%IsdB+1,Ieq-G%IsdB+1/) ) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1507,14 +1509,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if (use_EOS .and. (k==nkml+1)) then ! Find dRho/dT and dRho_dS. do i=is,ie - press(i) = GV%H_to_Pa * htot(i) + press(i) = (GV%H_to_RZ * GV%g_Earth) * htot(i) k2 = max(1,nkml) I_2hlay = 1.0 / (h(i,j,k2) + h(i,j+1,k2) + h_neglect) T_EOS(i) = (h(i,j,k2)*tv%T(i,j,k2) + h(i,j+1,k2)*tv%T(i,j+1,k2)) * I_2hlay S_EOS(i) = (h(i,j,k2)*tv%S(i,j,k2) + h(i,j+1,k2)*tv%S(i,j+1,k2)) * I_2hlay enddo call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, & - is-G%IsdB+1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + tv%eqn_of_state, (/is-G%IsdB+1,ie-G%IsdB+1/) ) endif do i=is,ie ; if (do_i(i)) then @@ -1634,8 +1636,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri endif ; enddo ! I-loop if (use_EOS) then - call calculate_density_derivs(T_EOS, S_EOS, forces%p_surf(:,j), & - dR_dT, dR_dS, is-G%IsdB+1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T_EOS, S_EOS, forces%p_surf(:,j), dR_dT, dR_dS, & + tv%eqn_of_state, (/is-G%IsdB+1,ie-G%IsdB+1/) ) endif do i=is,ie ; if (do_i(i)) then diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 9b5f00be61..27b316e144 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -440,7 +440,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & "The maximum internal tide energy source available to mix "//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & - units="W m-2", default=1.0e3, scale=US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3) + units="W m-2", default=1.0e3, scale=US%W_m2_to_RZ3_T3) call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & "If true, read a file (given by TIDEAMP_FILE) containing "//& @@ -509,7 +509,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) filename) call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je) ; CS%TKE_Niku(:,:) = 0.0 call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1, & ! ??? timelevel -aja - scale=US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3) + scale=US%W_m2_to_RZ3_T3) CS%TKE_Niku(:,:) = Niku_scale * CS%TKE_Niku(:,:) call get_param(param_file, mdl, "GAMMA_NIKURASHIN",CS%Gamma_lee, & diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index b4e2e302c8..6df0beb5e3 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -175,8 +175,8 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & optional, pointer :: Waves !< Container for wave/Stokes information ! Fields from forces used in this subroutine: - ! taux: Zonal wind stress [Pa]. - ! tauy: Meridional wind stress [Pa]. + ! taux: Zonal wind stress [R L Z T-2 ~> Pa]. + ! tauy: Meridional wind stress [R L Z T-2 ~> Pa]. ! Local variables diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index cd32f81a32..ac7324c143 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -8,8 +8,8 @@ module MOM_neutral_diffusion use MOM_domains, only : pass_var use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_diag_mediator, only : post_data, register_diag_field -use MOM_EOS, only : EOS_type, EOS_manual_init, calculate_compress, calculate_density_derivs -use MOM_EOS, only : calculate_density, calculate_density_second_derivs +use MOM_EOS, only : EOS_type, EOS_manual_init, EOS_domain +use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_EOS, only : extract_member_EOS, EOS_LINEAR, EOS_TEOS10, EOS_WRIGHT use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type @@ -48,9 +48,10 @@ module MOM_neutral_diffusion logical :: debug = .false. !< If true, write verbose debugging messages logical :: hard_fail_heff !< Bring down the model if a problem with heff is detected integer :: max_iter !< Maximum number of iterations if refine_position is defined - real :: drho_tol !< Convergence criterion representing difference from true neutrality + real :: drho_tol !< Convergence criterion representing density difference from true neutrality [R ~> kg m-3] real :: x_tol !< Convergence criterion for how small an update of the position can be - real :: ref_pres !< Reference pressure, negative if using locally referenced neutral density + real :: ref_pres !< Reference pressure, negative if using locally referenced neutral + !! density [R L2 T-2 ~> Pa] logical :: interior_only !< If true, only applies neutral diffusion in the ocean interior. !! That is, the algorithm will exclude the surface and bottom boundary layers. ! Positions of neutral surfaces in both the u, v directions @@ -72,19 +73,21 @@ 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 [kg m-3 degC-1] at interfaces - real, allocatable, dimension(:,:,:) :: dRdS !< dRho/dS [kg m-3 ppt-1] at interfaces + 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(:,:,:) :: Pint !< Interface pressure [Pa] + 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(:,:,:,:) :: P_i !< Interface pressure (Pa) - real, allocatable, dimension(:,:,:,:) :: dRdT_i !< dRho/dT (kg/m3/degC) at top edge - real, allocatable, dimension(:,:,:,:) :: dRdS_i !< dRho/dS (kg/m3/ppt) at top edge + 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(:,:,:,:) :: 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 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]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. integer :: neutral_pos_method !< Method to find the position of a neutral surface within the layer @@ -94,7 +97,6 @@ module MOM_neutral_diffusion integer :: id_uhEff_2d = -1 !< Diagnostic IDs integer :: id_vhEff_2d = -1 !< Diagnostic IDs - real :: C_p !< heat capacity of seawater (J kg-1 K-1) type(EOS_type), pointer :: EOS !< Equation of state parameters type(remapping_CS) :: remap_CS !< Remapping control structure used to create sublayers logical :: remap_answers_2018 !< If true, use the order of arithmetic and expressions that @@ -111,9 +113,10 @@ module MOM_neutral_diffusion contains !> Read parameters and allocate control structure for neutral_diffusion module. -logical function neutral_diffusion_init(Time, G, param_file, diag, EOS, diabatic_CSp, CS) +logical function neutral_diffusion_init(Time, G, US, param_file, diag, EOS, diabatic_CSp, CS) type(time_type), target, intent(in) :: Time !< Time structure type(ocean_grid_type), intent(in) :: G !< Grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), target, intent(in) :: EOS !< Equation of state @@ -157,9 +160,9 @@ logical function neutral_diffusion_init(Time, G, param_file, diag, EOS, diabatic "a higher computational cost.", default=.true.) call get_param(param_file, mdl, "NDIFF_REF_PRES", CS%ref_pres, & "The reference pressure (Pa) used for the derivatives of "//& - "the equation of state. If negative (default), local "//& - "pressure is used.", units="Pa", default = -1.) - call get_param(param_file, mdl, "NDIFF_INTERIOR_ONLY", CS%interior_only, & + "the equation of state. If negative (default), local pressure is used.", & + units="Pa", default = -1., scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + call get_param(param_file, mdl, "NDIFF_INTERIOR_ONLY", CS%interior_only, & "If true, only applies neutral diffusion in the ocean interior."//& "That is, the algorithm will exclude the surface and bottom"//& "boundary layers.", default = .false.) @@ -206,7 +209,7 @@ logical function neutral_diffusion_init(Time, G, param_file, diag, EOS, diabatic call get_param(param_file, mdl, "NDIFF_DRHO_TOL", CS%drho_tol, & "Sets the convergence criterion for finding the neutral\n"// & "position within a layer in kg m-3.", & - default=1.e-10) + default=1.e-10, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "NDIFF_X_TOL", CS%x_tol, & "Sets the convergence criterion for a change in nondim\n"// & "position within a layer.", & @@ -225,6 +228,9 @@ logical function neutral_diffusion_init(Time, G, param_file, diag, EOS, diabatic default = .true.) endif + ! Store a rescaling factor for use in diagnostic messages. + CS%R_to_kg_m3 = US%R_to_kg_m3 + if (CS%interior_only) then call extract_diabatic_member(diabatic_CSp, KPP_CSp=CS%KPP_CSp) call extract_diabatic_member(diabatic_CSp, energetic_PBL_CSp=CS%energetic_PBL_CSp) @@ -284,13 +290,14 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure ! Local variables + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k ! Variables used for reconstructions real, dimension(SZK_(G),2) :: ppoly_r_S ! Reconstruction slopes real, dimension(SZI_(G), SZJ_(G)) :: hEff_sum ! Summed effective face thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth [m] integer :: iMethod - real, dimension(SZI_(G)) :: ref_pres ! Reference pressure used to calculate alpha/beta + real, dimension(SZI_(G)) :: ref_pres ! Reference pressure used to calculate alpha/beta [R L2 T-2 ~> Pa] real, dimension(SZI_(G)) :: rho_tmp ! Routine to calculate drho_dp, returns density which is not used real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2] integer, dimension(SZI_(G), SZJ_(G)) :: k_top ! Index of the first layer within the boundary @@ -298,9 +305,9 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) ! top extent of the boundary layer (0 at top, 1 at bottom) [nondim] integer, dimension(SZI_(G), SZJ_(G)) :: k_bot ! Index of the last layer within the boundary real, dimension(SZI_(G), SZJ_(G)) :: zeta_bot ! Distance of the lower layer to the boundary layer depth - real :: pa_to_H ! A conversion factor from Pa to H [H Pa-1 ~> m Pa-1 or s2 m-2] + real :: pa_to_H ! A conversion factor from pressure to H units [H T2 R-1 Z-2 ~> m Pa-1 or s2 m-2] - pa_to_H = 1. / GV%H_to_pa + pa_to_H = 1. / (GV%H_to_RZ * GV%g_Earth) k_top(:,:) = 1 ; k_bot(:,:) = 1 zeta_top(:,:) = 0. ; zeta_bot(:,:) = 1. @@ -343,10 +350,11 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) CS%stable_cell(:,:,:) = .true. endif + ! ### Consider adding the surface pressures to both Pint and P_i. ! Calculate pressure at interfaces and layer averaged alpha/beta CS%Pint(:,:,1) = 0. do k=1,G%ke ; do j=G%jsc-1, G%jec+1 ; do i=G%isc-1,G%iec+1 - CS%Pint(i,j,k+1) = CS%Pint(i,j,k) + h(i,j,k)*GV%H_to_Pa + CS%Pint(i,j,k+1) = CS%Pint(i,j,k) + h(i,j,k)*(GV%g_Earth*GV%H_to_RZ) enddo ; enddo ; enddo ! Pressures at the interfaces, this is redundant as P_i(k,1) = P_i(k-1,2) however retain tis @@ -354,14 +362,15 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) if (.not. CS%continuous_reconstruction) then do j=G%jsc-1, G%jec+1 ; do i=G%isc-1,G%iec+1 CS%P_i(i,j,1,1) = 0. - CS%P_i(i,j,1,2) = h(i,j,1)*GV%H_to_Pa + CS%P_i(i,j,1,2) = h(i,j,1)*(GV%H_to_RZ*GV%g_Earth) enddo ; enddo do k=2,G%ke ; do j=G%jsc-1, G%jec+1 ; do i=G%isc-1,G%iec+1 CS%P_i(i,j,k,1) = CS%P_i(i,j,k-1,2) - CS%P_i(i,j,k,2) = CS%P_i(i,j,k-1,2) + h(i,j,k)*GV%H_to_Pa + CS%P_i(i,j,k,2) = CS%P_i(i,j,k-1,2) + h(i,j,k)*(GV%H_to_RZ*GV%g_Earth) enddo ; enddo ; enddo endif + EOSdom(:) = EOS_domain(G%HI, halo=1) do j = G%jsc-1, G%jec+1 ! Interpolate state to interface do i = G%isc-1, G%iec+1 @@ -388,21 +397,19 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) if (CS%continuous_reconstruction) then do k = 1, G%ke+1 if (CS%ref_pres<0) ref_pres(:) = CS%Pint(:,j,k) - call calculate_density_derivs(CS%Tint(:,j,k), CS%Sint(:,j,k), ref_pres, & - CS%dRdT(:,j,k), CS%dRdS(:,j,k), G%isc-1, G%iec-G%isc+3, CS%EOS) + call calculate_density_derivs(CS%Tint(:,j,k), CS%Sint(:,j,k), ref_pres, CS%dRdT(:,j,k), & + CS%dRdS(:,j,k), CS%EOS, EOSdom) enddo else ! Discontinuous reconstruction do k = 1, G%ke if (CS%ref_pres<0) ref_pres(:) = CS%Pint(:,j,k) ! Calculate derivatives for the top interface - call calculate_density_derivs(CS%T_i(:,j,k,1), CS%S_i(:,j,k,1), ref_pres, & - CS%dRdT_i(:,j,k,1), CS%dRdS_i(:,j,k,1), G%isc-1, G%iec-G%isc+3, CS%EOS) - if (CS%ref_pres<0) then - ref_pres(:) = CS%Pint(:,j,k+1) - endif - ! Calcualte derivatives at the bottom interface - call calculate_density_derivs(CS%T_i(:,j,k,2), CS%S_i(:,j,k,2), ref_pres, & - CS%dRdT_i(:,j,k,2), CS%dRdS_i(:,j,k,2), G%isc-1, G%iec-G%isc+3, CS%EOS) + call calculate_density_derivs(CS%T_i(:,j,k,1), CS%S_i(:,j,k,1), ref_pres, CS%dRdT_i(:,j,k,1), & + CS%dRdS_i(:,j,k,1), CS%EOS, EOSdom) + if (CS%ref_pres<0) ref_pres(:) = CS%Pint(:,j,k+1) + ! Calculate derivatives at the bottom interface + call calculate_density_derivs(CS%T_i(:,j,k,2), CS%S_i(:,j,k,2), ref_pres, CS%dRdT_i(:,j,k,2), & + CS%dRdS_i(:,j,k,2), CS%EOS, EOSdom) enddo endif enddo @@ -441,7 +448,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) CS%uPoL(I,j,:), CS%uPoR(I,j,:), CS%uKoL(I,j,:), CS%uKoR(I,j,:), CS%uhEff(I,j,:), & k_bot(I,j), k_bot(I+1,j), 1.-zeta_bot(I,j), 1.-zeta_bot(I+1,j)) else - call find_neutral_surface_positions_discontinuous(CS, G%ke, & + call find_neutral_surface_positions_discontinuous(CS, G%ke, & CS%P_i(i,j,:,:), h(i,j,:), CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%ppoly_coeffs_T(i,j,:,:), & CS%ppoly_coeffs_S(i,j,:,:),CS%stable_cell(i,j,:), & CS%P_i(i+1,j,:,:), h(i+1,j,:), CS%T_i(i+1,j,:,:), CS%S_i(i+1,j,:,:), CS%ppoly_coeffs_T(i+1,j,:,:), & @@ -459,10 +466,10 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) call find_neutral_surface_positions_continuous(G%ke, & CS%Pint(i,j,:), CS%Tint(i,j,:), CS%Sint(i,j,:), CS%dRdT(i,j,:), CS%dRdS(i,j,:), & CS%Pint(i,j+1,:), CS%Tint(i,j+1,:), CS%Sint(i,j+1,:), CS%dRdT(i,j+1,:), CS%dRdS(i,j+1,:), & - CS%vPoL(i,J,:), CS%vPoR(i,J,:), CS%vKoL(i,J,:), CS%vKoR(i,J,:), CS%vhEff(i,J,:), & + CS%vPoL(i,J,:), CS%vPoR(i,J,:), CS%vKoL(i,J,:), CS%vKoR(i,J,:), CS%vhEff(i,J,:), & k_bot(i,J), k_bot(i,J+1), 1.-zeta_bot(i,J), 1.-zeta_bot(i,J+1)) else - call find_neutral_surface_positions_discontinuous(CS, G%ke, & + call find_neutral_surface_positions_discontinuous(CS, G%ke, & CS%P_i(i,j,:,:), h(i,j,:), CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%ppoly_coeffs_T(i,j,:,:), & CS%ppoly_coeffs_S(i,j,:,:),CS%stable_cell(i,j,:), & CS%P_i(i,j+1,:,:), h(i,j+1,:), CS%T_i(i,j+1,:,:), CS%S_i(i,j+1,:,:), CS%ppoly_coeffs_T(i,j+1,:,:), & @@ -475,8 +482,8 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) ! Continuous reconstructions calculate hEff as the difference between the pressures of the ! neutral surfaces which need to be reconverted to thickness units. The discontinuous version - ! calculates hEff from the fraction of the nondimensional fraction of the layer spanned by - ! adjacent neutral surfaces. + ! calculates hEff from the nondimensional fraction of the layer spanned by adjacent neutral + ! surfaces, so hEff is already in thickness units. if (CS%continuous_reconstruction) then do k = 1, CS%nsurf-1 ; do j = G%jsc, G%jec ; do I = G%isc-1, G%iec if (G%mask2dCu(I,j) > 0.) CS%uhEff(I,j,k) = CS%uhEff(I,j,k) * pa_to_H @@ -909,23 +916,24 @@ end function fvlsq_slope subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdSl, Pr, Tr, Sr, & 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 [Pa] + 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 [kg m-3 degC-1] - real, dimension(nk+1), intent(in) :: dRdSl !< Left-column dRho/dS [kg m-3 ppt-1] - real, dimension(nk+1), intent(in) :: Pr !< Right-column interface pressure [Pa] + 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) :: 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 [kg m-3 degC-1] - real, dimension(nk+1), intent(in) :: dRdSr !< Left-column dRho/dS [kg m-3 ppt-1] + 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(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within !! layer KoL of left column real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within !! layer KoR of right column integer, dimension(2*nk+2), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(2*nk+2), intent(inout) :: KoR !< Index of first right interface above neutral surface - real, dimension(2*nk+1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces [Pa] + real, dimension(2*nk+1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces + !! [R L2 T-2 ~> Pa] or other units following Pl and Pr. integer, optional, intent(in) :: bl_kl !< Layer index of the boundary layer (left) integer, optional, intent(in) :: bl_kr !< Layer index of the boundary layer (right) real, optional, intent(in) :: bl_zl !< Nondimensional position of the boundary layer (left) @@ -936,14 +944,15 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS integer :: k_surface ! Index of neutral surface integer :: kl ! Index of left interface integer :: kr ! Index of right interface - real :: dRdT, dRdS ! dRho/dT and dRho/dS for the neutral surface + real :: dRdT, dRdS ! dRho/dT [kg m-3 degC-1] and dRho/dS [kg m-3 ppt-1] for the neutral surface logical :: searching_left_column ! True if searching for the position of a right interface in the left column logical :: searching_right_column ! True if searching for the position of a left interface in the right column logical :: reached_bottom ! True if one of the bottom-most interfaces has been used as the target integer :: krm1, klm1 - real :: dRho, dRhoTop, dRhoBot, hL, hR - integer :: lastK_left, lastK_right - real :: lastP_left, lastP_right + real :: dRho, dRhoTop, dRhoBot ! Potential density differences at various points [R ~> kg m-3] + real :: hL, hR ! Pressure thicknesses [R L2 T-2 ~> Pa] + integer :: lastK_left, lastK_right ! Layers used during the last iteration + real :: lastP_left, lastP_right ! Fractional positions during the last iteration [nondim] logical :: interior_limit ns = 2*nk+2 @@ -1006,7 +1015,7 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS PoL(k_surface) = 1. else ! Linearly interpolate for the position between Pl(kl-1) and Pl(kl) where the density difference - ! between right and left is zero. + ! between right and left is zero. The Pl here are only used to handle massless layers. PoL(k_surface) = interpolate_for_nondim_position( dRhoTop, Pl(klm1), dRhoBot, Pl(klm1+1) ) endif if (PoL(k_surface)>=1. .and. klm1= is really ==, when PoL==1 we point to the bottom of the cell @@ -1035,11 +1044,11 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS elseif (searching_right_column) then ! Interpolate for the neutral surface position within the right column, layer krm1 ! Potential density difference, rho(kr-1) - rho(kl) (should be negative) - dRhoTop = 0.5 * ( ( dRdTr(krm1) + dRdTl(kl) ) * ( Tr(krm1) - Tl(kl) ) & - + ( dRdSr(krm1) + dRdSl(kl) ) * ( Sr(krm1) - Sl(kl) ) ) + dRhoTop = 0.5 * ( ( dRdTr(krm1) + dRdTl(kl) ) * ( Tr(krm1) - Tl(kl) ) + & + ( dRdSr(krm1) + dRdSl(kl) ) * ( Sr(krm1) - Sl(kl) ) ) ! Potential density difference, rho(kr) - rho(kl) (will be positive) - dRhoBot = 0.5 * ( ( dRdTr(krm1+1) + dRdTl(kl) ) * ( Tr(krm1+1) - Tl(kl) ) & - + ( dRdSr(krm1+1) + dRdSl(kl) ) * ( Sr(krm1+1) - Sl(kl) ) ) + dRhoBot = 0.5 * ( ( dRdTr(krm1+1) + dRdTl(kl) ) * ( Tr(krm1+1) - Tl(kl) ) + & + ( dRdSr(krm1+1) + dRdSl(kl) ) * ( Sr(krm1+1) - Sl(kl) ) ) ! Because we are looking right, the left surface, kl, is lighter than krm1+1 and should be denser than krm1 ! unless we are still at the top of the right column (kr=1) @@ -1049,7 +1058,7 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS PoR(k_surface) = 1. else ! Linearly interpolate for the position between Pr(kr-1) and Pr(kr) where the density difference - ! between right and left is zero. + ! between right and left is zero. The Pr here are only used to handle massless layers. PoR(k_surface) = interpolate_for_nondim_position( dRhoTop, Pr(krm1), dRhoBot, Pr(krm1+1) ) endif if (PoR(k_surface)>=1. .and. krm1= is really ==, when PoR==1 we point to the bottom of the cell @@ -1111,21 +1120,26 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS enddo neutral_surfaces end subroutine find_neutral_surface_positions_continuous + !> Returns the non-dimensional position between Pneg and Ppos where the !! interpolated density difference equals zero. !! The result is always bounded to be between 0 and 1. real function interpolate_for_nondim_position(dRhoNeg, Pneg, dRhoPos, Ppos) - real, intent(in) :: dRhoNeg !< Negative density difference - real, intent(in) :: Pneg !< Position of negative density difference - real, intent(in) :: dRhoPos !< Positive density difference - real, intent(in) :: Ppos !< Position of positive density difference + real, intent(in) :: dRhoNeg !< Negative density difference [R ~> kg m-3] + real, intent(in) :: Pneg !< Position of negative density difference [R L2 T-2 ~> Pa] or [nondim] + real, intent(in) :: dRhoPos !< Positive density difference [R ~> kg m-3] + real, intent(in) :: Ppos !< Position of positive density difference [R L2 T-2 ~> Pa] or [nondim] - if (PposdRhoPos) then write(stderr,*) 'dRhoNeg, Pneg, dRhoPos, Ppos=',dRhoNeg, Pneg, dRhoPos, Ppos - elseif (dRhoNeg>dRhoPos) then - stop 'interpolate_for_nondim_position: Houston, we have a problem! dRhoNeg>dRhoPos' + write(mesg,*) 'dRhoNeg, Pneg, dRhoPos, Ppos=', dRhoNeg, Pneg, dRhoPos, Ppos + call MOM_error(WARNING, 'interpolate_for_nondim_position: '//trim(mesg)) + elseif (dRhoNeg>dRhoPos) then !### Does this duplicated test belong here? + call MOM_error(FATAL, 'interpolate_for_nondim_position: Houston, we have a problem! dRhoNeg>dRhoPos') endif if (Ppos<=Pneg) then ! Handle vanished or inverted layers interpolate_for_nondim_position = 0.5 @@ -1143,42 +1157,45 @@ real function interpolate_for_nondim_position(dRhoNeg, Pneg, dRhoPos, Ppos) interpolate_for_nondim_position = 0.5 endif if ( interpolate_for_nondim_position < 0. ) & - stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint < Pneg' + call MOM_error(FATAL, 'interpolate_for_nondim_position: Houston, we have a problem! Pint < Pneg') if ( interpolate_for_nondim_position > 1. ) & - stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint > Ppos' + call MOM_error(FATAL, 'interpolate_for_nondim_position: Houston, we have a problem! Pint > 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 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,& - Pres_r, hcol_r, Tr, Sr, ppoly_T_r, ppoly_S_r, stable_r,& - PoL, PoR, KoL, KoR, hEff, zeta_bot_L, zeta_bot_R, & - k_bot_L, k_bot_R, hard_fail_heff) +subroutine find_neutral_surface_positions_discontinuous(CS, nk, & + Pres_l, hcol_l, Tl, Sl, ppoly_T_l, ppoly_S_l, stable_l, & + Pres_r, hcol_r, Tr, Sr, ppoly_T_r, ppoly_S_r, stable_r, & + PoL, PoR, KoL, KoR, hEff, zeta_bot_L, zeta_bot_R, k_bot_L, k_bot_R, hard_fail_heff) type(neutral_diffusion_CS), intent(inout) :: CS !< Neutral diffusion control structure integer, intent(in) :: nk !< Number of levels - real, dimension(nk,2), intent(in) :: Pres_l !< Left-column interface pressure (Pa) - real, dimension(nk), intent(in) :: hcol_l !< Left-column layer thicknesses - 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 - real, dimension(:,:), intent(in) :: ppoly_S_l !< Left-column coefficients of S reconstruction - logical, dimension(nk), intent(in) :: stable_l !< Left-column, top interface dRho/dS (kg/m3/ppt) - real, dimension(nk,2), intent(in) :: Pres_r !< Right-column interface pressure (Pa) - real, dimension(nk), intent(in) :: hcol_r !< Left-column layer thicknesses - 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 - real, dimension(:,:), intent(in) :: ppoly_S_r !< Right-column coefficients of S reconstruction - logical, dimension(nk), intent(in) :: stable_r !< Left-column, top interface dRho/dS (kg/m3/ppt) + 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] + 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] + 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 + !! layer KoL of left column [nondim] real, dimension(4*nk), intent(inout) :: PoR !< Fractional position of neutral surface within - !! layer KoR of right column + !! layer KoR of right column [nondim] integer, dimension(4*nk), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(4*nk), intent(inout) :: KoR !< Index of first right interface above neutral surface - real, dimension(4*nk-1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces (Pa) + 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] real, optional, intent(in) :: zeta_bot_R!< Non-dimensional distance to where the boundary layer @@ -1197,17 +1214,13 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hcol_l, logical :: searching_right_column ! True if searching for the position of a left interface in the right column logical :: reached_bottom ! True if one of the bottom-most interfaces has been used as the target logical :: search_layer - logical :: fail_heff ! By default, - real :: dRho, dRhoTop, dRhoBot, hL, hR - real :: z0, pos - real :: dRdT_from_top, dRdS_from_top ! Density derivatives at the searched from interface - real :: dRdT_from_bot, dRdS_from_bot ! Density derivatives at the searched from interface - real :: dRdT_to_top, dRdS_to_top ! Density derivatives at the interfaces being searched - real :: dRdT_to_bot, dRdS_to_bot ! Density derivatives at the interfaces being searched - real :: T_ref, S_ref, P_ref, P_top, P_bot - real :: lastP_left, lastP_right - integer :: k_init_L, k_init_R ! Starting indices layers for left and right - real :: p_init_L, p_init_R ! Starting positions for left and right + logical :: fail_heff ! Fail if negative thickness are encountered. By default this + ! is true, but it can take its value from hard_fail_heff. + real :: dRho ! A density difference between columns [R ~> kg m-3] + real :: hL, hR ! Left and right layer thicknesses [H ~> m or kg m-2] or units from hcol_l + real :: lastP_left, lastP_right ! Previous positions for left and right [nondim] + integer :: k_init_L, k_init_R ! Starting indices layers for left and right + real :: p_init_L, p_init_R ! Starting positions for left and right [nondim] ! Initialize variables for the search ns = 4*nk ki_right = 1 @@ -1275,12 +1288,13 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hcol_l, ! For convenience, the left column uses the searched "from" interface variables, and the right column ! uses the searched 'to'. These will get reset in subsequent calc_delta_rho calls - call calc_delta_rho_and_derivs(CS, & - Tr(kl_right, ki_right), Sr(kl_right, ki_right), Pres_r(kl_right,ki_right), & - Tl(kl_left, ki_left), Sl(kl_left, ki_left) , Pres_l(kl_left,ki_left), & + call calc_delta_rho_and_derivs(CS, & + Tr(kl_right, ki_right), Sr(kl_right, ki_right), Pres_r(kl_right,ki_right), & + Tl(kl_left, ki_left), Sl(kl_left, ki_left) , Pres_l(kl_left,ki_left), & dRho) - if (CS%debug) write(stdout,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",dRho, & - "kl_left=",kl_left, " ki_left=",ki_left," kl_right=",kl_right, " ki_right=",ki_right + if (CS%debug) write(stdout,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') & + "k_surface=",k_surface, " dRho=",CS%R_to_kg_m3*dRho, & + "kl_left=",kl_left, " ki_left=",ki_left, " kl_right=",kl_right, " ki_right=",ki_right ! Which column has the lighter surface for the current indexes, kr and kl if (.not. reached_bottom) then if (dRho < 0.) then @@ -1368,15 +1382,15 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hcol_l, endif endif elseif ( hL + hR == 0. ) then - hEff(k_surface-1) = 0. + hEff(k_surface-1) = 0. else - hEff(k_surface-1) = 2. * ( (hL * hR) / ( hL + hR ) )! Harmonic mean - if ( KoL(k_surface) /= KoL(k_surface-1) ) then - call MOM_error(FATAL,"Neutral sublayer spans multiple layers") - endif - if ( KoR(k_surface) /= KoR(k_surface-1) ) then - call MOM_error(FATAL,"Neutral sublayer spans multiple layers") - endif + hEff(k_surface-1) = 2. * ( (hL * hR) / ( hL + hR ) )! Harmonic mean + if ( KoL(k_surface) /= KoL(k_surface-1) ) then + call MOM_error(FATAL,"Neutral sublayer spans multiple layers") + endif + if ( KoR(k_surface) /= KoR(k_surface-1) ) then + call MOM_error(FATAL,"Neutral sublayer spans multiple layers") + endif endif else hEff(k_surface-1) = 0. @@ -1389,53 +1403,54 @@ 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 - real, dimension(nk,2), intent(in) :: S !< Salinity at interfaces - real, dimension(nk,2), intent(in) :: P !< Pressure at interfaces + 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) :: P !< Pressure at interfaces [R L2 T-2 ~> Pa] logical, dimension(nk), intent( out) :: stable_cell !< True if this cell is unstably stratified integer :: k, first_stable, prev_stable - real :: delta_rho + real :: delta_rho ! A density difference [R ~> kg m-3] do k = 1,nk - call calc_delta_rho_and_derivs( CS, T(k,2), S(k,2), max(P(k,2),CS%ref_pres), & - T(k,1), S(k,1), max(P(k,1),CS%ref_pres), delta_rho ) - stable_cell(k) = delta_rho > 0. + call calc_delta_rho_and_derivs( CS, T(k,2), S(k,2), max(P(k,2), CS%ref_pres), & + T(k,1), S(k,1), max(P(k,1), CS%ref_pres), delta_rho ) + stable_cell(k) = (delta_rho > 0.) enddo end subroutine mark_unstable_cells !> Searches the "other" (searched) column for the position of the neutral surface real function search_other_column(CS, ksurf, pos_last, T_from, S_from, P_from, T_top, S_top, P_top, & - T_bot, S_bot, P_bot, T_poly, S_poly ) result(pos) + T_bot, S_bot, P_bot, T_poly, S_poly ) result(pos) type(neutral_diffusion_CS), intent(in ) :: CS !< Neutral diffusion control structure 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 rootfinding algorithm - real, intent(in ) :: T_from !< Temperature at the searched from interface - real, intent(in ) :: S_from !< Salinity at the searched from interface - real, intent(in ) :: P_from !< Pressure at the searched from interface - real, intent(in ) :: T_top !< Temperature at the searched to top interface - real, intent(in ) :: S_top !< Salinity at the searched to top interface - real, intent(in ) :: P_top !< Pressure at the searched to top interface - real, intent(in ) :: T_bot !< Temperature at the searched to bottom interface - real, intent(in ) :: S_bot !< Salinity at the searched to bottom interface - real, intent(in ) :: P_bot !< Pressure at the searched to bottom interface - real, dimension(:), intent(in ) :: T_poly !< Temperature polynomial reconstruction coefficients - real, dimension(:), intent(in ) :: S_poly !< Salinity polynomial reconstruction coefficients + !! 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 ) :: 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 ) :: 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 ) :: 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] ! Local variables - real :: dRhotop, dRhobot - real :: dRdT_top, dRdS_top, dRdT_bot, dRdS_bot - real :: dRdT_from, dRdS_from - real :: P_mid + 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] ! Calculate the differencei 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) elseif (CS%neutral_pos_method == 2) 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_top, S_top, P_top, T_from, S_from, P_from, dRhoTop, & dRdT_top, dRdS_top, dRdT_from, dRdS_from) - call calc_delta_rho_and_derivs(CS, T_bot, S_bot, P_bot, T_from, S_from, P_from, dRhoBot, & + call calc_delta_rho_and_derivs(CS, T_bot, S_bot, P_bot, T_from, S_from, P_from, dRhoBot, & dRdT_bot, dRdS_bot, dRdT_from, dRdS_from) endif @@ -1464,9 +1479,8 @@ real function search_other_column(CS, ksurf, pos_last, T_from, S_from, P_from, T ! For the 'Linear' case of finding the neutral position, the fromerence 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, P_from, dRdT_from, dRdS_from, & - P_top, dRdT_top, dRdS_top, & - P_bot, dRdT_bot, dRdS_bot, T_poly, S_poly ) + pos = find_neutral_pos_linear( CS, pos_last, T_from, S_from, dRdT_from, dRdS_from, & + dRdT_top, dRdS_top, dRdT_bot, dRdS_bot, T_poly, S_poly ) elseif (CS%neutral_pos_method == 3) then pos = find_neutral_pos_full( CS, pos_last, T_from, S_from, P_from, P_top, P_bot, T_poly, S_poly) endif @@ -1508,43 +1522,52 @@ end subroutine increment_interface !! interval [0,1], a bisection step would be taken instead. Also this linearization of alpha, beta means that second !! derivatives of the EOS are not needed. Note that delta in variable names below refers to horizontal differences and !! 'd' refers to vertical differences -function find_neutral_pos_linear( CS, z0, T_ref, S_ref, P_ref, dRdT_ref, dRdS_ref, & - P_top, dRdT_top, dRdS_top, & - P_bot, dRdT_bot, dRdS_bot, ppoly_T, ppoly_S ) result( z ) +function find_neutral_pos_linear( CS, z0, T_ref, S_ref, dRdT_ref, dRdS_ref, & + dRdT_top, dRdS_top, dRdT_bot, dRdS_bot, ppoly_T, ppoly_S ) result( z ) 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 - real, intent(in) :: T_ref !< Temperature at the searched from interface - real, intent(in) :: S_ref !< Salinity at the searched from interface - real, intent(in) :: P_ref !< Pressure at the searched from interface + 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) :: dRdT_ref !< dRho/dT at the searched from interface + !! [R degC-1 ~> kg m-3 degC-1] real, intent(in) :: dRdS_ref !< dRho/dS at the searched from interface - real, intent(in) :: P_top !< Pressure at top of layer being searched + !! [R ppt-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] real, intent(in) :: dRdS_top !< dRho/dS at top of layer being searched - real, intent(in) :: P_bot !< Pressure at bottom of layer being searched + !! [R ppt-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] real, intent(in) :: dRdS_bot !< dRho/dS at bottom of layer being searched + !! [R ppt-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. - real, dimension(:), intent(in) :: ppoly_S !< Coefficients of the polynomial reconstruction of T within - !! the layer to be searched. - real :: z !< Position where drho = 0 + !! the layer to be searched [degC]. + real, dimension(:), intent(in) :: ppoly_S !< Coefficients of the polynomial reconstruction of S within + !! the layer to be searched [ppt]. + real :: z !< Position where drho = 0 [nondim] ! Local variables - real :: dRdT_diff, dRdS_diff - real :: drho, drho_dz, dRdT_z, dRdS_z, T_z, S_z, deltaT, deltaS, deltaP, dT_dz, dS_dz - real :: drho_min, drho_max, ztest, zmin, zmax, dRdT_sum, dRdS_sum, dz, P_z, dP_dz - real :: a1, a2 + real :: dRdT_diff ! Difference in the partial derivative of density with temperature across the + ! layer [R degC-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] + real :: drho_min, drho_max ! Bounds on density differences [R ~> kg m-3] + real :: ztest, zmin, zmax ! Fractional positions in the cell [nondim] + real :: dz ! Change in position in the cell [nondim] + real :: a1, a2 ! Fractional weights of the top and bottom values [nondim] integer :: iter integer :: nterm - real :: T_top, T_bot, S_top, S_bot nterm = SIZE(ppoly_T) ! Position independent quantities dRdT_diff = dRdT_bot - dRdT_top dRdS_diff = dRdS_bot - dRdS_top - ! Assume a linear increase in pressure from top and bottom of the cell - dP_dz = P_bot - P_top ! Initial starting drho (used for bisection) zmin = z0 ! Lower bounding interval zmax = 1. ! Maximum bounding interval (bottom of layer) @@ -1554,14 +1577,11 @@ function find_neutral_pos_linear( CS, z0, T_ref, S_ref, P_ref, dRdT_ref, dRdS_r S_z = evaluation_polynomial( ppoly_S, nterm, zmin ) dRdT_z = a1*dRdT_top + a2*dRdT_bot dRdS_z = a1*dRdS_top + a2*dRdS_bot - P_z = a1*P_top + a2*P_bot - drho_min = delta_rho_from_derivs(T_z, S_z, P_z, dRdT_z, dRdS_z, & - T_ref, S_ref, P_ref, dRdT_ref, dRdS_ref) + drho_min = 0.5*((dRdT_z+dRdT_ref)*(T_z-T_ref) + (dRdS_z+dRdS_ref)*(S_z-S_ref)) T_z = evaluation_polynomial( ppoly_T, nterm, 1. ) S_z = evaluation_polynomial( ppoly_S, nterm, 1. ) - drho_max = delta_rho_from_derivs(T_z, S_z, P_bot, dRdT_bot, dRdS_bot, & - T_ref, S_ref, P_ref, dRdT_ref, dRdS_ref) + drho_max = 0.5*((dRdT_bot+dRdT_ref)*(T_z-T_ref) + (dRdS_bot+dRdS_ref)*(S_z-S_ref)) if (drho_min >= 0.) then z = z0 @@ -1584,14 +1604,7 @@ function find_neutral_pos_linear( CS, z0, T_ref, S_ref, P_ref, dRdT_ref, dRdS_r dRdS_z = a1*dRdS_top + a2*dRdS_bot T_z = evaluation_polynomial( ppoly_T, nterm, z ) S_z = evaluation_polynomial( ppoly_S, nterm, z ) - P_z = a1*P_top + a2*P_bot - deltaT = T_z - T_ref - deltaS = S_z - S_ref - deltaP = P_z - P_ref - dRdT_sum = dRdT_ref + dRdT_z - dRdS_sum = dRdS_ref + dRdS_z - drho = delta_rho_from_derivs(T_z, S_z, P_z, dRdT_z, dRdS_z, & - T_ref, S_ref, P_ref, dRdT_ref, dRdS_ref) + drho = 0.5*((dRdT_z+dRdT_ref)*(T_z-T_ref) + (dRdS_z+dRdS_ref)*(S_z-S_ref)) ! Check for convergence if (ABS(drho) <= CS%drho_tol) exit @@ -1607,7 +1620,8 @@ function find_neutral_pos_linear( CS, z0, T_ref, S_ref, P_ref, dRdT_ref, dRdS_r ! Calculate a Newton step dT_dz = first_derivative_polynomial( ppoly_T, nterm, z ) dS_dz = first_derivative_polynomial( ppoly_S, nterm, z ) - drho_dz = 0.5*( (dRdT_diff*deltaT + dRdT_sum*dT_dz) + (dRdS_diff*deltaS + dRdS_sum*dS_dz) ) + drho_dz = 0.5*( (dRdT_diff*(T_z - T_ref) + (dRdT_ref+dRdT_z)*dT_dz) + & + (dRdS_diff*(S_z - S_ref) + (dRdS_ref+dRdS_z)*dS_dz) ) ztest = z - drho/drho_dz ! Take a bisection if z falls out of [zmin,zmax] @@ -1629,30 +1643,34 @@ end function find_neutral_pos_linear !> Use the full equation of state to calculate the difference in locally referenced potential density. The derivatives !! in this case are not trivial to calculate, so instead we use a regula falsi method -function find_neutral_pos_full( CS, z0, T_ref, S_ref, P_ref, P_top, P_bot, ppoly_T, ppoly_S ) result( z ) +function find_neutral_pos_full( CS, z0, T_ref, S_ref, P_ref, P_top, P_bot, ppoly_T, ppoly_S ) result( z ) 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 - real, intent(in) :: T_ref !< Temperature at the searched from interface - real, intent(in) :: S_ref !< Salinity at the searched from interface - real, intent(in) :: P_ref !< Pressure at the searched from interface - real, intent(in) :: P_top !< Pressure at top of layer being searched - real, intent(in) :: P_bot !< Pressure at bottom of layer being searched + 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) :: 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. + !! the layer to be searched [degC] real, dimension(:), intent(in) :: ppoly_S !< Coefficients of the polynomial reconstruction of T within - !! the layer to be searched. - real :: z !< Position where drho = 0 + !! the layer to be searched [ppt] + real :: z !< Position where drho = 0 [nondim] ! Local variables integer :: iter integer :: nterm - real :: drho_a, drho_b, drho_c - real :: a, b, c, Ta, Tb, Tc, Sa, Sb, Sc, Pa, Pb, Pc + 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 :: Pa, Pb, Pc ! Pressures [R L2 T-2 ~> Pa] integer :: side side = 0 ! Set the first two evaluation to the endpoints of the interval - b = z0; c = 1 + b = z0 ; c = 1 nterm = SIZE(ppoly_T) ! Calculate drho at the minimum bound @@ -1718,23 +1736,26 @@ function find_neutral_pos_full( CS, z0, T_ref, S_ref, P_ref, P_top, P_bot, ppoly end function find_neutral_pos_full !> Calculate the difference in density between two points in a variety of ways -subroutine calc_delta_rho_and_derivs(CS, T1, S1, p1_in, T2, S2, p2_in, drho, & +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 - real, intent(in ) :: S1 !< Salinity at point 1 - real, intent(in ) :: p1_in !< Pressure at point 1 - real, intent(in ) :: T2 !< Temperature at point 2 - real, intent(in ) :: S2 !< Salinity at point 2 - real, intent(in ) :: p2_in !< Pressure at point 2 - real, intent( out) :: drho !< Difference in density between the two points - real, optional, intent( out) :: dRdT1_out !< drho_dt at point 1 - real, optional, intent( out) :: dRdS1_out !< drho_ds at point 1 - real, optional, intent( out) :: dRdT2_out !< drho_dt at point 2 - real, optional, intent( out) :: dRdS2_out !< drho_ds at point 2 + real, intent(in ) :: T1 !< Temperature at point 1 [degC] + real, intent(in ) :: S1 !< Salinity at point 1 [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 ) :: 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] ! Local variables - real :: rho1, rho2, p1, p2, pmid - real :: drdt1, drdt2, drds1, drds2, drdp1, drdp2, rho_dummy + 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 :: drdp1, drdp2 ! Partial derivatives of density with pressure [T2 L-2 ~> s2 m-2] ! Use the same reference pressure or the in-situ pressure if (CS%ref_pres > 0.) then @@ -1748,8 +1769,8 @@ 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 elseif (TRIM(CS%delta_rho_form) == 'mid_pressure') then @@ -1757,11 +1778,11 @@ subroutine calc_delta_rho_and_derivs(CS, T1, S1, p1_in, T2, S2, p2_in, drho, if (CS%ref_pres>=0) pmid = CS%ref_pres call calculate_density_derivs(T1, S1, pmid, drdt1, drds1, CS%EOS) call calculate_density_derivs(T2, S2, pmid, drdt2, drds2, CS%EOS) - drho = delta_rho_from_derivs( T1, S1, P1, drdt1, drds1, T2, S2, P2, drdt2, drds2) + drho = delta_rho_from_derivs( T1, S1, p1, drdt1, drds1, T2, S2, p2, drdt2, drds2) elseif (TRIM(CS%delta_rho_form) == 'local_pressure') then call calculate_density_derivs(T1, S1, p1, drdt1, drds1, CS%EOS) call calculate_density_derivs(T2, S2, p2, drdt2, drds2, CS%EOS) - drho = delta_rho_from_derivs( T1, S1, P1, drdt1, drds1, T2, S2, P2, drdt2, drds2) + drho = delta_rho_from_derivs( T1, S1, p1, drdt1, drds1, T2, S2, p2, drdt2, drds2) else call MOM_error(FATAL, "delta_rho_form is not recognized") endif @@ -1779,30 +1800,33 @@ 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 - real :: S1 !< Salinity at point 1 - real :: P1 !< Pressure at point 1 - real :: dRdT1 !< Pressure at point 1 - real :: dRdS1 !< Pressure at point 1 - real :: T2 !< Temperature at point 2 - real :: S2 !< Salinity at point 2 - real :: P2 !< Pressure at point 2 - real :: dRdT2 !< Pressure at point 2 - real :: dRdS2 !< Pressure at point 2 + real :: T1 !< Temperature at point 1 [degC] + real :: S1 !< Salinity at point 1 [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 :: 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] ! Local variables - real :: drho + real :: drho ! The density difference [R ~> kg m-3] drho = 0.5 * ( (dRdT1+dRdT2)*(T1-T2) + (dRdS1+dRdS2)*(S1-S2)) end function delta_rho_from_derivs + !> Converts non-dimensional position within a layer to absolute position (for debugging) -real function absolute_position(n,ns,Pint,Karr,NParr,k_surface) +function absolute_position(n,ns,Pint,Karr,NParr,k_surface) integer, intent(in) :: n !< Number of levels integer, intent(in) :: ns !< Number of neutral surfaces - real, intent(in) :: Pint(n+1) !< Position of interfaces [Pa] + real, intent(in) :: Pint(n+1) !< Position of interfaces [R L2 T-2 ~> Pa] or other units integer, intent(in) :: Karr(ns) !< Index of interface above position - real, intent(in) :: NParr(ns) !< Non-dimensional position within layer Karr(:) + real, intent(in) :: NParr(ns) !< Non-dimensional position within layer Karr(:) [nondim] integer, intent(in) :: k_surface !< k-interface to query + real :: absolute_position !< The absolute position of a location [R L2 T-2 ~> Pa] + !! or other units following Pint ! Local variables integer :: k @@ -1814,13 +1838,14 @@ end function absolute_position !> Converts non-dimensional positions within layers to absolute positions (for debugging) function absolute_positions(n,ns,Pint,Karr,NParr) - integer, intent(in) :: n !< Number of levels - integer, intent(in) :: ns !< Number of neutral surfaces - real, intent(in) :: Pint(n+1) !< Position of interface [Pa] + integer, intent(in) :: n !< Number of levels + integer, intent(in) :: ns !< Number of neutral surfaces + real, intent(in) :: Pint(n+1) !< Position of interface [R L2 T-2 ~> Pa] or other units integer, intent(in) :: Karr(ns) !< Indexes of interfaces about positions real, intent(in) :: NParr(ns) !< Non-dimensional positions within layers Karr(:) - real, dimension(ns) :: absolute_positions ! Absolute positions [Pa] + real, dimension(ns) :: absolute_positions !< Absolute positions [R L2 T-2 ~> Pa] + !! or other units following Pint ! Local variables integer :: k_surface, k @@ -1837,8 +1862,8 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K integer, intent(in) :: nk !< Number of levels integer, intent(in) :: nsurf !< Number of neutral surfaces integer, intent(in) :: deg !< Degree of polynomial reconstructions - real, dimension(nk), intent(in) :: hl !< Left-column layer thickness [H or Pa] - real, dimension(nk), intent(in) :: hr !< Right-column layer thickness [H or Pa] + real, dimension(nk), intent(in) :: hl !< Left-column layer thickness [H ~> m or kg m-2] + real, dimension(nk), intent(in) :: hr !< Right-column layer thickness [H ~> m or kg m-2] real, dimension(nk), intent(in) :: Tl !< Left-column layer tracer (conc, e.g. degC) real, dimension(nk), intent(in) :: Tr !< Right-column layer tracer (conc, e.g. degC) real, dimension(nsurf), intent(in) :: PiL !< Fractional position of neutral surface @@ -1847,16 +1872,16 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K !! within layer KoR of right column integer, dimension(nsurf), intent(in) :: KoL !< Index of first left interface above neutral surface integer, dimension(nsurf), intent(in) :: KoR !< Index of first right interface above neutral surface - real, dimension(nsurf-1), intent(in) :: hEff !< Effective thickness between two neutral surfaces [Pa] + real, dimension(nsurf-1), intent(in) :: hEff !< Effective thickness between two neutral + !! surfaces [H ~> m or kg m-2] real, dimension(nsurf-1), intent(inout) :: Flx !< Flux of tracer between pairs of neutral layers (conc H) logical, intent(in) :: continuous !< True if using continuous reconstruction real, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions - !! in the same units as h0. + !! purpose of cell reconstructions [H ~> m or kg m-2] type(remapping_CS), optional, intent(in) :: remap_CS !< Remapping control structure used !! to create sublayers real, optional, intent(in) :: h_neglect_edge !< A negligibly small width used for - !! edge value calculations if continuous is false. + !! edge value calculations if continuous is false [H ~> m or kg m-2] ! Local variables integer :: k_sublayer, klb, klt, krb, krt, k real :: T_right_top, T_right_bottom, T_right_layer, T_right_sub, T_right_top_int, T_right_bot_int @@ -2315,9 +2340,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) ! Local variables integer, parameter :: nk = 3 integer, parameter :: ns = nk*4 - real, dimension(nk) :: Sl, Sr, Tl, Tr, hl, hr - real, dimension(nk,2) :: TiL, SiL, TiR, SiR - real, dimension(nk,2) :: Pres_l, Pres_r + real, dimension(nk) :: Sl, Sr, Tl, Tr ! Salinities [ppt] and temperatures [degC] + real, dimension(nk) :: hl, hr ! Thicknesses in pressure units [R L2 T-2 ~> Pa] + real, dimension(nk,2) :: TiL, SiL, TiR, SiR ! Cell edge salinities [ppt] and temperatures [degC] + real, dimension(nk,2) :: Pres_l, Pres_r ! Interface pressures [R L2 T-2 ~> Pa] integer, dimension(ns) :: KoL, KoR real, dimension(ns) :: PoL, PoR real, dimension(ns-1) :: hEff, Flx @@ -2326,7 +2352,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) type(remapping_CS), pointer :: remap_CS !< Remapping control structure (PLM) 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) :: dRdT, dRdS + real, dimension(nk,2) :: dRdT !< Partial derivative of density with temperature at + !! cell edges [R degC-1 ~> kg m-3 degC-1] + real, dimension(nk,2) :: dRdS !< Partial derivative of density with salinity at + !! cell edges [R ppt-1 ~> kg m-3 ppt-1] logical, dimension(nk) :: stable_l, stable_r integer :: iMethod integer :: ns_l, ns_r @@ -2340,7 +2369,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) ! Unit tests for find_neutral_surface_positions_discontinuous ! Salinity is 0 for all these tests allocate(CS%EOS) - call EOS_manual_init(CS%EOS, form_of_EOS = EOS_LINEAR, dRho_dT = -1., dRho_dS = 0.) + call EOS_manual_init(CS%EOS, form_of_EOS=EOS_LINEAR, dRho_dT=-1., dRho_dS=0.) Sl(:) = 0. ; Sr(:) = 0. ; ; SiL(:,:) = 0. ; SiR(:,:) = 0. ppoly_T_l(:,:) = 0.; ppoly_T_r(:,:) = 0. ppoly_S_l(:,:) = 0.; ppoly_S_r(:,:) = 0. @@ -2363,7 +2392,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3 /), & ! KoL (/ 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3 /), & ! KoR @@ -2377,7 +2406,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3 /), & ! KoL (/ 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3 /), & ! KoR @@ -2391,7 +2420,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3 /), & ! KoL (/ 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3 /), & ! KoR @@ -2405,7 +2434,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 1, 1, 1, 2, 2, 3, 3, 3, 3, 3 /), & ! KoL (/ 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3 /), & ! KoR @@ -2419,7 +2448,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 1, 1, 1, 1, 2, 2, 3, 3, 3, 3 /), & ! KoL (/ 1, 1, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3 /), & ! KoR @@ -2433,7 +2462,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3 /), & ! KoL (/ 1, 1, 1, 1, 2, 2, 3, 3, 3, 3, 3, 3 /), & ! KoR @@ -2447,7 +2476,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 3, 3 /), & ! KoL (/ 1, 1, 1, 1, 2, 2, 3, 3, 3, 3, 3, 3 /), & ! KoR @@ -2461,7 +2490,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3 /), & ! KoL (/ 1, 1, 1, 1, 2, 2, 2, 3, 3, 3, 3, 3 /), & ! KoR @@ -2475,7 +2504,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 1, 1, 2, 2, 3, 3, 3, 3, 3, 3 /), & ! KoL (/ 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3 /), & ! KoR @@ -2489,7 +2518,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3 /), & ! KoL (/ 1, 1, 1, 1, 1, 1, 2, 2, 3, 3, 3, 3 /), & ! KoR @@ -2503,7 +2532,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3 /), & ! KoL (/ 1, 1, 1, 1, 1, 1, 2, 2, 3, 3, 3, 3 /), & ! KoR @@ -2517,7 +2546,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, stable_l ) call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, stable_r ) call find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & - Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) + Pres_r, hR, TiR, SiR, ppoly_T_r, ppoly_S_r, stable_r, PoL, PoR, KoL, KoR, hEff) ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. test_nsp(v, 12, KoL, KoR, PoL, PoR, hEff, & (/ 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3 /), & ! KoL (/ 1, 1, 1, 1, 2, 2, 2, 3, 3, 3, 3, 3 /), & ! KoR @@ -2533,29 +2562,29 @@ logical function ndiff_unit_tests_discontinuous(verbose) ! Unit tests require explicit initialization of tolerance CS%Drho_tol = 0. CS%x_tol = 0. - ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. (test_rnp(0.5, & - find_neutral_pos_linear(CS, 0., 10., 35., 0., -0.2, 0., & - 0., -0.2, 0., 10., -0.2, 0., & + ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. (test_rnp(0.5, & + find_neutral_pos_linear(CS, 0., 10., 35., -0.2, 0., & + -0.2, 0., -0.2, 0., & (/12.,-4./), (/34.,0./)), "Temp Uniform Linearized Alpha/Beta")) ! EOS linear in S, uniform beta ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. (test_rnp(0.5, & - find_neutral_pos_linear(CS, 0., 10., 35., 0., 0., 0.8, & - 0., 0., 0.8, 10., 0., 0.8, & + find_neutral_pos_linear(CS, 0., 10., 35., 0., 0.8, & + 0., 0.8, 0., 0.8, & (/12.,0./), (/34.,2./)), "Salt Uniform Linearized Alpha/Beta")) ! EOS linear in T/S, uniform alpha/beta ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. (test_rnp(0.5, & - find_neutral_pos_linear(CS, 0., 10., 35., 0., -0.5, 0.5, & - 0., -0.5, 0.5, 10., -0.5, 0.5, & + find_neutral_pos_linear(CS, 0., 10., 35., -0.5, 0.5, & + -0.5, 0.5, -0.5, 0.5, & (/12.,-4./), (/34.,2./)), "Temp/salt Uniform Linearized Alpha/Beta")) ! EOS linear in T, insensitive to So ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. (test_rnp(0.5, & - find_neutral_pos_linear(CS, 0., 10., 35., 0., -0.2, 0., & - 0., -0.4, 0., 10., -0.6, 0., & + find_neutral_pos_linear(CS, 0., 10., 35., -0.2, 0., & + -0.4, 0., -0.6, 0., & (/12.,-4./), (/34.,0./)), "Temp stratified Linearized Alpha/Beta")) ! EOS linear in S, insensitive to T ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. (test_rnp(0.5, & - find_neutral_pos_linear(CS, 0., 10., 35., 0., 0., 0.8, & - 0., 0., 1.0, 10., 0., 0.5, & + find_neutral_pos_linear(CS, 0., 10., 35., 0., 0.8, & + 0., 1.0, 0., 0.5, & (/12.,0./), (/34.,2./)), "Salt stratified Linearized Alpha/Beta")) if (.not. ndiff_unit_tests_discontinuous) write(stdout,*) 'Pass' @@ -2564,13 +2593,13 @@ end function ndiff_unit_tests_discontinuous !> Returns true if a test of fv_diff() fails, and conditionally writes results to stream logical function test_fv_diff(verbose, hkm1, hk, hkp1, Skm1, Sk, Skp1, Ptrue, title) logical, intent(in) :: verbose !< If true, write results to stdout - real, intent(in) :: hkm1 !< Left cell width - real, intent(in) :: hk !< Center cell width - real, intent(in) :: hkp1 !< Right cell width + real, intent(in) :: hkm1 !< Left cell width [nondim] + real, intent(in) :: hk !< Center cell width [nondim] + real, intent(in) :: hkp1 !< Right cell width [nondim] real, intent(in) :: Skm1 !< Left cell average value real, intent(in) :: Sk !< Center cell average value real, intent(in) :: Skp1 !< Right cell average value - real, intent(in) :: Ptrue !< True answer [Pa] + real, intent(in) :: Ptrue !< True answer [nondim] character(len=*), intent(in) :: title !< Title for messages ! Local variables @@ -2602,7 +2631,7 @@ logical function test_fvlsq_slope(verbose, hkm1, hk, hkp1, Skm1, Sk, Skp1, Ptrue real, intent(in) :: Skm1 !< Left cell average value real, intent(in) :: Sk !< Center cell average value real, intent(in) :: Skp1 !< Right cell average value - real, intent(in) :: Ptrue !< True answer [Pa] + real, intent(in) :: Ptrue !< True answer character(len=*), intent(in) :: title !< Title for messages ! Local variables @@ -2628,11 +2657,11 @@ end function test_fvlsq_slope !> Returns true if a test of interpolate_for_nondim_position() fails, and conditionally writes results to stream logical function test_ifndp(verbose, rhoNeg, Pneg, rhoPos, Ppos, Ptrue, title) logical, intent(in) :: verbose !< If true, write results to stdout - real, intent(in) :: rhoNeg !< Lighter density [kg m-3] - real, intent(in) :: Pneg !< Interface position of lighter density [Pa] - real, intent(in) :: rhoPos !< Heavier density [kg m-3] - real, intent(in) :: Ppos !< Interface position of heavier density [Pa] - real, intent(in) :: Ptrue !< True answer [Pa] + real, intent(in) :: rhoNeg !< Lighter density [R ~> kg m-3] + real, intent(in) :: Pneg !< Interface position of lighter density [nondim] + real, intent(in) :: rhoPos !< Heavier density [R ~> kg m-3] + real, intent(in) :: Ppos !< Interface position of heavier density [nondim] + real, intent(in) :: Ptrue !< True answer [nondim] character(len=*), intent(in) :: title !< Title for messages ! Local variables @@ -2728,19 +2757,19 @@ end function test_data1di !> Returns true if output of find_neutral_surface_positions() does not match correct values, !! and conditionally writes results to stream logical function test_nsp(verbose, ns, KoL, KoR, pL, pR, hEff, KoL0, KoR0, pL0, pR0, hEff0, title) - logical, intent(in) :: verbose !< If true, write results to stdout - integer, intent(in) :: ns !< Number of surfaces + logical, intent(in) :: verbose !< If true, write results to stdout + integer, intent(in) :: ns !< Number of surfaces integer, dimension(ns), intent(in) :: KoL !< Index of first left interface above neutral surface integer, dimension(ns), intent(in) :: KoR !< Index of first right interface above neutral surface real, dimension(ns), intent(in) :: pL !< Fractional position of neutral surface within layer KoL of left column real, dimension(ns), intent(in) :: pR !< Fractional position of neutral surface within layer KoR of right column - real, dimension(ns-1), intent(in) :: hEff !< Effective thickness between two neutral surfaces [Pa] + real, dimension(ns-1), intent(in) :: hEff !< Effective thickness between two neutral surfaces [R L2 T-2 ~> Pa] integer, dimension(ns), intent(in) :: KoL0 !< Correct value for KoL integer, dimension(ns), intent(in) :: KoR0 !< Correct value for KoR real, dimension(ns), intent(in) :: pL0 !< Correct value for pL real, dimension(ns), intent(in) :: pR0 !< Correct value for pR - real, dimension(ns-1), intent(in) :: hEff0 !< Correct value for hEff - character(len=*), intent(in) :: title !< Title for messages + real, dimension(ns-1), intent(in) :: hEff0 !< Correct value for hEff + character(len=*), intent(in) :: title !< Title for messages ! Local variables integer :: k, stdunit diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index aaa670070b..a84814d40a 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -744,7 +744,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, real, dimension(:,:,:), intent(inout) :: temp !< potential temperature [degC] real, dimension(:,:,:), intent(inout) :: salt !< salinity [PSU] real, dimension(size(temp,3)), intent(in) :: R_tgt !< desired potential density [R ~> kg m-3]. - real, intent(in) :: p_ref !< reference pressure [Pa]. + 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 @@ -763,7 +763,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, 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] - real, dimension(size(temp,1)) :: press + real, dimension(size(temp,1)) :: press ! Reference pressures [R L2 T-2 ~> Pa] integer :: nx, ny, nz, nt, i, j, k, n, itt real :: dT_dS_gauge ! The relative penalizing of temperature to salinity changes when ! minimizing property changes while correcting density [degC ppt-1]. @@ -801,9 +801,9 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, adjust_salt = .true. iter_loop: do itt = 1,niter do k=1, nz - call calculate_density(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos, scale=US%kg_m3_to_R) - call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, & - eos, scale=US%kg_m3_to_R) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), eos, (/1,nx/) ) + call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), & + eos, (/1,nx/) ) enddo do k=k_start,nz ; do i=1,nx @@ -831,9 +831,9 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, if (adjust_salt .and. old_fit) then ; do itt = 1,niter do k=1, nz - call calculate_density(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos, scale=US%kg_m3_to_R) - call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, & - eos, scale=US%kg_m3_to_R) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), eos, (/1,nx/) ) + call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), & + eos, (/1,nx/) ) enddo do k=k_start,nz ; do i=1,nx ! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. hin(i,k)>h_massless .and. abs(T(i,k)-land_fill) < epsln ) then diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index aec9c8ccf2..6898af23da 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -12,7 +12,7 @@ module MOM_tracer_hor_diff use MOM_domains, only : pass_vector use MOM_debugging, only : hchksum, uvchksum use MOM_diabatic_driver, only : diabatic_CS -use MOM_EOS, only : calculate_density, EOS_type +use MOM_EOS, only : calculate_density, EOS_type, EOS_domain use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -673,8 +673,9 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & left_set, & ! If true, the left or right point determines the density of right_set ! of the trio. If densities are exactly equal, both are true. real :: tmp - real :: p_ref_cv(SZI_(G)) + real :: p_ref_cv(SZI_(G)) ! The reference pressure for the coordinate density [R L2 T-2 ~> Pa] + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: k_max, k_min, k_test, itmp integer :: i, j, k, k2, m, is, ie, js, je, nz, nkmb integer :: isd, ied, jsd, jed, IsdB, IedB, k_size @@ -695,13 +696,14 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & endif do i=is-2,ie+2 ; p_ref_cv(i) = tv%P_Ref ; enddo + EOSdom(:) = EOS_domain(G%HI,halo=2) call do_group_pass(CS%pass_t, G%Domain, clock=id_clock_pass) ! 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), is-2, ie-is+5, tv%eqn_of_state, scale=US%kg_m3_to_R) + 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 do j=js-2,je+2 ; do i=is-2,ie+2 @@ -1426,7 +1428,7 @@ subroutine tracer_hor_diff_init(Time, G, US, param_file, diag, EOS, diabatic_CSp type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(inout) :: diag !< diagnostic control type(EOS_type), target, intent(in) :: EOS !< Equation of state CS - type(diabatic_CS), pointer, intent(in) :: diabatic_CSp !< Equation of state CS + type(diabatic_CS), pointer, intent(in) :: diabatic_CSp !< Equation of state CS type(param_file_type), intent(in) :: param_file !< parameter file type(tracer_hor_diff_CS), pointer :: CS !< horz diffusion control structure @@ -1497,8 +1499,8 @@ subroutine tracer_hor_diff_init(Time, G, US, param_file, diag, EOS, diabatic_CSp units="nondim", default=1.0) endif - CS%use_neutral_diffusion = neutral_diffusion_init(Time, G, param_file, diag, EOS, diabatic_CSp, & - CS%neutral_diffusion_CSp ) + CS%use_neutral_diffusion = neutral_diffusion_init(Time, G, US, param_file, diag, EOS, & + diabatic_CSp, CS%neutral_diffusion_CSp ) if (CS%use_neutral_diffusion .and. CS%Diffuse_ML_interior) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & "USE_NEUTRAL_DIFFUSION and DIFFUSE_ML_TO_INTERIOR are mutually exclusive!") CS%use_lateral_boundary_diffusion = lateral_boundary_diffusion_init(Time, G, param_file, diag, diabatic_CSp, & diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index f582ca0c7a..f92d2d7ac6 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -261,7 +261,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! Local variables ! The following variables are used to set the target temperature and salinity. real :: T0(SZK_(G)), S0(SZK_(G)) - real :: pres(SZK_(G)) ! An array of the reference pressure [Pa]. + real :: pres(SZK_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. @@ -359,13 +359,13 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! 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 - call calculate_density(T0(1),S0(1),pres(1),rho_guess(1),tv%eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,tv%eqn_of_state, scale=US%kg_m3_to_R) + 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/) ) do k=1,nz ; T0(k) = T0(1) + (GV%Rlay(k)-rho_guess(1)) / drho_dT(1) ; enddo do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,tv%eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T0, S0, pres, rho_guess, tv%eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, tv%eqn_of_state) do k=1,nz ; T0(k) = T0(k) + (GV%Rlay(k)-rho_guess(k)) / drho_dT(k) ; enddo enddo diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index ba8dc1162f..0a3cfb3fbe 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -184,10 +184,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, 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, scale=US%kg_m3_to_R) + 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, scale=US%kg_m3_to_R) + 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 @@ -281,7 +281,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. - real :: pres(SZK_(G)) ! An array of the reference pressure [Pa]. (zero here) + real :: pres(SZK_(G)) ! 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 :: T_Ref, S_Ref @@ -301,10 +301,10 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi 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) - call calculate_density(t_sur,s_sur,0.0,rho_sur,eqn_of_state, scale=US%kg_m3_to_R) + 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, scale=US%kg_m3_to_R) + 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) @@ -362,10 +362,10 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi ! call MOM_mesg(mesg,5) enddo - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, (/1,1/) ) ! write(mesg,*) 'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1) ! call MOM_mesg(mesg,5) - call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T0(1), S0(1), pres(1), rho_guess(1), eqn_of_state) if (fit_salin) then ! A first guess of the layers' salinity. @@ -374,8 +374,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi enddo ! Refine the guesses for each layer. do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state) do k=1,nz S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS1) enddo @@ -388,8 +388,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi enddo do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -521,10 +521,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) 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, scale=US%kg_m3_to_R) + 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, scale=US%kg_m3_to_R) + 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 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 815e4fa361..da181c5eca 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1035,7 +1035,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) ! ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * GV%mks_g_Earth / tmp + fp = 0.877 * US%L_T_to_m_s**2*US%m_to_Z * GV%g_Earth / tmp ! ! mean frequency fm = fm_into_fp * fp @@ -1168,23 +1168,25 @@ subroutine DHH85_mid(GV, US, zpt, UStokes) real :: ann, Bnn, Snn, Cnn, Dnn real :: omega_peak, omega, u10, WA, domega real :: omega_min, omega_max, wavespec, Stokes + real :: g_Earth ! Gravitational acceleration [m s-2] integer :: Nomega, OI WA = WaveAge u10 = WaveWind + g_Earth = US%L_T_to_m_s**2*US%m_to_Z * GV%g_Earth !/ omega_min = 0.1 ! Hz ! Cut off at 30cm for now... - omega_max = 10. ! ~sqrt(0.2*GV%mks_g_Earth*2*pi/0.3) + omega_max = 10. ! ~sqrt(0.2*g_Earth*2*pi/0.3) NOmega = 1000 domega = (omega_max-omega_min)/real(NOmega) ! if (WaveAgePeakFreq) then - omega_peak = GV%mks_g_Earth / (WA * u10) + omega_peak = g_Earth / (WA * u10) else - omega_peak = 2. * pi * 0.13 * GV%mks_g_Earth / U10 + omega_peak = 2. * pi * 0.13 * g_Earth / U10 endif !/ Ann = 0.006 * WaveAge**(-0.55) @@ -1200,11 +1202,11 @@ subroutine DHH85_mid(GV, US, zpt, UStokes) do oi = 1,nomega-1 Dnn = exp ( -0.5 * (omega-omega_peak)**2 / (Snn**2 * omega_peak**2) ) ! wavespec units = m2s - wavespec = (Ann * GV%mks_g_Earth**2 / (omega_peak*omega**4 ) ) * & + wavespec = (Ann * g_Earth**2 / (omega_peak*omega**4 ) ) * & exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn ! Stokes units m (multiply by frequency range for units of m/s) Stokes = 2.0 * wavespec * omega**3 * & - exp( 2.0 * omega**2 * US%Z_to_m*zpt / GV%mks_g_Earth) / GV%mks_g_Earth + exp( 2.0 * omega**2 * US%Z_to_m*zpt / g_Earth) / g_Earth UStokes = UStokes + Stokes*domega omega = omega + domega enddo diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 949530e773..64afe85ab5 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -122,7 +122,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state type(EOS_type), pointer :: eqn_of_state !< integer that selects the !! equation of state. real, intent(in) :: P_Ref !< The coordinate-density - !! reference pressure [Pa]. + !! reference pressure [R L2 T-2 ~> Pa]. ! Local variables real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index ae28bb36c6..70b9fcd4dc 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -35,7 +35,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 +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type, EOS_domain implicit none ; private #include @@ -77,7 +77,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness at h points real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points [T-1 ~> s-1]. real :: TNUDG ! Nudging time scale [T ~> s] - real :: pres(SZI_(G)) ! An array of the reference pressure, in Pa + real :: pres(SZI_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa] real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. @@ -90,6 +90,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) character(len=40) :: temp_var, salt_var, eta_var, inputdir, h_var character(len=40) :: mod = "RGC_initialize_sponges" ! This subroutine's name. + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, iscB, iecB, jscB, jecB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -211,10 +212,9 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) ! mixed layer density, which is used in determining which layers can be ! inflated without causing static instabilities. do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo - + EOSdom(:) = EOS_domain(G%HI) do j=js,je - call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), tv%eqn_of_state, EOSdom) enddo call set_up_sponge_ML_density(tmp, G, CSp) diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index be12f75c38..a63205fede 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -167,11 +167,11 @@ subroutine SCM_CVMix_tests_surface_forcing_init(Time, G, param_file, CS) call get_param(param_file, mdl, "SCM_TAU_X", & CS%tau_x, "Constant X-dir wind stress "// & "used in the SCM CVMix test surface forcing.", & - units='N/m2', scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z, fail_if_missing=.true.) + units='N/m2', scale=US%kg_m2s_to_RZ_T*US%m_s_to_L_T, fail_if_missing=.true.) call get_param(param_file, mdl, "SCM_TAU_Y", & CS%tau_y, "Constant y-dir wind stress "// & "used in the SCM CVMix test surface forcing.", & - units='N/m2', scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z, fail_if_missing=.true.) + units='N/m2', scale=US%kg_m2s_to_RZ_T*US%m_s_to_L_T, fail_if_missing=.true.) endif if (CS%UseHeatFlux) then call get_param(param_file, mdl, "SCM_HEAT_FLUX", & diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 5641035ded..e32c8b9e41 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -83,7 +83,7 @@ end subroutine benchmark_initialize_topography !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state, & - P_ref, just_read_params) + P_Ref, just_read_params) 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 @@ -94,7 +94,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state type(EOS_type), pointer :: eqn_of_state !< integer that selects the !! equation of state. real, intent(in) :: P_Ref !< The coordinate-density - !! reference pressure [Pa]. + !! reference pressure [R L2 T-2 ~> Pa]. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables @@ -109,10 +109,11 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state 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, pres, S0, & ! drho + T0, S0, & ! Profiles of temperature [degC] and salinity [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]. + 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]. real :: T_frac ! A ratio of the interface temperature to the range @@ -151,8 +152,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state pres(k) = P_Ref ; S0(k) = 35.0 enddo T0(k1) = 29.0 - call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, scale=US%kg_m3_to_R) + 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) ! A first guess of the layers' temperatures. do k=1,nz @@ -161,8 +162,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state ! Refine the guesses for each layer. do itt=1,6 - call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -227,12 +228,12 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & type(EOS_type), pointer :: eqn_of_state !< integer that selects the !! equation of state. real, intent(in) :: P_Ref !< The coordinate-density - !! reference pressure [Pa]. + !! reference pressure [R L2 T-2 ~> Pa]. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables real :: T0(SZK_(G)), S0(SZK_(G)) - real :: pres(SZK_(G)) ! Reference pressure [Pa]. + real :: pres(SZK_(G)) ! Reference pressure [R L2 T-2 ~> Pa]. real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. @@ -256,8 +257,8 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & enddo T0(k1) = 29.0 - call calculate_density(T0(k1),S0(k1),pres(k1),rho_guess(k1),eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,k1,1,eqn_of_state, scale=US%kg_m3_to_R) + 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/) ) ! A first guess of the layers' temperatures. ! do k=1,nz @@ -266,8 +267,8 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & ! Refine the guesses for each layer. ! do itt = 1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state, scale=US%kg_m3_to_R) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index c1f615fe2a..5be2bc9b8e 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -30,16 +30,15 @@ module dumbbell_surface_forcing real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3]. real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. - real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar [Pa]. - real :: slp_amplitude !< The amplitude of pressure loading [Pa] applied +! real :: gust_const !< A constant unresolved background gustiness +! !! that contributes to ustar [R L Z T-2 ~> Pa]. + real :: slp_amplitude !< The amplitude of pressure loading [R L2 T-2 ~> Pa] applied !! to the reservoirs - real :: slp_period !< Period of sinusoidal pressure wave + real :: slp_period !< Period of sinusoidal pressure wave [days] real, dimension(:,:), allocatable :: & forcing_mask !< A mask regulating where forcing occurs real, dimension(:,:), allocatable :: & - S_restore !< The surface salinity field toward which to - !! restore [ppt]. + S_restore !< The surface salinity field toward which to restore [ppt]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. end type dumbbell_surface_forcing_CS @@ -213,10 +212,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "DUMBBELL_SLP_AMP", CS%slp_amplitude, & "Amplitude of SLP forcing in reservoirs.", & - units="kg m2 s-1", default = 10000.0) - call get_param(param_file, mdl, "DUMBBELL_SLP_PERIOD", CS%slp_period, & - "Periodicity of SLP forcing in reservoirs.", & - units="days", default = 1.0) + units="Pa", default = 10000.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) call get_param(param_file, mdl, "DUMBBELL_SLP_PERIOD", CS%slp_period, & "Periodicity of SLP forcing in reservoirs.", & units="days", default = 1.0) diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 86f3e6e99a..a63e7a2b89 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -10,7 +10,7 @@ module user_change_diffusivity 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 +use MOM_EOS, only : calculate_density, EOS_domain implicit none ; private @@ -66,12 +66,13 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i !! each interface [Z2 T-1 ~> m2 s-1]. ! Local variables real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers [R ~> kg m-3]. - real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures. + real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures [R L2 T-2 ~> Pa]. real :: rho_fn ! The density dependence of the input function, 0-1 [nondim]. real :: lat_fn ! The latitude dependence of the input function, 0-1 [nondim]. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. logical :: store_Kd_add ! Save the added diffusivity as a diagnostic if true. + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed @@ -104,16 +105,15 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i if (store_Kd_add) Kd_int_add(:,:,:) = 0.0 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo + EOSdom(:) = EOS_domain(G%HI) do j=js,je if (present(T_f) .and. present(S_f)) then do k=1,nz - call calculate_density(T_f(:,j,k), S_f(:,j,k), p_ref, Rcv(:,k),& - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T_f(:,j,k), S_f(:,j,k), p_ref, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo else do k=1,nz - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k),& - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo endif