From 5a56df7d7c095a3e8f4ef2e54954bfc2e62979d9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 4 Apr 2020 08:34:56 -0400 Subject: [PATCH 01/55] +Add optional pres_scale arguments to EOS routines Added optional pres_scale arguments to various MOM_EOS.F90 routines to allow pressures to be passed with in various units for flexibility and streamlined dimensional consistency testing. Also added optional rho_scale arguments to the various int_density_dz subroutines. All answers are bitwise identical, but there are new optional arguments to public interfaces. --- src/equation_of_state/MOM_EOS.F90 | 555 +++++++++++++++-------- src/equation_of_state/MOM_EOS_Wright.F90 | 74 +-- src/equation_of_state/MOM_EOS_linear.F90 | 35 +- 3 files changed, 431 insertions(+), 233 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 3d0cb9abc4..d1fc2a917b 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -135,31 +135,36 @@ module MOM_EOS !> Calls the appropriate subroutine to calculate density of sea water for scalar inputs. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. -subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) +subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale, pres_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 [other ~> 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + + real :: p_scale ! A factor to convert pressure to units of Pa. if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_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_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.") @@ -173,7 +178,7 @@ end subroutine calculate_density_scalar !> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. -subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref, scale) +subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref, scale, pres_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] @@ -184,27 +189,53 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + + real :: p_scale ! A factor to convert pressure to units of Pa. + real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] 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, & + p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + + if (p_scale == 1.0) then + 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 + 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_linear(T, S, pres, rho, start, npts, & + EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_ref) + case (EOS_UNESCO) + call calculate_density_unesco(T, S, pres, rho, start, npts, rho_ref) + case (EOS_WRIGHT) + call calculate_density_wright(T, S, pres, rho, start, npts, rho_ref) + case (EOS_TEOS10) + call calculate_density_teos10(T, S, pres, rho, start, npts, rho_ref) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pres, rho, start, npts, rho_ref) + case default + call MOM_error(FATAL, & + "calculate_density_array: 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 ; rho(j) = scale * rho(j) ; enddo @@ -214,7 +245,7 @@ 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) +subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale, pres_scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] @@ -223,32 +254,35 @@ subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scal 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + real :: p_scale ! A factor to convert pressure to units of Pa. real :: rho if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_spec_vol_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_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) + call calculate_spec_vol_linear(T, S, p_scale*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) + call calculate_spec_vol_unesco(T, S, p_scale*pressure, specvol, spv_ref) case (EOS_WRIGHT) - call calculate_spec_vol_wright(T, S, pressure, specvol, spv_ref) + call calculate_spec_vol_wright(T, S, p_scale*pressure, specvol, spv_ref) case (EOS_TEOS10) - call calculate_spec_vol_teos10(T, S, pressure, specvol, spv_ref) + call calculate_spec_vol_teos10(T, S, p_scale*pressure, specvol, spv_ref) case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho) + call calculate_density_nemo(T, S, p_scale*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.") + call MOM_error(FATAL, "calculate_spec_vol_scalar: EOS is not valid.") end select if (present(scale)) then ; if (scale /= 1.0) then @@ -260,7 +294,7 @@ end subroutine calculate_spec_vol_scalar !> 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) +subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, spv_ref, scale, pres_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]. @@ -271,34 +305,62 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + real :: p_scale ! A factor to convert pressure to units of Pa. + real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] real, dimension(size(specvol)) :: rho integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_spec_vol_array 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, start, npts, & - EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) - case (EOS_UNESCO) - call calculate_spec_vol_unesco(T, S, pressure, specvol, start, npts, spv_ref) - case (EOS_WRIGHT) - call calculate_spec_vol_wright(T, S, pressure, specvol, start, npts, spv_ref) - 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) - 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.") - 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_EOS) + case (EOS_LINEAR) + call calculate_spec_vol_linear(T, S, pressure, specvol, start, npts, & + EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) + case (EOS_UNESCO) + call calculate_spec_vol_unesco(T, S, pressure, specvol, start, npts, spv_ref) + case (EOS_WRIGHT) + call calculate_spec_vol_wright(T, S, pressure, specvol, start, npts, spv_ref) + 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) + 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.") + 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_spec_vol_linear(T, S, pres, specvol, start, npts, & + EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) + case (EOS_UNESCO) + call calculate_spec_vol_unesco(T, S, pres, specvol, start, npts, spv_ref) + case (EOS_WRIGHT) + call calculate_spec_vol_wright(T, S, pres, specvol, start, npts, spv_ref) + case (EOS_TEOS10) + call calculate_spec_vol_teos10(T, S, pres, specvol, start, npts, spv_ref) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pres, 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.") + end select + endif if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 specvol(j) = scale * specvol(j) @@ -362,7 +424,7 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS) end subroutine calculate_TFreeze_array !> Calls the appropriate subroutine to calculate density derivatives for 1-D array inputs. -subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS, scale) +subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS, scale, pres_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] @@ -375,27 +437,52 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star 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) :: 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_density_derivs called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & - EOS%dRho_dT, EOS%dRho_dS, start, npts) - case (EOS_UNESCO) - call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) - case (EOS_WRIGHT) - call calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS, start, npts) - case (EOS_TEOS10) - call calculate_density_derivs_teos10(T, S, pressure, drho_dT, drho_dS, start, npts) - 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.") - 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_EOS) + case (EOS_LINEAR) + call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & + EOS%dRho_dT, EOS%dRho_dS, start, npts) + case (EOS_UNESCO) + call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_WRIGHT) + call calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_TEOS10) + call calculate_density_derivs_teos10(T, S, pressure, drho_dT, drho_dS, start, npts) + 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.") + 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_derivs_linear(T, S, pres, drho_dT, drho_dS, EOS%Rho_T0_S0, & + EOS%dRho_dT, EOS%dRho_dS, start, npts) + case (EOS_UNESCO) + call calculate_density_derivs_unesco(T, S, pres, drho_dT, drho_dS, start, npts) + case (EOS_WRIGHT) + call calculate_density_derivs_wright(T, S, pres, drho_dT, drho_dS, start, npts) + case (EOS_TEOS10) + call calculate_density_derivs_teos10(T, S, pres, drho_dT, drho_dS, start, npts) + case (EOS_NEMO) + call calculate_density_derivs_nemo(T, S, pres, drho_dT, drho_dS, start, npts) + case default + call MOM_error(FATAL, "calculate_density_derivs_array: 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_dT(j) = scale * drho_dT(j) @@ -406,7 +493,7 @@ end subroutine calculate_density_derivs_array !> 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) +subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS, scale, pres_scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] @@ -417,18 +504,23 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS 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) :: 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_density_derivs called with an unassociated EOS_type EOS.") + p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + 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.") @@ -443,7 +535,7 @@ end subroutine calculate_density_derivs_scalar !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs. subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & - drho_dS_dP, drho_dT_dP, start, npts, EOS, scale) + drho_dS_dP, drho_dT_dP, start, npts, EOS, scale, pres_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] @@ -462,27 +554,51 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + ! Local variables + real :: p_scale ! A factor to convert pressure to units of Pa. + real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] + real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa. 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 = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + + 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 + 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) @@ -490,11 +606,19 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh drho_dT_dP(j) = scale * drho_dT_dP(j) enddo ; endif ; 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 !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & - drho_dS_dP, drho_dT_dP, EOS, scale) + drho_dS_dP, drho_dT_dP, EOS, scale, pres_scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] @@ -511,19 +635,25 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + ! Local variables + real :: p_scale ! A factor to convert pressure to units of Pa. + real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa. if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") + p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + 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, & @@ -538,10 +668,16 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr drho_dT_dP = scale * drho_dT_dP endif ; 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_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS, scale, pres_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] @@ -554,14 +690,18 @@ subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, 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] + real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa. ! Local variables real, dimension(size(T)) :: dRho_dT, dRho_dS, rho + real :: p_scale ! A factor to convert pressure to units of Pa. integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") + p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & @@ -726,9 +866,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, rho_scale, pres_scale) 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), & @@ -739,53 +878,66 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & 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]. + 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]. 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 [R L2 T-2 Pa-1 ~> 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, & + rho_scale, pres_scale) 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) + if (present(rho_scale)) 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, & + 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) + bathyT, dz_neglect, useMassWghtInterp, rho_scale, pres_scale) 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, & + rho_scale, pres_scale) end select ; endif end subroutine int_density_dz @@ -979,7 +1131,7 @@ end subroutine EOS_use_linear !! finite-volume form pressure accelerations in a Boussinesq model. subroutine 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) + bathyT, dz_neglect, useMassWghtInterp, rho_scale, pres_scale) 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), & @@ -990,39 +1142,49 @@ subroutine int_density_dz_generic(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 bottom of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density [kg m-3], that is + 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]. + !! 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]. + !! 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]. + !! 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 :: T5(5), S5(5), p5(5), r5(5) - real :: rho_anom ! The depth averaged density anomaly [kg m-3]. - real :: w_left, w_right + 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 :: 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 :: 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_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]. @@ -1032,7 +1194,7 @@ subroutine int_density_dz_generic(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 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 +1208,8 @@ 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 + GxRho = G_e * rho_0 ; if (present(pres_scale)) GxRho = pres_scale * G_e * rho_0 + rho_ref_mks = rho_ref ; if (present(rho_scale)) rho_ref_mks = rho_ref / rho_scale I_Rho = 1.0 / rho_0 do_massWeight = .false. @@ -1064,7 +1227,7 @@ 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) + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) ! 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 +1269,7 @@ 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) + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) ! 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 +1311,7 @@ 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) + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) ! 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))) @@ -1166,7 +1329,7 @@ end subroutine int_density_dz_generic 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) + useMassWghtInterp, rho_scale, pres_scale) 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 +1341,38 @@ 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) :: 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]. 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. + 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]. ! 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 @@ -1221,20 +1387,24 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! 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 :: 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 [kg m-3]. + 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 [kg m-3]. + 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]. + ! 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 ! 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 :: 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_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]. @@ -1254,7 +1424,8 @@ 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 + GxRho = G_e * rho_0 ; if (present(pres_scale)) GxRho = pres_scale * G_e * rho_0 + rho_ref_mks = rho_ref ; if (present(rho_scale)) rho_ref_mks = rho_ref / rho_scale I_Rho = 1.0 / rho_0 massWeightToggle = 0. if (present(useMassWghtInterp)) then @@ -1280,7 +1451,7 @@ 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 ) + call calculate_density_array(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS, rho_ref_mks, scale=rho_scale) do i=isq,ieq+1 ; iin = i+ioff ! Use Bode's rule to estimate the pressure anomaly change. @@ -1360,7 +1531,7 @@ 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) + call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, rho_ref_mks, scale=rho_scale) do I=Isq,Ieq ; iin = i+ioff intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j) @@ -1440,7 +1611,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & 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) + r15(15*HIO%isc+1:), 1, 15*(HIO%iec-HIO%isc+1), EOS, rho_ref_mks, scale=rho_scale) do i=HIO%isc,HIO%iec ; iin = i+ioff intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1) @@ -1580,7 +1751,7 @@ end function frac_dp_at_pos !! 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) + EOS, dpa, intz_dpa, intx_dpa, inty_dpa, rho_scale, pres_scale) 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 @@ -1600,10 +1771,10 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & 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. + 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), & @@ -1620,6 +1791,10 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & 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]. + 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]. ! This subroutine calculates (by numerical quadrature) integrals of ! pressure anomalies across layers, which are required for calculating the @@ -1632,12 +1807,20 @@ 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_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 +1846,8 @@ 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 + GxRho = G_e * rho_0 ; if (present(pres_scale)) GxRho = pres_scale * G_e * rho_0 + rho_ref_mks = rho_ref ; if (present(rho_scale)) rho_ref_mks = rho_ref / rho_scale I_Rho = 1.0 / rho_0 ! ============================= @@ -1691,23 +1875,18 @@ 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) + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) ! 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 +1934,11 @@ 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) + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) ! 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 +1981,7 @@ 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 ) + call calculate_density( T_node, S_node, p_node, r_node, 1, 9, EOS, rho_ref_mks, scale=rho_scale ) r_node = r_node - rho_ref call compute_integral_quadratic( x, y, r_node, intx_dpa(i-ioff,j-joff) ) diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index bc490ca361..39d1dd26d4 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 diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 55b3835681..2c19b617c6 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 From 63c451005e241f28a752a1adf6ab97b5a53d0ddd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 4 Apr 2020 09:22:58 -0400 Subject: [PATCH 02/55] +Rescaled Boussinesq pressure force calculations Rescaled the pressures in Boussinesq pressure force calculations, including changing the units of the densities passed to set_pbce_Bouss and using the new rho_scale and pres_scale arguments to the equation of state routines. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 26 +++---- src/core/MOM_PressureForce_analytic_FV.F90 | 81 +++++++++----------- src/core/MOM_PressureForce_blocked_AFV.F90 | 88 ++++++++++------------ 3 files changed, 88 insertions(+), 107 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 43de125701..e0177e35b9 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. @@ -401,7 +401,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! 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]. + 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] @@ -520,7 +520,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = CS%GFS_scale * (rho_star(i,j,1) * e(i,j,1)) - if (use_p_atm) M(i,j,1) = M(i,j,1) + 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) + US%kg_m3_to_R*US%m_s_to_L_T**2*p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k-1) + (rho_star(i,j,k) - rho_star(i,j,k-1)) * e(i,j,K) @@ -531,7 +531,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) + US%kg_m3_to_R*US%m_s_to_L_T**2*p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * e(i,j,K) @@ -609,7 +609,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,13 +623,13 @@ 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. @@ -639,7 +639,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - Rho0xG = Rho0*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 @@ -664,8 +664,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) 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) + 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, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) do i=Isq,Ieq+1 pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo @@ -675,8 +675,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) T_int(i) = 0.5*(tv%T(i,j,k-1)+tv%T(i,j,k)) S_int(i) = 0.5*(tv%S(i,j,k-1)+tv%S(i,j,k)) enddo - 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) + 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, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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)) * & @@ -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..d0a6932810 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. @@ -77,7 +77,7 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc !! or atmosphere-ocean interface [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. @@ -113,7 +113,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p !! or atmosphere-ocean interface [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. @@ -194,7 +194,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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 + alpha_ref = 1.0/(US%R_to_kg_m3*CS%Rho0) g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth I_gEarth = 1.0 / g_Earth_z @@ -456,7 +456,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at !! or atmosphere-ocean interface [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 +471,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 @@ -502,12 +501,9 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m]. - 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. @@ -534,12 +530,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 @@ -651,12 +644,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) + US%kg_m3_to_R*US%m_s_to_L_T**2 * 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 +673,21 @@ 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, & + rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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) + tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), rho_ref, CS%Rho0, & + GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & + rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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, & + rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -706,7 +696,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 +757,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 +808,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..60e1330aa6 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. @@ -77,7 +77,7 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, !! or atmosphere-ocean interface [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. @@ -112,7 +112,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, !! or atmosphere-ocean interface [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. @@ -190,7 +190,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, use_EOS = associated(tv%eqn_of_state) dp_neglect = GV%H_to_Pa * GV%H_subroundoff - alpha_ref = 1.0/CS%Rho0 + alpha_ref = 1.0/(US%R_to_kg_m3*CS%Rho0) g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth I_gEarth = 1.0 / g_Earth_z @@ -437,7 +437,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, !! or atmosphere-ocean interface [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 +452,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 @@ -483,12 +482,9 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: I_Rho0 ! 1/Rho0 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. @@ -518,12 +514,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 @@ -629,9 +622,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,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 +643,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) + US%kg_m3_to_R*US%m_s_to_L_T**2*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,24 +670,24 @@ 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, & + rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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, & - intx_dpa_bk, inty_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, & + rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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) + G%bathyT, dz_neglect, CS%useMassWghtInterp, & + rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%Z_to_H @@ -702,7 +695,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 +752,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 +803,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, & From 7632abe2d78f74040dd7b75965ab4b4f8de92a50 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 5 Apr 2020 09:06:13 -0400 Subject: [PATCH 03/55] +Add optional SV_scale arg to int_specific_vol_dp Optionally rescale the units of the specific volume integrals. Added new optional SV_scale and pres_scale arguments to int_specific_vol_dp, int_spec_vol_dp_generic, and int_spec_vol_dp_Wright. All answers are bitwise identical, but there are new optional arguments to public interfaces. --- src/equation_of_state/MOM_EOS.F90 | 219 ++++++++++++++--------- src/equation_of_state/MOM_EOS_Wright.F90 | 70 +++++--- src/equation_of_state/MOM_EOS_linear.F90 | 50 +++--- 3 files changed, 202 insertions(+), 137 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index d1fc2a917b..5603246ace 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -800,43 +800,50 @@ end subroutine calculate_compress_scalar !! series for log(1-eps/1+eps) that assumes that |eps| < . 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) + bathyP, dP_tiny, useMassWghtInterp, SV_scale, pres_scale) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature referenced to the surface [degC] 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 [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. + 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 :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] if (.not.associated(EOS)) call MOM_error(FATAL, & "int_specific_vol_dp called with an unassociated EOS_type EOS.") @@ -844,21 +851,29 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & if (EOS%EOS_quadrature) then 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, & - bathyP, dP_tiny, useMassWghtInterp) + bathyP, dP_tiny, useMassWghtInterp, SV_scale, pres_scale) 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, & + if (present(SV_scale)) then + rho_scale = 1.0 / SV_scale + call int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, rho_scale*EOS%Rho_T0_S0, & + rho_scale*EOS%dRho_dT, rho_scale*EOS%dRho_dS, dza, intp_dza, & + intx_dza, inty_dza, halo_size, & + bathyP, dP_tiny, useMassWghtInterp) + else + 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) + endif 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) + bathyP, dP_tiny, useMassWghtInterp, SV_scale, pres_scale) 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, & - bathyP, dP_tiny, useMassWghtInterp) + bathyP, dP_tiny, useMassWghtInterp, SV_scale, pres_scale) end select ; endif end subroutine int_specific_vol_dp @@ -1176,7 +1191,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure !! into Pa [Pa T2 R-1 L-2 ~> 1]. ! Local variables - real :: T5(5), S5(5) ! Temperatures and salinities at five quadrature points [degC] and [ppt] + real :: T5(5), S5(5) ! Temperatures and salinities at five quadrature points [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]. @@ -2198,44 +2213,48 @@ end subroutine evaluate_shape_quadratic !! 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, & - bathyP, dP_neglect, useMassWghtInterp) + bathyP, dP_neglect, useMassWghtInterp, SV_scale, pres_scale) 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]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & 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. + 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]. ! This subroutine calculates analytical and nearly-analytical integrals in ! pressure across layers of geopotential anomalies, which are required for @@ -2244,19 +2263,24 @@ 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]. + ! 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] 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 @@ -2267,6 +2291,9 @@ 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 + RL2_T2_to_Pa = 1.0 ; if (present(pres_scale)) RL2_T2_to_Pa = pres_scale + alpha_ref_mks = alpha_ref ; if (present(SV_scale)) alpha_ref_mks = alpha_ref / SV_scale + do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then do_massWeight = .true. @@ -2280,9 +2307,9 @@ 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) + call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks, scale=SV_scale) ! 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)) @@ -2318,15 +2345,15 @@ 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) + call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks, scale=SV_scale) ! 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)) + & @@ -2362,14 +2389,14 @@ 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) + call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks, scale=SV_scale) ! 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)) + & @@ -2388,7 +2415,7 @@ end subroutine int_spec_vol_dp_generic !! no free assumptions, apart from the use of Bode's rule quadrature to do the integrals. subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, & dP_neglect, bathyP, HI, EOS, dza, & - intp_dza, intx_dza, inty_dza, useMassWghtInterp) + intp_dza, intx_dza, inty_dza, useMassWghtInterp, SV_scale, pres_scale) 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]. @@ -2399,36 +2426,40 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & 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. + 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]. ! This subroutine calculates analytical and nearly-analytical integrals in ! pressure across layers of geopotential anomalies, which are required for @@ -2437,23 +2468,31 @@ 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 :: 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, 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 @@ -2463,6 +2502,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 + RL2_T2_to_Pa = 1.0 ; if (present(pres_scale)) RL2_T2_to_Pa = pres_scale + alpha_ref_mks = alpha_ref ; if (present(SV_scale)) alpha_ref_mks = alpha_ref / SV_scale + + 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) @@ -2474,11 +2517,11 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, do j=Jsq,Jeq+1; do i=Isq,Ieq+1 dp = p_b(i,j) - p_t(i,j) do n=1,5 ! T, S and p are linearly interpolated in the vertical. - p5(n) = 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) + call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks, scale=SV_scale) ! 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)) @@ -2529,13 +2572,13 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, ! Salinity, temperature and pressure with linear interpolation in the vertical. pos = (m-2)*5 do n=1,5 - p15(pos+n) = 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) + call calculate_spec_vol(T15, S15, p15, a15, 1, 15, EOS, alpha_ref_mks, scale=SV_scale) intp(1) = dza(i,j) ; intp(5) = dza(i+1,j) do m=2,4 @@ -2588,13 +2631,13 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, ! Salinity, temperature and pressure with linear interpolation in the vertical. pos = (m-2)*5 do n=1,5 - p15(pos+n) = 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) + call calculate_spec_vol(T15, S15, p15, a15, 1, 15, EOS, alpha_ref_mks, scale=SV_scale) intp(1) = dza(i,j) ; intp(5) = dza(i,j+1) do m=2,4 diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index 39d1dd26d4..cd590aa611 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -631,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 @@ -639,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. @@ -697,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. @@ -706,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 2c19b617c6..623db27ad3 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -510,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 From 3b3c34ab94506283479290fbb2472211cba08e00 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 5 Apr 2020 09:06:49 -0400 Subject: [PATCH 04/55] +Rescaled non-Boussinesq pressure force calcs Rescaled the pressures and specific volumes in the non-Boussinesq pressure force calculations, including changing the units of the pressures passed to set_pbce_nonBouss and using the new SV_scale and pres_scale arguments to the equation of state routines. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 105 ++++++++++----------- src/core/MOM_PressureForce_analytic_FV.F90 | 104 ++++++++++---------- src/core/MOM_PressureForce_blocked_AFV.F90 | 102 ++++++++++---------- 3 files changed, 148 insertions(+), 163 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index e0177e35b9..2aa13c5f39 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -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,10 +97,9 @@ 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]. @@ -112,20 +111,16 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb 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]. @@ -148,35 +143,34 @@ 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 if (use_p_atm) then !$OMP parallel do default(shared) - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(i,j,1) = p_atm(i,j) ; enddo ; enddo + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(i,j,1) = US%kg_m3_to_R*US%m_s_to_L_T**2*p_atm(i,j) ; enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(i,j,1) = 0.0 ; enddo ; enddo 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) - US%kg_m3_to_R*US%m_s_to_L_T**2*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 @@ -192,10 +186,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), & - 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=1) + 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=1, & + SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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 @@ -260,20 +255,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 +291,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 +316,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 @@ -707,22 +702,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,9 +728,8 @@ 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 :: Isq, Ieq, Jsq, Jeq, nz, i, j, k Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke @@ -743,7 +737,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) 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 +755,9 @@ 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, & + Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R, & + pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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 +767,11 @@ 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, Isq, Ieq-Isq+2, tv%eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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) + Isq, Ieq-Isq+2, tv%eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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 +792,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 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index d0a6932810..aca19a6ec6 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -118,7 +118,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p !! 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,33 +148,32 @@ 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). 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-12 ~> 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 @@ -193,15 +192,15 @@ 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/(US%R_to_kg_m3*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) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - p(i,j,1) = p_atm(i,j) + p(i,j,1) = US%kg_m3_to_R*US%m_s_to_L_T**2*p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) @@ -211,7 +210,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 @@ -263,13 +262,11 @@ 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, & + 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 + intx_dza(:,:,k), inty_dza(:,:,k), useMassWghtInterp=CS%useMassWghtInterp, & + SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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 +280,13 @@ 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, & + SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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, Isq, Ieq-Isq+2, & + tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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,11 +410,11 @@ 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 - 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) - US%kg_m3_to_R*US%m_s_to_L_T**2*p_atm(i,j))*Pa_to_H ! eta has the same units as h. enddo ; enddo else !$OMP parallel do default(shared) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 60e1330aa6..34b3b8301d 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -117,7 +117,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, !! 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,53 +125,52 @@ 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). 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] + 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-12 ~> 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 @@ -189,15 +188,15 @@ 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/(US%R_to_kg_m3*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) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - p(i,j,1) = p_atm(i,j) + p(i,j,1) = US%kg_m3_to_R*US%m_s_to_L_T**2*p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) @@ -207,7 +206,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 @@ -249,11 +248,12 @@ 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, & + SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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 +277,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 +293,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 +302,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, Isq, Ieq-Isq+2, & + tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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 @@ -355,28 +353,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,11 +392,11 @@ 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 - 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) - US%kg_m3_to_R*US%m_s_to_L_T**2*p_atm(i,j))*Pa_to_H ! eta has the same units as h. enddo ; enddo else !$OMP parallel do default(shared) From 94f94ede612eeb3ed2b47cb10f3ea16774dfebd7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Apr 2020 19:45:32 -0400 Subject: [PATCH 05/55] Rescaled pressure in find_eta routines Rescaled the pressure used to calculate density integrals in find_eta_3d and find_eta_2d to [R L2 T-2] and used the new pres_scale and SV_scale arguments to int_specific_vol_dp. All answers are bitwise identical. --- src/core/MOM_interface_heights.F90 | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 8dbacf6798..06868b875f 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,13 +100,14 @@ 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 do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,K), p(:,:,K+1), & - 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo) + 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo, & + SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) enddo !$OMP do do j=jsv,jev @@ -159,11 +161,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 +177,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,16 +199,18 @@ 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 do k = 1, nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), 0.0, & - G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo) + G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo, & + SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) enddo !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie From f29e32a4492fdeff8d540d5d2240bef6373e5ab0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Apr 2020 19:46:25 -0400 Subject: [PATCH 06/55] Rescaled pressure in calc_isoneutral_slopes Rescaled the pressure used in calls to calculate_density_derivs to [R L2 T-2] in calculate_density_derivs. All answers are bitwise identical. --- src/core/MOM_isopycnal_slopes.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index fc60d54f10..11ae7baa26 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]. @@ -147,12 +147,11 @@ 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 @@ -177,7 +176,8 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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) + drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state, scale=US%kg_m3_to_R, & + pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) endif do I=is-1,ie @@ -263,7 +263,8 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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) + drho_dS_v, is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R, & + pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) endif do i=is,ie if (use_EOS) then From efbbd317b0c964b52b909b3f1a2f1681b2b3f6cb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Apr 2020 19:47:54 -0400 Subject: [PATCH 07/55] Rescaled pressures in calculate_vertical_integrals Rescaled pressures to [R L2 T-2] in calculate_vertical_integrals for improved dimensional consistency testing. All answers are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 84c4011718..63e664a0ed 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -785,11 +785,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 +831,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 +841,11 @@ 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, & - G%HI, G%HI, tv%eqn_of_state, dpress) + 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, rho_scale=US%kg_m3_to_R, & + pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) 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,9 +867,9 @@ 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) + btm_pres(i,j) = btm_pres(i,j) + US%kg_m3_to_R*US%m_s_to_L_T**2*p_surf(i,j) endif enddo ; enddo call post_data(CS%id_pbo, btm_pres, CS%diag) @@ -1732,7 +1732,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%R_to_kg_m3*US%L_T_to_m_s**2) call set_dependent_diagnostics(MIS, ADp, CDp, G, CS) From f9b63f304e71b7f8beeb4364df9f51f462310e58 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Apr 2020 12:39:21 -0400 Subject: [PATCH 08/55] +Added RL2_T2_to_Pa element to unit_scale_type Added new RL2_T2_to_Pa and W_m2_to_RZ3_T3 elements to the unit_scale_type for code simplification and clarity. Also corrected spelling errors in the get_param descriptions of 5 scaling factors, which will change comments in the MOM_parameter_doc.debugging files. All answers are bitwise identical. --- src/framework/MOM_unit_scaling.F90 | 49 +++++++++++++++++++----------- 1 file changed, 32 insertions(+), 17 deletions(-) diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index 30e9c49850..7ef0486c0e 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. @@ -72,23 +75,23 @@ subroutine unit_scaling_init( param_file, US ) "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, & "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, & "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, & "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, & "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.", & + "internal units of heat content. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) if (abs(Z_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& "Z_RESCALE_POWER is outside of the valid range of -300 to 300.") @@ -129,19 +132,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 From 6d7dde4805df7a830d8bc1ffa5486f5102119ac8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Apr 2020 12:44:48 -0400 Subject: [PATCH 09/55] Use combined scaling factors Replaced products of scaling factors (like US%R_to_kg_m3*US%L_T_to_m_s**2) with combined scaling factors (like US%RL2_T2_to_Pa) to simplfy and clarify the code. All answers are bitwise idenical. --- src/core/MOM.F90 | 4 ++-- src/core/MOM_PressureForce_Montgomery.F90 | 12 ++++++------ src/core/MOM_PressureForce_analytic_FV.F90 | 12 ++++++------ src/core/MOM_PressureForce_blocked_AFV.F90 | 10 +++++----- src/core/MOM_forcing_type.F90 | 12 ++++++------ src/core/MOM_interface_heights.F90 | 4 ++-- src/core/MOM_isopycnal_slopes.F90 | 4 ++-- src/diagnostics/MOM_diagnostics.F90 | 4 ++-- .../lateral/MOM_mixed_layer_restrat.F90 | 2 +- .../vertical/MOM_internal_tide_input.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 11 +++++------ src/parameterizations/vertical/MOM_tidal_mixing.F90 | 4 ++-- src/user/SCM_CVMix_tests.F90 | 4 ++-- 13 files changed, 43 insertions(+), 44 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 213f81a06e..def4fd5197 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2987,13 +2987,13 @@ subroutine extract_surface_state(CS, sfc_state) 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_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 2aa13c5f39..b8dbfbc6fd 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -187,7 +187,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), & 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=1, & - SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) enddo !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 @@ -660,7 +660,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, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) do i=Isq,Ieq+1 pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo @@ -671,7 +671,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, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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)) * & @@ -757,7 +757,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) 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, & - pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + pres_scale=US%RL2_T2_to_Pa) 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)) @@ -768,10 +768,10 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) 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, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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)) + & diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index aca19a6ec6..6d0465f047 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -266,7 +266,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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, & - SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) elseif ( CS%Recon_Scheme == 2 ) then call MOM_error(FATAL, "PressureForce_AFV_nonBouss: "//& "int_spec_vol_dp_generic_ppm does not exist yet.") @@ -281,7 +281,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p dza(:,:,k), intp_dza(:,:,k), intx_dza(:,:,k), & inty_dza(:,:,k), bathyP=p(:,:,nz+1), dP_tiny=dp_neglect, & useMassWghtInterp=CS%useMassWghtInterp, & - SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) endif else alpha_anom = 1.0 / GV%Rlay(k) - alpha_ref @@ -336,7 +336,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p !$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, scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -670,18 +670,18 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at 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, & - rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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, CS%Rho0, & GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & - rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & 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, & - rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 34b3b8301d..08951d9eb0 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -249,7 +249,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, dza(:,:,k), intp_dza(:,:,k), intx_dza(:,:,k), & inty_dza(:,:,k), bathyP=p(:,:,nz+1), dP_tiny=dp_neglect, & useMassWghtInterp=CS%useMassWghtInterp, & - SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) else alpha_anom = 1.0 / GV%Rlay(k) - alpha_ref do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -303,7 +303,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, !$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, scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -670,20 +670,20 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, 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, & - rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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, 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, & - rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,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, & G%bathyT, dz_neglect, CS%useMassWghtInterp, & - rho_scale=US%kg_m3_to_R, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%Z_to_H diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 167ae0581d..b1b29ee9d3 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1116,7 +1116,7 @@ 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) if (associated(forces%ustar)) & @@ -1230,17 +1230,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)', & diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 06868b875f..c7147669dd 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -107,7 +107,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,K), p(:,:,K+1), & 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo, & - SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) enddo !$OMP do do j=jsv,jev @@ -210,7 +210,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) do k = 1, nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), 0.0, & G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo, & - SV_scale=US%R_to_kg_m3, pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) enddo !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 11ae7baa26..e5101d9937 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -177,7 +177,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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, & - pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + pres_scale=US%RL2_T2_to_Pa) endif do I=is-1,ie @@ -264,7 +264,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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, & - pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + pres_scale=US%RL2_T2_to_Pa) endif do i=is,ie if (use_EOS) then diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 63e664a0ed..0af64c98ff 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -843,7 +843,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) enddo ; enddo 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, rho_scale=US%kg_m3_to_R, & - pres_scale=US%R_to_kg_m3*US%L_T_to_m_s**2) + pres_scale=US%RL2_T2_to_Pa) do j=js,je ; do i=is,ie mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth enddo ; enddo @@ -1732,7 +1732,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', conversion=US%R_to_kg_m3*US%L_T_to_m_s**2) + units='Pa', conversion=US%RL2_T2_to_Pa) call set_dependent_diagnostics(MIS, ADp, CDp, G, CS) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 3ef9bd308a..c535cc9334 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -353,7 +353,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: diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index ebd5016855..e37f7a397d 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -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) @@ -349,7 +349,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_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 3229a7bf80..30fa1689e1 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2084,7 +2084,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.", & - 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.", & @@ -2096,19 +2096,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_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/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", & From 6af725f2bdf7176de7ba2ce94016d5819a7616c7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 8 Apr 2020 11:07:28 -0400 Subject: [PATCH 10/55] +Rescaled the units of fluxes%p_surf Rescaled the units of forces%p_surf, fluxes%p_surf, forces%p_surf_full and fluxes%p_surf_full and related surface pressure variables to [R L2 T-2 ~> Pa] for expanded dimensional consistency testing. All answers are bitwise identical, although there are changes to the rescaled units of elements to two transparent data types. --- .../MOM_surface_forcing_gfdl.F90 | 20 +++++++------- .../mct_driver/mom_surface_forcing_mct.F90 | 18 ++++++++----- .../mom_surface_forcing_nuopc.F90 | 22 +++++++-------- src/core/MOM.F90 | 25 +++++++++-------- src/core/MOM_PressureForce.F90 | 4 +-- src/core/MOM_PressureForce_Montgomery.F90 | 12 ++++----- src/core/MOM_PressureForce_analytic_FV.F90 | 14 +++++----- src/core/MOM_PressureForce_blocked_AFV.F90 | 20 +++++++------- src/core/MOM_dynamics_split_RK2.F90 | 10 +++---- src/core/MOM_dynamics_unsplit.F90 | 4 +-- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 +-- src/core/MOM_forcing_type.F90 | 27 ++++++++++--------- src/diagnostics/MOM_diagnostics.F90 | 10 +++---- src/ice_shelf/MOM_ice_shelf.F90 | 8 +++--- .../vertical/MOM_diabatic_aux.F90 | 6 ++--- .../vertical/MOM_entrain_diffusive.F90 | 2 +- .../vertical/MOM_full_convection.F90 | 6 ++--- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_kappa_shear.F90 | 10 +++---- .../vertical/MOM_set_diffusivity.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 8 +++--- src/user/dumbbell_surface_forcing.F90 | 16 +++++------ 22 files changed, 125 insertions(+), 125 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 index 3fd9ce7888..f2c0b5eea1 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..c017ecbba5 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. @@ -528,11 +528,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, 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) +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) +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 +623,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] @@ -687,11 +689,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) 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) +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) +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 +849,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 +1081,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 ab72a830ec..0cc71fcb1c 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. @@ -519,12 +519,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 @@ -613,7 +613,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) @@ -677,12 +677,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 @@ -840,7 +840,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 @@ -1071,8 +1071,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/core/MOM.F90 b/src/core/MOM.F90 index def4fd5197..6d5a49209c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -264,9 +264,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 @@ -473,7 +473,7 @@ subroutine step_MOM(forces, fluxes, 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 @@ -878,10 +878,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]. @@ -2449,8 +2449,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 @@ -2683,13 +2682,13 @@ 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 !< atmospheric 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 ! 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 :: i, j, is, ie, js, je @@ -2701,12 +2700,12 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) ! atmospheric pressure do j=js,je ; do i=is,ie 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(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, pres_scale=US%RL2_T2_to_Pa) else Rho_conv = GV%Rho0 endif - IgR0 = 1.0 / (Rho_conv * US%R_to_kg_m3*GV%mks_g_Earth) + IgR0 = US%Z_to_m / (Rho_conv * GV%g_Earth) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo ; enddo endif ; 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 b8dbfbc6fd..58687b874f 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -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, @@ -150,7 +150,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb if (use_p_atm) then !$OMP parallel do default(shared) - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(i,j,1) = US%kg_m3_to_R*US%m_s_to_L_T**2*p_atm(i,j) ; enddo ; enddo + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(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 ; p(i,j,1) = 0.0 ; enddo ; enddo @@ -165,7 +165,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb 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) - US%kg_m3_to_R*US%m_s_to_L_T**2*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) @@ -367,7 +367,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]. @@ -515,7 +515,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%kg_m3_to_R*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) @@ -526,7 +526,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%kg_m3_to_R*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) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 6d0465f047..aaab3d822f 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -74,7 +74,7 @@ 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 !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -110,7 +110,7 @@ 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 !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -200,7 +200,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - p(i,j,1) = US%kg_m3_to_R*US%m_s_to_L_T**2*p_atm(i,j) + p(i,j,1) = p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) @@ -414,7 +414,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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) - US%kg_m3_to_R*US%m_s_to_L_T**2*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) @@ -447,7 +447,7 @@ 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 !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -602,7 +602,7 @@ 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) + Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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) @@ -638,7 +638,7 @@ 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*GV%g_Earth)*e(i,j,1) + US%kg_m3_to_R*US%m_s_to_L_T**2 * 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) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 08951d9eb0..ae50019987 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -74,7 +74,7 @@ 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 !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -109,7 +109,7 @@ 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 !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -196,7 +196,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - p(i,j,1) = US%kg_m3_to_R*US%m_s_to_L_T**2*p_atm(i,j) + p(i,j,1) = p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) @@ -396,7 +396,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, 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) - US%kg_m3_to_R*US%m_s_to_L_T**2*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) @@ -430,7 +430,7 @@ 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 !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -587,11 +587,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, Isq, & + Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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, & + Isq, Ieq-Isq+2, tv%eqn_of_state, scale=US%kg_m3_to_R) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) @@ -639,7 +639,7 @@ 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*GV%g_Earth)*e(i,j,1) + US%kg_m3_to_R*US%m_s_to_L_T**2*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 diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f4327c2d57..ed74570dab 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -249,10 +249,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] @@ -409,7 +409,7 @@ 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 + Pa_to_eta = US%RL2_T2_to_Pa / GV%H_to_Pa !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta_PF_start(i,j) = CS%eta_PF(i,j) - Pa_to_eta * & 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 b1b29ee9d3..05d668d866 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -116,13 +116,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 @@ -195,14 +195,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 @@ -1063,9 +1063,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) @@ -1118,7 +1118,7 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, US, haloshift) call uvchksum(mesg//" forces%tau[xy]", forces%taux, forces%tauy, G%HI, & 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)) & @@ -1265,9 +1265,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/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 0af64c98ff..2107ca21bc 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -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 @@ -345,9 +345,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif else ! thkcello = dp/(rho*g) for non-Boussinesq 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) + pressure_1d(i) = US%RL2_T2_to_Pa * p_surf(i,j) enddo else do i=is,ie @@ -769,7 +769,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 @@ -869,7 +869,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) do j=js,je ; do i=is,ie btm_pres(i,j) = GV%g_Earth * mass(i,j) if (associated(p_surf)) then - btm_pres(i,j) = btm_pres(i,j) + US%kg_m3_to_R*US%m_s_to_L_T**2*p_surf(i,j) + btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif enddo ; enddo call post_data(CS%id_pbo, btm_pres, CS%diag) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index a0f54efb2d..0117061278 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -803,11 +803,11 @@ subroutine add_shelf_forces(G, US, CS, forces, do_shelf_area) press_ice = (ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) if (associated(forces%p_surf)) then if (.not.forces%accumulate_p_surf) forces%p_surf(i,j) = 0.0 - forces%p_surf(i,j) = forces%p_surf(i,j) + press_ice + forces%p_surf(i,j) = forces%p_surf(i,j) + US%kg_m3_to_R*US%m_s_to_L_T**2*press_ice endif if (associated(forces%p_surf_full)) then if (.not.forces%accumulate_p_surf) forces%p_surf_full(i,j) = 0.0 - forces%p_surf_full(i,j) = forces%p_surf_full(i,j) + press_ice + forces%p_surf_full(i,j) = forces%p_surf_full(i,j) + US%kg_m3_to_R*US%m_s_to_L_T**2*press_ice endif enddo ; enddo @@ -855,11 +855,11 @@ subroutine add_shelf_pressure(G, US, CS, fluxes) press_ice = (CS%ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) if (associated(fluxes%p_surf)) then if (.not.fluxes%accumulate_p_surf) fluxes%p_surf(i,j) = 0.0 - fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + press_ice + fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + US%kg_m3_to_R*US%m_s_to_L_T**2*press_ice endif if (associated(fluxes%p_surf_full)) then if (.not.fluxes%accumulate_p_surf) fluxes%p_surf_full(i,j) = 0.0 - fluxes%p_surf_full(i,j) = fluxes%p_surf_full(i,j) + press_ice + fluxes%p_surf_full(i,j) = fluxes%p_surf_full(i,j) + US%kg_m3_to_R*US%m_s_to_L_T**2*press_ice endif enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 343423a221..2af57f77c0 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -111,7 +111,7 @@ 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 @@ -136,13 +136,13 @@ 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 endif -!$OMP parallel do default(none) shared(is,ie,js,je,CS,G,GV,h,nz,tv,p_surf) & +!$OMP parallel do default(none) shared(is,ie,js,je,CS,G,GV,US,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 do j=js,je ps(:) = 0.0 if (PRESENT(p_surf)) then ; do i=is,ie - ps(i) = p_surf(i,j) + ps(i) = US%RL2_T2_to_Pa*p_surf(i,j) enddo ; endif do i=is,ie ; fraz_col(i) = 0.0 ; enddo diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 0fd691e7ab..3413f41389 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -836,7 +836,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & do i=is,ie ; diff_work(i,j,1) = 0.0 ; diff_work(i,j,nz+1) = 0.0 ; enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then - do i=is,ie ; pressure(i) = fluxes%p_surf(i,j) ; enddo + do i=is,ie ; pressure(i) = US%RL2_T2_to_Pa*fluxes%p_surf(i,j) ; enddo else do i=is,ie ; pressure(i) = 0.0 ; enddo endif diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index daf41a1ad3..0a023bbebf 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -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 @@ -403,7 +403,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h endif if (associated(p_surf)) then - do i=is,ie ; pres(i) = p_surf(i,j) ; enddo + do i=is,ie ; pres(i) = US%RL2_T2_to_Pa*p_surf(i,j) ; enddo else do i=is,ie ; pres(i) = 0.0 ; enddo endif diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index e37f7a397d..7360853976 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -199,7 +199,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) do j=js,je if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then - do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo + do i=is,ie ; pres(i) = US%RL2_T2_to_Pa*fluxes%p_surf(i,j) ; enddo else do i=is,ie ; pres(i) = 0.0 ; enddo endif diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 77407b6da1..db6aa37e58 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -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 @@ -283,7 +283,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & endif f2 = 0.25 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = p_surf(i,j) + surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = US%RL2_T2_to_Pa*p_surf(i,j) ! ---------------------------------------------------- I_Ld2_1d, dz_Int_1d @@ -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 @@ -585,8 +585,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ endif f2 = G%CoriolisBu(I,J)**2 surface_pres = 0.0 ; if (associated(p_surf)) & - surface_pres = 0.25 * ((p_surf(i,j) + p_surf(i+1,j+1)) + & - (p_surf(i+1,j) + p_surf(i,j+1))) + surface_pres = 0.25 * US%RL2_T2_to_Pa*((p_surf(i,j) + p_surf(i+1,j+1)) + & + (p_surf(i+1,j) + p_surf(i,j+1))) ! ---------------------------------------------------- ! Set the initial guess for kappa, here defined at interfaces. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 30fa1689e1..16305a33e9 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -896,7 +896,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then - do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo + do i=is,ie ; pres(i) = US%RL2_T2_to_Pa*fluxes%p_surf(i,j) ; enddo else do i=is,ie ; pres(i) = 0.0 ; enddo endif diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 840059e25a..d58256f9b6 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1395,8 +1395,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, & + Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_PA) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1632,8 +1632,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, & + is-G%IsdB+1, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_PA) endif do i=is,ie ; if (do_i(i)) then 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) From 916be3c56ba77e8ccfbcca0a357656058797e701 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 8 Apr 2020 14:13:58 -0400 Subject: [PATCH 11/55] Rescaled ice_shelf_CS%g_Earth like GV%g_Earth Revised the dimensional rescaling of ice_shelf_CS%g_Earth to match GV%g_Earth and ice_shelf_dyn_CS%g_Earth to minimize confusion when examining different parts of the code. Also cancelled out pairs of unit conversion factors when setting the ice shelf contributions to fluxes%p_surf and forces%p_surf. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 1ab963e63f..36f97a65fa 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -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]. @@ -371,7 +371,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) 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) = US%RL2_T2_to_Pa*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, & @@ -399,8 +399,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 @@ -776,7 +776,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,15 +811,14 @@ 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) + US%kg_m3_to_R*US%m_s_to_L_T**2*press_ice + forces%p_surf(i,j) = forces%p_surf(i,j) + press_ice endif if (associated(forces%p_surf_full)) then if (.not.forces%accumulate_p_surf) forces%p_surf_full(i,j) = 0.0 - forces%p_surf_full(i,j) = forces%p_surf_full(i,j) + US%kg_m3_to_R*US%m_s_to_L_T**2*press_ice + forces%p_surf_full(i,j) = forces%p_surf_full(i,j) + press_ice endif enddo ; enddo @@ -855,7 +854,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,15 +863,14 @@ 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) + US%kg_m3_to_R*US%m_s_to_L_T**2*press_ice + fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + press_ice endif if (associated(fluxes%p_surf_full)) then if (.not.fluxes%accumulate_p_surf) fluxes%p_surf_full(i,j) = 0.0 - fluxes%p_surf_full(i,j) = fluxes%p_surf_full(i,j) + US%kg_m3_to_R*US%m_s_to_L_T**2*press_ice + fluxes%p_surf_full(i,j) = fluxes%p_surf_full(i,j) + press_ice endif enddo ; enddo @@ -890,7 +888,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 @@ -1285,7 +1282,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl 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.", & From 5e1645878c8d258fe51ebb259ea424c527ee612e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 9 Apr 2020 08:46:39 -0400 Subject: [PATCH 12/55] +Add optional pres_scale arg to calculate_TFreeze Added a new optional pres_scale argument to the calculate_TFreeze interfaces to rescale pressures for dimensional consistency testing. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS.F90 | 86 +++++++++++++++++++------------ 1 file changed, 53 insertions(+), 33 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 5603246ace..d329b718bd 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -166,8 +166,7 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale, pr case (EOS_NEMO) call calculate_density_nemo(T, S, p_scale*pressure, rho, rho_ref) case default - call MOM_error(FATAL, & - "calculate_density_scalar: EOS is not valid.") + call MOM_error(FATAL, "calculate_density_scalar: EOS is not valid.") end select if (present(scale)) then ; if (scale /= 1.0) then @@ -214,8 +213,7 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re 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.") + call MOM_error(FATAL, "calculate_density_array: EOS%form_of_EOS is not valid.") end select else do j=start,start+npts-1 ; pres(j) = p_scale * pressure(j) ; enddo @@ -232,8 +230,7 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re case (EOS_NEMO) call calculate_density_nemo(T, S, pres, rho, start, npts, rho_ref) case default - call MOM_error(FATAL, & - "calculate_density_array: EOS%form_of_EOS is not valid.") + call MOM_error(FATAL, "calculate_density_array: EOS%form_of_EOS is not valid.") end select endif @@ -370,33 +367,38 @@ end subroutine calculate_spec_vol_array !> 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(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(inout) :: T_fr !< Freezing point potential temperature referenced @@ -404,22 +406,44 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS) 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 @@ -522,8 +546,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS case (EOS_TEOS10) 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 @@ -656,8 +679,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr 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 @@ -725,8 +747,7 @@ 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_density_derivs: EOS%form_of_EOS is not valid.") end select if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 @@ -765,8 +786,7 @@ 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 end subroutine calculate_compress_array From 1252e3b82594d3241c4b34c4830f3cc951840e1f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 9 Apr 2020 09:01:46 -0400 Subject: [PATCH 13/55] Pass rescaled pressures to calculate_TFreeze Use the new pres_scale argument to TFreeze and pass rescaled pressures to calculate_TFreeze and several instances of calculate_density. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 26 ++++++++++--------- .../vertical/MOM_diabatic_aux.F90 | 17 +++++++----- .../vertical/MOM_entrain_diffusive.F90 | 10 +++---- .../vertical/MOM_full_convection.F90 | 20 +++++++------- .../vertical/MOM_internal_tide_input.F90 | 10 +++---- .../vertical/MOM_set_diffusivity.F90 | 10 +++---- 6 files changed, 49 insertions(+), 44 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 36f97a65fa..298fbc4507 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -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, & @@ -217,7 +218,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) !< with temperature [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]. + 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] @@ -371,13 +372,13 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) 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%RL2_T2_to_Pa*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) + Rhoml(:), is, ie-is+1, CS%eqn_of_state, pres_scale=US%RL2_T2_to_Pa) call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, & - dR0_dT, dR0_dS, is, ie-is+1, CS%eqn_of_state) + dR0_dT, dR0_dS, is, ie-is+1, CS%eqn_of_state, pres_scale=US%RL2_T2_to_Pa) do i=is,ie if ((state%ocean_mass(i,j) > US%RZ_to_kg_m2*CS%col_mass_melt_threshold) .and. & @@ -445,7 +446,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 +590,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)) @@ -1272,12 +1275,11 @@ 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, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 8fec9a4ca2..1d079d451b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -118,9 +118,10 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) 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,6 +136,8 @@ 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,US,h,nz,tv,p_surf) & !$OMP private(fraz_col,T_fr_set,T_freeze,hc,ps) & @@ -142,18 +145,18 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) do j=js,je ps(:) = 0.0 if (PRESENT(p_surf)) then ; do i=is,ie - ps(i) = US%RL2_T2_to_Pa*p_surf(i,j) + ps(i) = p_surf(i,j) enddo ; endif do i=is,ie ; fraz_col(i) = 0.0 ; enddo 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 +165,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 +191,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 diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 3413f41389..e5366897e4 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -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 @@ -836,12 +836,12 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & do i=is,ie ; diff_work(i,j,1) = 0.0 ; diff_work(i,j,nz+1) = 0.0 ; enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then - do i=is,ie ; pressure(i) = US%RL2_T2_to_Pa*fluxes%p_surf(i,j) ; enddo + do i=is,ie ; pressure(i) = fluxes%p_surf(i,j) ; enddo else 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, is, ie-is+1, & + tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) do i=is,ie if ((k>kmb) .and. (k 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]. @@ -403,24 +403,24 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h endif if (associated(p_surf)) then - do i=is,ie ; pres(i) = US%RL2_T2_to_Pa*p_surf(i,j) ; enddo + do i=is,ie ; pres(i) = p_surf(i,j) ; enddo 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 + 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, pres_scale=US%RL2_T2_to_Pa) + 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), is-G%isd+1, ie-is+1, & + tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + 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) + 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, pres_scale=US%RL2_T2_to_Pa) end subroutine smoothed_dRdT_dRdS diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index a9275c1ccc..6c366e5ff9 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -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] @@ -199,18 +199,18 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) do j=js,je if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then - do i=is,ie ; pres(i) = US%RL2_T2_to_Pa*fluxes%p_surf(i,j) ; enddo + do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo else do i=is,ie ; pres(i) = 0.0 ; enddo 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(:), & + is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 4f9a6bf478..9c47841748 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -868,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] @@ -896,18 +896,18 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then - do i=is,ie ; pres(i) = US%RL2_T2_to_Pa*fluxes%p_surf(i,j) ; enddo + do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo else do i=is,ie ; pres(i) = 0.0 ; enddo 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(:,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), & + is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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) From ce0905e17e7fc4b0e1f4f55f6ece1d75234d8826 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Apr 2020 06:03:18 -0400 Subject: [PATCH 14/55] +Add hor_index_type variants of EOS routines Added variants of calculate_density routines that use a hor_index_type to specify array extents and unit_scale_types for dimensional consistency testing, further overloading existing interfaces. Also replaced the recently added rho_scale and pres_scale arguments to int_density_dz with an optional unit_scale_type argument, and modified calls to use this new argument. All answers are bitwise identical, but there are changes to external interfaces. --- src/core/MOM_PressureForce_Montgomery.F90 | 27 +- src/core/MOM_PressureForce_analytic_FV.F90 | 39 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 14 +- src/core/MOM_interface_heights.F90 | 6 +- src/diagnostics/MOM_diagnostics.F90 | 3 +- src/equation_of_state/MOM_EOS.F90 | 722 +++++++++++++++++---- 6 files changed, 627 insertions(+), 184 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 58687b874f..1665e28def 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -186,8 +186,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), & - 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=1, & - SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) + 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=1, US=US) enddo !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 @@ -659,8 +658,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, G%HI, & + tv%eqn_of_state, US, halo=1) do i=Isq,Ieq+1 pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo @@ -670,8 +669,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) T_int(i) = 0.5*(tv%T(i,j,k-1)+tv%T(i,j,k)) S_int(i) = 0.5*(tv%S(i,j,k-1)+tv%S(i,j,k)) enddo - 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T_int, S_int, press, dR_dT, dR_dS, G%HI, & + tv%eqn_of_state, US, halo=1) 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)) * & @@ -755,9 +754,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, & - pres_scale=US%RL2_T2_to_Pa) + call calculate_density(tv%T(:,j,nz), tv%S(:,j,nz), p(:,j,nz+1), rho_in_situ, G%HI, & + tv%eqn_of_state, US, halo=1) 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)) @@ -767,11 +765,12 @@ 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, pres_scale=US%RL2_T2_to_Pa) - 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T_int, S_int, p(:,j,k+1), rho_in_situ, G%HI, tv%eqn_of_state, US, halo=1) +! 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T_int, S_int, p(:,j,k+1), dR_dT, dR_dS, G%HI, & + tv%eqn_of_state, US, halo=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)) * & ((dR_dT(i)*(tv%T(i,j,k+1)-tv%T(i,j,k)) + & diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index aaab3d822f..10842f9e7e 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -264,24 +264,22 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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, & - SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) + tv%eqn_of_state, dza(:,:,k), intp_dza(:,:,k), intx_dza(:,:,k), inty_dza(:,:,k), & + useMassWghtInterp=CS%useMassWghtInterp, US=US) elseif ( CS%Recon_Scheme == 2 ) then call MOM_error(FATAL, "PressureForce_AFV_nonBouss: "//& "int_spec_vol_dp_generic_ppm does not exist yet.") ! call int_spec_vol_dp_generic_ppm ( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & ! tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), p(:,:,K), p(:,:,K+1), & ! alpha_ref, G%HI, tv%eqn_of_state, dza(:,:,k), intp_dza(:,:,k), & - ! intx_dza(:,:,k), inty_dza(:,:,k)) + ! intx_dza(:,:,k), inty_dza(:,:,k), US=US) endif else call int_specific_vol_dp(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), p(:,:,K), & 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, & - SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) + useMassWghtInterp=CS%useMassWghtInterp, US=US) endif else alpha_anom = 1.0 / GV%Rlay(k) - alpha_ref @@ -335,8 +333,8 @@ 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, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), rho_in_situ, G%HI, & + tv%eqn_of_state, US, halo=1) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -601,11 +599,11 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at !$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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), rho_in_situ, G%HI, & + tv%eqn_of_state, US, halo=1) 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, G%HI, & + tv%eqn_of_state, US, halo=1) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) @@ -668,20 +666,19 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at 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, 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, & - rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + 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, US=US) 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, CS%Rho0, & - GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & - rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & + rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, dpa, & + intz_dpa, intx_dpa, inty_dpa, US=US) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - 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, & - rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + 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, US=US) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index ae50019987..c532e17001 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -248,8 +248,7 @@ 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, & - SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) + useMassWghtInterp=CS%useMassWghtInterp, US=US) else alpha_anom = 1.0 / GV%Rlay(k) - alpha_ref do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -669,21 +668,18 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, 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, & - rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + useMassWghtInterp=CS%useMassWghtInterp, US=US) 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, 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, & - rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, & + intx_dpa_bk, inty_dpa_bk, US=US) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,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, & - G%bathyT, dz_neglect, CS%useMassWghtInterp, & - rho_scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + G%bathyT, dz_neglect, CS%useMassWghtInterp, US=US) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%Z_to_H diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index c7147669dd..bfb9ad2703 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -106,8 +106,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !$OMP do do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,K), p(:,:,K+1), & - 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo, & - SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) + 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo, US=US) enddo !$OMP do do j=jsv,jev @@ -209,8 +208,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !$OMP do do k = 1, nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), 0.0, & - G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo, & - SV_scale=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) + G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo, US=US) enddo !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index be97723ee2..8c69853f3d 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -842,8 +842,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) z_bot(i,j) = z_top(i,j) - GV%H_to_Z*h(i,j,k) enddo ; enddo call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), z_top, z_bot, 0.0, GV%Rho0, GV%g_Earth, & - G%HI, G%HI, tv%eqn_of_state, dpress, rho_scale=US%kg_m3_to_R, & - pres_scale=US%RL2_T2_to_Pa) + G%HI, G%HI, tv%eqn_of_state, dpress, US=US) do j=js,je ; do i=is,ie mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth enddo ; enddo diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index d329b718bd..cfd286450e 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 @@ -58,19 +59,24 @@ 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_HI_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 calculate_spec_vol_scalar , calculate_spec_vol_array, calculate_spec_vol_HI_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_HI_1d end interface calculate_density_derivs +interface calculate_specific_vol_derivs + module procedure calculate_spec_vol_derivs_array, calculate_spec_vol_derivs_HI_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 @@ -180,7 +186,7 @@ end subroutine calculate_density_scalar subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref, scale, pres_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 [other ~> 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 @@ -240,6 +246,94 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re end subroutine calculate_density_array +!> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs +!! using array extents determined from a hor_index_type. +!! If rho_ref is present, the anomaly with respect to rho_ref is returned. +subroutine calculate_density_HI_1d(T, S, pressure, rho, HI, EOS, US, halo, rho_ref) + type(hor_index_type), intent(in) :: HI !< The horizontal index structure + real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] + real, dimension(HI%isd:HI%ied), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] + real, dimension(HI%isd:HI%ied), intent(inout) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] + type(EOS_type), pointer :: EOS !< Equation of state structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + + ! Local variables + real, dimension(HI%isd:HI%ied) :: pres ! Pressure converted to [Pa] + real :: rho_reference ! rho_ref converted to [kg m-3] + integer :: i, is, ie, start, npts, halo_sz + + if (.not.associated(EOS)) call MOM_error(FATAL, & + "calculate_density_HI_1d called with an unassociated EOS_type EOS.") + + halo_sz = 0 ; if (present(halo)) halo_sz = halo + + start = HI%isc - (HI%isd-1) - halo_sz + npts = HI%iec - HI%isc + 1 + 2*halo_sz + is = HI%isc - halo_sz ; ie = HI%iec + halo_sz + + if ((US%RL2_T2_to_Pa == 1.0) .and. (US%R_to_kg_M3 == 1.0)) then + 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_HI_1d: EOS%form_of_EOS is not valid.") + end select + 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo + rho_reference = 0.0 ; if (present(rho_ref)) rho_reference = US%R_to_kg_m3*rho_ref + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_density_linear(T, S, pres, rho, start, npts, & + EOS%Rho_T0_S0-rho_reference, EOS%dRho_dT, EOS%dRho_dS) + case (EOS_UNESCO) + call calculate_density_unesco(T, S, pres, rho, start, npts, rho_reference) + case (EOS_WRIGHT) + call calculate_density_wright(T, S, pres, rho, start, npts, rho_reference) + case (EOS_TEOS10) + call calculate_density_teos10(T, S, pres, rho, start, npts, rho_reference) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pres, rho, start, npts, rho_reference) + case default + call MOM_error(FATAL, "calculate_density_HI_1d: EOS%form_of_EOS is not valid.") + end select + 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_density_linear(T, S, pres, rho, start, npts, & + EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) + case (EOS_UNESCO) + call calculate_density_unesco(T, S, pres, rho, start, npts) + case (EOS_WRIGHT) + call calculate_density_wright(T, S, pres, rho, start, npts) + case (EOS_TEOS10) + call calculate_density_teos10(T, S, pres, rho, start, npts) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pres, rho, start, npts) + case default + call MOM_error(FATAL, "calculate_density_HI_1d: EOS%form_of_EOS is not valid.") + end select + endif + + if (US%kg_m3_to_R /= 1.0) then ; do i=is,ie + rho(i) = US%kg_m3_to_R * rho(i) + enddo ; endif + +end subroutine calculate_density_HI_1d + !> 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, pres_scale) @@ -288,7 +382,6 @@ subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scal end subroutine calculate_spec_vol_scalar - !> 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, pres_scale) @@ -365,6 +458,100 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s end subroutine calculate_spec_vol_array +!> Calls the appropriate subroutine to calculate the specific volume of sea water for 1-D array +!! inputs using array extents determined from a hor_index_type. +subroutine calculate_spec_vol_HI_1d(T, S, pressure, specvol, HI, EOS, US, halo, spv_ref) + type(hor_index_type), intent(in) :: HI !< The horizontal index structure + real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] + real, dimension(HI%isd:HI%ied), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] + real, dimension(HI%isd:HI%ied), intent(inout) :: specvol !< In situ specific volume [R-1 ~> m3 kg-1] + type(EOS_type), pointer :: EOS !< Equation of state structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. + real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1]. + + ! Local variables + real, dimension(HI%isd:HI%ied) :: pres ! Pressure converted to [Pa] + real, dimension(HI%isd:HI%ied) :: rho ! Density [kg m-3] + real :: spv_reference ! spv_ref converted to [m3 kg-1] + integer :: i, is, ie, start, npts, halo_sz + + if (.not.associated(EOS)) call MOM_error(FATAL, & + "calculate_spec_vol_HI_1d called with an unassociated EOS_type EOS.") + + halo_sz = 0 ; if (present(halo)) halo_sz = halo + + start = HI%isc - (HI%isd-1) - halo_sz + npts = HI%iec - HI%isc + 1 + 2*halo_sz + is = HI%isc - halo_sz ; ie = HI%iec + halo_sz + + if ((US%RL2_T2_to_Pa == 1.0) .and. (US%R_to_kg_m3 == 1.0)) then + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_spec_vol_linear(T, S, pressure, specvol, start, npts, & + EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) + case (EOS_UNESCO) + call calculate_spec_vol_unesco(T, S, pressure, specvol, start, npts, spv_ref) + case (EOS_WRIGHT) + call calculate_spec_vol_wright(T, S, pressure, specvol, start, npts, spv_ref) + 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) + 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_HI_1d: EOS%form_of_EOS is not valid.") + end select + 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo + spv_reference = US%kg_m3_to_R*spv_ref + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_spec_vol_linear(T, S, pres, specvol, start, npts, & + EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_reference) + case (EOS_UNESCO) + call calculate_spec_vol_unesco(T, S, pres, specvol, start, npts, spv_reference) + case (EOS_WRIGHT) + call calculate_spec_vol_wright(T, S, pres, specvol, start, npts, spv_reference) + case (EOS_TEOS10) + call calculate_spec_vol_teos10(T, S, pres, specvol, start, npts, spv_reference) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pres, rho, start, npts) + specvol = 1.0 / rho - spv_reference + case default + call MOM_error(FATAL, "calculate_spec_vol_HI_1d: EOS%form_of_EOS is not valid.") + end select + 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_spec_vol_linear(T, S, pres, specvol, start, npts, & + EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS) + case (EOS_UNESCO) + call calculate_spec_vol_unesco(T, S, pres, specvol, start, npts) + case (EOS_WRIGHT) + call calculate_spec_vol_wright(T, S, pres, specvol, start, npts) + case (EOS_TEOS10) + call calculate_spec_vol_teos10(T, S, pres, specvol, start, npts) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pres, rho, start, npts) + do i=is,ie ; specvol(i) = 1.0 / rho(i) ; enddo + case default + call MOM_error(FATAL, "calculate_spec_vol_HI_1d: EOS%form_of_EOS is not valid.") + end select + endif + + if (US%R_to_kg_m3 /= 1.0) then ; do i=is,ie + specvol(i) = US%R_to_kg_m3 * specvol(i) + enddo ; endif + +end subroutine calculate_spec_vol_HI_1d !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs. subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) @@ -515,6 +702,78 @@ 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_HI_1d(T, S, pressure, drho_dT, drho_dS, HI, EOS, US, halo) + type(hor_index_type), intent(in) :: HI !< The horizontal index structure + real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] + real, dimension(HI%isd:HI%ied), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] + real, dimension(HI%isd:HI%ied), intent(inout) :: drho_dT !< The partial derivative of density with potential + !! temperature [R degC-1 ~> kg m-3 degC-1] + real, dimension(HI%isd:HI%ied), 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. + + ! Local variables + real, dimension(HI%isd:HI%ied) :: pres ! Pressure converted to [Pa] + real :: rho_reference ! rho_ref converted to [kg m-3] + integer :: i, is, ie, start, npts, halo_sz + + if (.not.associated(EOS)) call MOM_error(FATAL, & + "calculate_density_derivs called with an unassociated EOS_type EOS.") + + halo_sz = 0 ; if (present(halo)) halo_sz = halo + + start = HI%isc - (HI%isd-1) - halo_sz + npts = HI%iec - HI%isc + 1 + 2*halo_sz + is = HI%isc - halo_sz ; ie = HI%iec + halo_sz + + if (US%RL2_T2_to_Pa == 1.0) then + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & + EOS%dRho_dT, EOS%dRho_dS, start, npts) + case (EOS_UNESCO) + call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_WRIGHT) + call calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_TEOS10) + call calculate_density_derivs_teos10(T, S, pressure, drho_dT, drho_dS, start, npts) + 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_HI_1d: EOS%form_of_EOS is not valid.") + end select + else + do i=is,ie ; pres(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_density_derivs_linear(T, S, pres, drho_dT, drho_dS, EOS%Rho_T0_S0, & + EOS%dRho_dT, EOS%dRho_dS, start, npts) + case (EOS_UNESCO) + call calculate_density_derivs_unesco(T, S, pres, drho_dT, drho_dS, start, npts) + case (EOS_WRIGHT) + call calculate_density_derivs_wright(T, S, pres, drho_dT, drho_dS, start, npts) + case (EOS_TEOS10) + call calculate_density_derivs_teos10(T, S, pres, drho_dT, drho_dS, start, npts) + case (EOS_NEMO) + call calculate_density_derivs_nemo(T, S, pres, drho_dT, drho_dS, start, npts) + case default + call MOM_error(FATAL, "calculate_density_derivs_HI_1d: EOS%form_of_EOS is not valid.") + end select + endif + + if (US%kg_m3_to_R /= 1.0) then ; do i=is,ie + drho_dT(i) = US%kg_m3_to_R * drho_dT(i) + drho_dS(i) = US%kg_m3_to_R * drho_dS(i) + enddo ; endif + +end subroutine calculate_density_derivs_HI_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, pres_scale) @@ -620,8 +879,7 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh end select endif - if (present(scale)) then ; if (scale /= 1.0) then - ; do j=start,start+npts-1 + 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) @@ -699,7 +957,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr 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, pres_scale) +subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS, scale, pres_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] @@ -715,48 +973,173 @@ subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa. ! 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] real :: p_scale ! A factor to convert pressure to units of Pa. 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.") p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & - npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) - case (EOS_UNESCO) - call calculate_density_unesco(T, S, pressure, rho, start, npts) - call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) - do j=start,start+npts-1 - dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) - dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) - enddo - case (EOS_WRIGHT) - call calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) - case (EOS_TEOS10) - call calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start, npts) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho, start, npts) - call calculate_density_derivs_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) - do j=start,start+npts-1 - dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) - 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.") - end select + if (p_scale == 1.0) then + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & + npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) + case (EOS_UNESCO) + call calculate_density_unesco(T, S, pressure, rho, start, npts) + call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) + do j=start,start+npts-1 + dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) + dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) + enddo + case (EOS_WRIGHT) + call calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) + case (EOS_TEOS10) + call calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start, npts) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pressure, rho, start, npts) + call calculate_density_derivs_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) + do j=start,start+npts-1 + dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) + dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) + enddo + case default + call MOM_error(FATAL, "calculate_spec_vol_derivs_array: EOS%form_of_EOS is not valid.") + end select + else + do j=start,start+npts-1 ; press(j) = p_scale * pressure(j) ; enddo + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_specvol_derivs_linear(T, S, press, dSV_dT, dSV_dS, start, & + npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) + case (EOS_UNESCO) + call calculate_density_unesco(T, S, press, rho, start, npts) + call calculate_density_derivs_unesco(T, S, press, drho_dT, drho_dS, start, npts) + do j=start,start+npts-1 + dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) + dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) + enddo + case (EOS_WRIGHT) + call calculate_specvol_derivs_wright(T, S, press, dSV_dT, dSV_dS, start, npts) + case (EOS_TEOS10) + call calculate_specvol_derivs_teos10(T, S, press, dSV_dT, dSV_dS, start, npts) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pressure, rho, start, npts) + call calculate_density_derivs_nemo(T, S, press, drho_dT, drho_dS, start, npts) + do j=start,start+npts-1 + dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) + dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) + enddo + case default + call MOM_error(FATAL, "calculate_spec_vol_derivs_array: 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 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 an array. +subroutine calculate_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, EOS, US, halo) + type(hor_index_type), intent(in) :: HI !< The horizontal index structure + real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] + real, dimension(HI%isd:HI%ied), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] + real, dimension(HI%isd:HI%ied), intent(inout) :: dSV_dT !< The partial derivative of specific volume with potential + !! temperature [R-1 degC-1 ~> m3 kg-1 degC-1] + real, dimension(HI%isd:HI%ied), 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. + + ! Local variables + real, dimension(HI%isd:HI%ied) :: rho ! In situ density [kg m-3] + real, dimension(HI%isd:HI%ied) :: dRho_dT ! Derivative of density with temperature [kg m-3 degC-1] + real, dimension(HI%isd:HI%ied) :: dRho_dS ! Derivative of density with salinity [kg m-3 ppt-1] + real, dimension(HI%isd:HI%ied) :: press ! Pressure converted to [Pa] + real :: rho_reference ! rho_ref converted to [kg m-3] + integer :: i, is, ie, start, npts, halo_sz + + if (.not.associated(EOS)) call MOM_error(FATAL, & + "calculate_spec_vol_derivs_HI_1d called with an unassociated EOS_type EOS.") + + halo_sz = 0 ; if (present(halo)) halo_sz = halo + + start = HI%isc - (HI%isd-1) - halo_sz + npts = HI%iec - HI%isc + 1 + 2*halo_sz + is = HI%isc - halo_sz ; ie = HI%iec + halo_sz + + if (US%RL2_T2_to_Pa == 1.0) then + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & + npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) + case (EOS_UNESCO) + call calculate_density_unesco(T, S, pressure, rho, start, npts) + call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) + do i=is,ie + dSV_dT(i) = -dRho_DT(i)/(rho(i)**2) + dSV_dS(i) = -dRho_DS(i)/(rho(i)**2) + enddo + case (EOS_WRIGHT) + call calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) + case (EOS_TEOS10) + call calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start, npts) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pressure, rho, start, npts) + call calculate_density_derivs_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) + do i=is,ie + dSV_dT(i) = -dRho_DT(i)/(rho(i)**2) + dSV_dS(i) = -dRho_DS(i)/(rho(i)**2) + enddo + case default + call MOM_error(FATAL, "calculate_spec_vol_derivs_HI_1d: EOS%form_of_EOS is not valid.") + end select + else + do i=is,ie ; press(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_specvol_derivs_linear(T, S, press, dSV_dT, dSV_dS, start, & + npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) + case (EOS_UNESCO) + call calculate_density_unesco(T, S, press, rho, start, npts) + call calculate_density_derivs_unesco(T, S, press, drho_dT, drho_dS, start, npts) + do i=is,ie + dSV_dT(i) = -dRho_DT(i)/(rho(i)**2) + dSV_dS(i) = -dRho_DS(i)/(rho(i)**2) + enddo + case (EOS_WRIGHT) + call calculate_specvol_derivs_wright(T, S, press, dSV_dT, dSV_dS, start, npts) + case (EOS_TEOS10) + call calculate_specvol_derivs_teos10(T, S, press, dSV_dT, dSV_dS, start, npts) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pressure, rho, start, npts) + call calculate_density_derivs_nemo(T, S, press, drho_dT, drho_dS, start, npts) + do i=is,ie + dSV_dT(i) = -dRho_DT(i)/(rho(i)**2) + dSV_dS(i) = -dRho_DS(i)/(rho(i)**2) + enddo + case default + call MOM_error(FATAL, "calculate_spec_vol_derivs_HI_1d: EOS%form_of_EOS is not valid.") + end select + endif + + if (US%R_to_kg_m3 /= 1.0) then ; do i=is,ie + drho_dT(i) = US%R_to_kg_m3 * drho_dT(i) + drho_dS(i) = US%R_to_kg_m3 * drho_dS(i) + enddo ; endif + +end subroutine calculate_spec_vol_derivs_HI_1d -end subroutine calculate_specific_vol_derivs !> 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) @@ -791,15 +1174,15 @@ subroutine calculate_compress_array(T, S, pressure, rho, drho_dp, start, npts, E 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 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(in) :: T !< Potential temperature referenced to the surface [degC] + real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: pressure !< Pressure [Pa] + real, intent(out) :: rho !< In situ density [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. + !! (also the inverse of the square of sound speed) [s2 m-2]. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa @@ -820,7 +1203,7 @@ end subroutine calculate_compress_scalar !! series for log(1-eps/1+eps) that assumes that |eps| < . 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, SV_scale, pres_scale) + bathyP, dP_tiny, useMassWghtInterp, US) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature referenced to the surface [degC] @@ -857,13 +1240,12 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & !! 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]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] + 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.") @@ -871,14 +1253,13 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & if (EOS%EOS_quadrature) then 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, & - bathyP, dP_tiny, useMassWghtInterp, SV_scale, pres_scale) + bathyP, dP_tiny, useMassWghtInterp, US) else ; select case (EOS%form_of_EOS) case (EOS_LINEAR) - if (present(SV_scale)) then - rho_scale = 1.0 / SV_scale - call int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, rho_scale*EOS%Rho_T0_S0, & - rho_scale*EOS%dRho_dT, rho_scale*EOS%dRho_dS, dza, intp_dza, & - intx_dza, inty_dza, halo_size, & + if (present(US)) then + call int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, US%kg_m3_to_R*EOS%Rho_T0_S0, & + US%kg_m3_to_R*EOS%dRho_dT, US%kg_m3_to_R*EOS%dRho_dS, dza, & + intp_dza, intx_dza, inty_dza, halo_size, & bathyP, dP_tiny, useMassWghtInterp) else call int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, EOS%Rho_T0_S0, & @@ -887,13 +1268,18 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & bathyP, dP_tiny, useMassWghtInterp) endif case (EOS_WRIGHT) - call int_spec_vol_dp_wright(T, S, p_t, p_b, alpha_ref, HI, dza, & - intp_dza, intx_dza, inty_dza, halo_size, & - bathyP, dP_tiny, useMassWghtInterp, SV_scale, pres_scale) + if (present(US)) then + 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=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) + else + 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) + endif 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, & - bathyP, dP_tiny, useMassWghtInterp, SV_scale, pres_scale) + bathyP, dP_tiny, useMassWghtInterp, US) end select ; endif end subroutine int_specific_vol_dp @@ -902,7 +1288,7 @@ end subroutine int_specific_vol_dp !! 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, rho_scale, pres_scale) + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp, US) 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), & @@ -942,21 +1328,23 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dp 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 [R L2 T-2 Pa-1 ~> 1]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + + ! 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, & - rho_scale, pres_scale) + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp, US) else ; select case (EOS%form_of_EOS) case (EOS_LINEAR) - if (present(rho_scale)) then + rho_scale = 1.0 ; if (present(US)) rho_scale = US%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) @@ -966,13 +1354,20 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dp 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, pres_scale) + rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + pres_scale = 1.0 ; if (present(US)) pres_scale = US%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, & - rho_scale, pres_scale) + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp, US) end select ; endif end subroutine int_density_dz @@ -1166,7 +1561,7 @@ end subroutine EOS_use_linear !! finite-volume form pressure accelerations in a Boussinesq model. subroutine 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, rho_scale, pres_scale) + bathyT, dz_neglect, useMassWghtInterp, US) 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), & @@ -1187,18 +1582,18 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! [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 + 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 [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 [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 [R L2 T-2 ~> Pa]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & @@ -1206,10 +1601,8 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, 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]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + ! 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] @@ -1219,6 +1612,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] or [m3 kg-1] + real :: 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]. @@ -1243,8 +1637,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 ; if (present(pres_scale)) GxRho = pres_scale * G_e * rho_0 - rho_ref_mks = rho_ref ; if (present(rho_scale)) rho_ref_mks = rho_ref / rho_scale + rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + GxRho = G_e * rho_0 ; if (present(US)) GxRho = US%RL2_T2_to_Pa * G_e * rho_0 + rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * US%R_to_kg_m3 I_Rho = 1.0 / rho_0 do_massWeight = .false. @@ -1262,7 +1657,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_mks, scale=rho_scale) + if (rho_scale /= 1.0) then + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) + else + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, 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)) @@ -1304,7 +1703,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_mks, scale=rho_scale) + if (rho_scale /= 1.0) then + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) + else + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, 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))) @@ -1346,7 +1749,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_mks, scale=rho_scale) + if (rho_scale /= 1.0) then + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) + else + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, 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))) @@ -1363,8 +1770,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, rho_scale, pres_scale) + intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp, US) 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), & @@ -1404,10 +1810,8 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & !! 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. - 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]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + ! 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 @@ -1439,6 +1843,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & 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]. @@ -1459,8 +1864,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 ; if (present(pres_scale)) GxRho = pres_scale * G_e * rho_0 - rho_ref_mks = rho_ref ; if (present(rho_scale)) rho_ref_mks = rho_ref / rho_scale + rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + GxRho = G_e * rho_0 ; if (present(US)) GxRho = US%RL2_T2_to_Pa * G_e * rho_0 + rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * US%R_to_kg_m3 I_Rho = 1.0 / rho_0 massWeightToggle = 0. if (present(useMassWghtInterp)) then @@ -1486,7 +1892,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_mks, scale=rho_scale) + if (rho_scale /= 1.0) then + call calculate_density_array(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS, rho_ref_mks, scale=rho_scale) + else + call calculate_density_array(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS, rho_ref_mks) + endif do i=isq,ieq+1 ; iin = i+ioff ! Use Bode's rule to estimate the pressure anomaly change. @@ -1566,7 +1976,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_mks, scale=rho_scale) + if (rho_scale /= 1.0) then + call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, rho_ref_mks, scale=rho_scale) + else + call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, rho_ref_mks) + endif do I=Isq,Ieq ; iin = i+ioff intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j) @@ -1645,8 +2059,13 @@ 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_mks, scale=rho_scale) + 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_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_mks) + endif do i=HIO%isc,HIO%iec ; iin = i+ioff intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1) @@ -1784,9 +2203,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, rho_scale, pres_scale) +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, US) 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 @@ -1826,10 +2245,7 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & 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]. - 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]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine calculates (by numerical quadrature) integrals of ! pressure anomalies across layers, which are required for calculating the @@ -1855,6 +2271,7 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] or [m3 kg-1] + real :: 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 @@ -1881,8 +2298,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 ; if (present(pres_scale)) GxRho = pres_scale * G_e * rho_0 - rho_ref_mks = rho_ref ; if (present(rho_scale)) rho_ref_mks = rho_ref / rho_scale + rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + GxRho = G_e * rho_0 ; if (present(US)) GxRho = US%RL2_T2_to_Pa * G_e * rho_0 + rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * US%R_to_kg_m3 I_Rho = 1.0 / rho_0 ! ============================= @@ -1910,7 +2328,11 @@ 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, rho_ref_mks, scale=rho_scale) + if (rho_scale /= 1.0) then + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) + else + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, 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)) @@ -1969,7 +2391,11 @@ 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, rho_ref_mks, scale=rho_scale) + if (rho_scale /= 1.0) then + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) + else + call calculate_density(T5, S5, p5, r5, 1, 5, EOS, 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)) + & @@ -2016,7 +2442,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, rho_ref_mks, scale=rho_scale ) + if (rho_scale /= 1.0) then + call calculate_density( T_node, S_node, p_node, r_node, 1, 9, EOS, rho_ref_mks, scale=rho_scale ) + else + call calculate_density( T_node, S_node, p_node, r_node, 1, 9, EOS, rho_ref_mks) + endif r_node = r_node - rho_ref call compute_integral_quadratic( x, y, r_node, intx_dpa(i-ioff,j-joff) ) @@ -2231,9 +2661,9 @@ 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, & - bathyP, dP_neglect, useMassWghtInterp, SV_scale, pres_scale) +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, US) 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]. @@ -2271,10 +2701,7 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & !! 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]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine calculates analytical and nearly-analytical integrals in ! pressure across layers of geopotential anomalies, which are required for @@ -2301,6 +2728,8 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations [L2 T-2 ~> m2 s-2]. real :: RL2_T2_to_Pa ! A unit conversion factor from the rescaled units of pressure to Pa [Pa T2 R-1 L-2 ~> 1] + real :: SV_scale ! A multiplicative factor by which to scale specific + ! volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_90 = 1.0/90.0 ! A rational constant. integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, n, halo @@ -2311,8 +2740,9 @@ 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 - RL2_T2_to_Pa = 1.0 ; if (present(pres_scale)) RL2_T2_to_Pa = pres_scale - alpha_ref_mks = alpha_ref ; if (present(SV_scale)) alpha_ref_mks = alpha_ref / SV_scale + SV_scale = 1.0 ; if (present(US)) SV_scale = US%R_to_kg_m3 + RL2_T2_to_Pa = 1.0 ; if (present(US)) RL2_T2_to_Pa = US%RL2_T2_to_Pa + alpha_ref_mks = alpha_ref ; if (present(US)) alpha_ref_mks = alpha_ref * US%kg_m3_to_R do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then @@ -2329,7 +2759,12 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & T5(n) = T(i,j) ; S5(n) = S(i,j) p5(n) = RL2_T2_to_Pa * (p_b(i,j) - 0.25*real(n-1)*dp) enddo - call calculate_spec_vol(T5, S5, p5, a5, 1, 5, EOS, alpha_ref_mks, scale=SV_scale) + + 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)) @@ -2373,7 +2808,11 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & do n=2,5 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_mks, scale=SV_scale) + 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)) + & @@ -2416,7 +2855,11 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & do n=2,5 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_mks, scale=SV_scale) + 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)) + & @@ -2435,7 +2878,7 @@ end subroutine int_spec_vol_dp_generic !! no free assumptions, apart from the use of Bode's rule quadrature to do the integrals. subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, & dP_neglect, bathyP, HI, EOS, dza, & - intp_dza, intx_dza, inty_dza, useMassWghtInterp, SV_scale, pres_scale) + intp_dza, intx_dza, inty_dza, useMassWghtInterp, US) 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]. @@ -2476,10 +2919,7 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, !! 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. - 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]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine calculates analytical and nearly-analytical integrals in ! pressure across layers of geopotential anomalies, which are required for @@ -2513,6 +2953,8 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations [L2 T-2 ~> m2 s-2]. real :: RL2_T2_to_Pa ! A unit conversion factor from the rescaled units of pressure to Pa [Pa T2 R-1 L-2 ~> 1] + real :: SV_scale ! A multiplicative factor by which to scale specific + ! volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] real, parameter :: C1_90 = 1.0/90.0 ! A rational constant. logical :: do_massWeight ! Indicates whether to do mass weighting. integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n, pos @@ -2522,9 +2964,9 @@ 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 - RL2_T2_to_Pa = 1.0 ; if (present(pres_scale)) RL2_T2_to_Pa = pres_scale - alpha_ref_mks = alpha_ref ; if (present(SV_scale)) alpha_ref_mks = alpha_ref / SV_scale - + SV_scale = 1.0 ; if (present(US)) SV_scale = US%R_to_kg_m3 + RL2_T2_to_Pa = 1.0 ; if (present(US)) RL2_T2_to_Pa = US%RL2_T2_to_Pa + alpha_ref_mks = alpha_ref ; if (present(US)) alpha_ref_mks = alpha_ref * US%kg_m3_to_R do n = 1, 5 ! Note that these are reversed from int_density_dz. wt_t(n) = 0.25 * real(n-1) @@ -2541,7 +2983,11 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, 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_mks, scale=SV_scale) + 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)) @@ -2598,7 +3044,11 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, enddo enddo - call calculate_spec_vol(T15, S15, p15, a15, 1, 15, EOS, alpha_ref_mks, scale=SV_scale) + 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 @@ -2657,7 +3107,11 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, enddo enddo - call calculate_spec_vol(T15, S15, p15, a15, 1, 15, EOS, alpha_ref_mks, scale=SV_scale) + 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 From 2fc1c2e5a1d6c8e23c023065cff3973adb80b98b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Apr 2020 21:42:22 -0400 Subject: [PATCH 15/55] Use new HI_1d forms of calculate_density calls Revised numerous calls to calculate_density and calculate_density_derivs to use the new form with domain extents indicated by a hor_index_type argument. Internal density variables were also rescaled in a few cases. All answers are bitwise identical. --- src/core/MOM.F90 | 25 ++++++----- src/core/MOM_PressureForce_Montgomery.F90 | 3 -- src/core/MOM_PressureForce_blocked_AFV.F90 | 12 ++--- src/core/MOM_isopycnal_slopes.F90 | 10 ++--- src/ice_shelf/MOM_ice_shelf.F90 | 44 +++++++++---------- .../MOM_state_initialization.F90 | 5 +-- .../vertical/MOM_bulk_mixed_layer.F90 | 21 ++++----- .../vertical/MOM_diabatic_aux.F90 | 11 +++-- .../vertical/MOM_diabatic_driver.F90 | 11 +++-- .../vertical/MOM_entrain_diffusive.F90 | 23 +++++----- .../vertical/MOM_full_convection.F90 | 12 ++--- .../vertical/MOM_geothermal.F90 | 12 ++--- .../vertical/MOM_internal_tide_input.F90 | 4 +- .../vertical/MOM_regularize_layers.F90 | 10 ++--- .../vertical/MOM_set_diffusivity.F90 | 28 ++++++------ .../vertical/MOM_set_viscosity.F90 | 10 ++--- 16 files changed, 113 insertions(+), 128 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index fa952e1d92..0dc34fa670 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2685,11 +2685,11 @@ 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 [R L2 T-2 ~> 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 R L2 T-2 to m [m T2 R-1 L-2 ~> m Pa-1]. logical :: calc_rho @@ -2699,18 +2699,21 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), Rho_conv, G%HI, & + tv%eqn_of_state, US) + 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 = US%Z_to_m / (Rho_conv * GV%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 diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 1665e28def..3aeffb762f 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -766,9 +766,6 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) 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, G%HI, tv%eqn_of_state, US, halo=1) -! 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, pres_scale=US%RL2_T2_to_Pa) call calculate_density_derivs(T_int, S_int, p(:,j,k+1), dR_dT, dR_dS, G%HI, & tv%eqn_of_state, US, halo=1) do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index c532e17001..38d27b3563 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -301,8 +301,8 @@ 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, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), rho_in_situ, G%HI, & + tv%eqn_of_state, US, halo=1) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -586,11 +586,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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), rho_in_situ, G%HI, & + tv%eqn_of_state, US, halo=1) 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, G%HI, & + tv%eqn_of_state, US, halo=1) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index e5101d9937..00b5264251 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -175,9 +175,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, & - pres_scale=US%RL2_T2_to_Pa) + 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, pres_scale=US%RL2_T2_to_Pa) endif do I=is-1,ie @@ -262,9 +261,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, & - pres_scale=US%RL2_T2_to_Pa) + 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, pres_scale=US%RL2_T2_to_Pa) endif do i=is,ie if (use_EOS) then diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 298fbc4507..858af4e1ea 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -197,27 +197,27 @@ 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]. + !< 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)) :: & @@ -235,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 @@ -263,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] @@ -306,8 +306,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 @@ -375,10 +375,10 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) 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, pres_scale=US%RL2_T2_to_Pa) - call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, & - dR0_dT, dR0_dS, is, ie-is+1, CS%eqn_of_state, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(state%sst(:,j), state%sss(:,j), p_int, Rhoml(:), G%HI, & + CS%eqn_of_state, US) + call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, dR0_dT, dR0_dS, G%HI, & + CS%eqn_of_state, US) do i=is,ie if ((state%ocean_mass(i,j) > US%RZ_to_kg_m2*CS%col_mass_melt_threshold) .and. & diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index afadae1a1b..95faef5449 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -2185,7 +2185,7 @@ 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 + 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) @@ -2399,8 +2399,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) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 00686c2bbe..88c9e47ba4 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -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 @@ -376,7 +376,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Idt_diag = 1.0 / (dt__diag) write_diags = .true. ; if (present(last_call)) write_diags = last_call - p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref + p_ref(:) = 0.0 ; p_ref_cv(:) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref nsw = CS%nsw @@ -464,17 +464,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! Calculate an estimate of the mid-mixed layer pressure [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, G%HI, tv%eqn_of_state, US) + call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, G%HI, & + tv%eqn_of_state, US) 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), G%HI, tv%eqn_of_state, US) + call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), G%HI, tv%eqn_of_state, US) 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 1d079d451b..32a909fed4 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -408,11 +408,11 @@ 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 :: i, j, k, is, ie, js, je, nz, ks @@ -427,7 +427,7 @@ 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(:) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref brine_dz = 1.0*GV%m_to_H inject_layer(:,:) = nz @@ -447,8 +447,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), G%HI, tv%eqn_of_state, US) enddo ! First, try to find an interior layer where inserting all the salt @@ -459,7 +458,7 @@ subroutine insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS, dt, id_brine_lay) if ((G%mask2dT(i,j) > 0.0) .and. dzbr(i) < brine_dz .and. salt(i) > 0.) then s_new = S(i,k) + salt(i) / (GV%H_to_RZ * h_2d(i,k)) t0 = T(i,k) - call calculate_density(t0, s_new, tv%P_Ref, R_new, tv%eqn_of_state) + call calculate_density(t0, s_new, tv%P_Ref, R_new, tv%eqn_of_state, scale=US%kg_m3_to_R) if (R_new < 0.5*(Rcv(i,k)+Rcv(i,k+1)) .and. s_new Pa]. logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that @@ -2681,11 +2680,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_sponge) ! 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 + do i=is,ie ; p_ref_cv(i) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref ; enddo !$OMP parallel do default(shared) do j=js,je - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), G%HI, & + tv%eqn_of_state, US) enddo call apply_sponge(h, dt, G, GV, US, ea, eb, CS%sponge_CSp, Rcv_ml) else diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index e5366897e4..fe7fc57cb0 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -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]. @@ -243,7 +243,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & correct_density = (CS%correct_density .and. associated(tv%eqn_of_state)) if (correct_density) then - pres(:) = tv%P_Ref + pres(:) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref else pres(:) = 0.0 endif @@ -700,8 +700,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, G%HI, tv%eqn_of_state, US) 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 +783,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, G%HI, tv%eqn_of_state, US) 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 @@ -851,8 +849,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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T_eos, S_eos, pressure, dRho_dT, dRho_dS, G%HI, & + tv%eqn_of_state, US) 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)) :: & @@ -1084,10 +1082,9 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, max_ent = 1.0e4*GV%m_to_H h_neglect = GV%H_subroundoff - do i=is,ie ; pres(i) = tv%P_Ref ; enddo + do i=is,ie ; pres(i) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref ; enddo 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, G%HI, tv%eqn_of_state, US) 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 288fe01484..11baf7c59e 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -407,20 +407,20 @@ 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T_f(:,1), S_f(:,1), pres, dR_dT(:,1), dR_dS(:,1), G%HI, & + tv%eqn_of_state, US) 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T_EOS, S_EOS, pres, dR_dT(:,K), dR_dS(:,K), G%HI, & + tv%eqn_of_state, US) 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T_f(:,nz), S_f(:,nz), pres, dR_dT(:,nz+1), dR_dS(:,nz+1), G%HI, & + tv%eqn_of_state, US) end subroutine smoothed_dRdT_dRdS diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index e26e126db8..36231cd668 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] @@ -135,7 +135,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) Irho_cp = 1.0 / (GV%H_to_RZ * tv%C_p) Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff - p_ref(:) = tv%P_Ref + p_ref(:) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref Idt = 1.0 / dt if (.not.associated(tv%T)) call MOM_error(FATAL, "MOM geothermal: "//& @@ -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(:), isj, iej-isj+1, & + tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) else Rcv_BL(:) = -1.0 endif @@ -248,8 +248,8 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) Rcv, tv%eqn_of_state, scale=US%kg_m3_to_R) 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_, 1, 2, & + tv%eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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 6c366e5ff9..3ba5520117 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -209,8 +209,8 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(Temp_int, Salin_int, pres, dRho_dT(:), dRho_dS(:), G%HI, & + tv%eqn_of_state, US) 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) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index a4a4723092..7a77a13433 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -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, & @@ -240,7 +240,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) I_dtol = 1.0 / max(CS%h_def_tol2 - CS%h_def_tol1, 1e-40) I_dtol34 = 1.0 / max(CS%h_def_tol4 - CS%h_def_tol3, 1e-40) - p_ref_cv(:) = tv%P_Ref + p_ref_cv(:) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref do j=js-1,je+1 ; do i=is-1,ie+1 e(i,j,1) = 0.0 @@ -312,8 +312,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) 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, G%HI, tv%eqn_of_state, US) ! 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 +444,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), G%HI, tv%eqn_of_state, US) 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 9c47841748..38f4975a23 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -661,11 +661,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 @@ -712,13 +711,13 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! Determine kb - the index of the shallowest active interior layer. 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 + do i=is,ie ; p_0(i) = 0.0 ; p_ref(i) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref ; enddo 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), G%HI, & + tv%eqn_of_state, US) 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, G%HI, & + tv%eqn_of_state, US) kb_min = kmb+1 do i=is,ie @@ -906,8 +905,8 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(Temp_int, Salin_int, pres, dRho_dT(:,K), dRho_dS(:,K), G%HI, & + tv%eqn_of_state, US) 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) @@ -1794,7 +1793,7 @@ 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] @@ -1817,10 +1816,9 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) g_R0 = GV%g_Earth / (GV%Rho0) kmb = GV%nk_rho_varies eps = 0.1 - do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo + do i=is,ie ; p_ref(i) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref ; enddo 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), G%HI, tv%eqn_of_state, US) enddo do i=is,ie if (kb(i) <= nz-1) then diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 41fd8047dc..472c158f69 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -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]. @@ -312,11 +312,11 @@ 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 + do i=Isq,Ieq+1 ; p_ref(i) = US%kg_m3_to_R*US%m_s_to_L_T**2*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), G%HI, & + tv%eqn_of_state, US, halo=1) enddo ; enddo endif From 3223eb6bd5abb1eea2f59e29ee7193a13d91ec51 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 Apr 2020 07:57:09 -0400 Subject: [PATCH 16/55] +Rescaled the units of tv%P_Ref to [R L2 T-2] Rescaled the units of tv%P_Ref to [R L2 T-2] for expanded dimensional consistency testing. In some cases, other pressure variables were also rescaled and calls to calculate_density are recast into the simpler G%HI forms. All answers are bitwise identical, but the scaled units of an element of a transparent type were rescaled. --- src/core/MOM.F90 | 11 +++++---- src/core/MOM_PressureForce_Montgomery.F90 | 21 ++++++++-------- src/core/MOM_PressureForce_analytic_FV.F90 | 12 +++++----- src/core/MOM_PressureForce_blocked_AFV.F90 | 12 +++++----- src/core/MOM_variables.F90 | 2 +- src/diagnostics/MOM_diagnostics.F90 | 16 ++++++------- .../MOM_coord_initialization.F90 | 6 ++--- .../MOM_state_initialization.F90 | 24 +++++++++---------- .../vertical/MOM_bulk_mixed_layer.F90 | 2 +- .../vertical/MOM_diabatic_aux.F90 | 5 ++-- .../vertical/MOM_diabatic_driver.F90 | 2 +- .../vertical/MOM_entrain_diffusive.F90 | 4 ++-- .../vertical/MOM_geothermal.F90 | 4 ++-- .../vertical/MOM_regularize_layers.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 4 ++-- .../vertical/MOM_set_viscosity.F90 | 2 +- src/tracer/MOM_tracer_hor_diff.F90 | 6 ++--- src/user/DOME_initialization.F90 | 14 +++++++---- src/user/RGC_initialization.F90 | 5 ++-- src/user/user_change_diffusivity.F90 | 8 +++---- 20 files changed, 82 insertions(+), 80 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0dc34fa670..7cc28919f1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1805,7 +1805,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 "//& @@ -1820,8 +1821,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 "//& @@ -1832,8 +1833,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, & diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 3aeffb762f..b7291b71b2 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -106,7 +106,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb 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] @@ -227,8 +227,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(:), G%HI, & + tv%eqn_of_state, US, halo=1) 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) @@ -244,8 +244,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, G%HI, & + tv%eqn_of_state, US, halo=1) do i=Isq,Ieq+1 ; alpha_star(i,j,k) = 1.0 / rho_in_situ(i) ; enddo enddo ; enddo endif ! use_EOS @@ -394,7 +394,7 @@ 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). + ! 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 @@ -482,8 +482,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(:), G%HI, & + tv%eqn_of_state, US, halo=1) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -503,8 +503,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! will come down with a fatal error if there is any compressibility. !$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) + call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), G%HI, & + tv%eqn_of_state, US, halo=1) + do i=Isq,Ieq+1 ; rho_star(i,j,k) = G_Rho0*rho_star(i,j,k) ; enddo enddo ; enddo endif ! use_EOS diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 10842f9e7e..ca6f7ae283 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -157,7 +157,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & 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 [R L2 T-2 ~> Pa]. @@ -227,8 +227,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(:), G%HI, & + tv%eqn_of_state, US, halo=1) 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) @@ -489,7 +489,7 @@ 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). + ! density, [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m]. @@ -576,8 +576,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(:), G%HI, & + tv%eqn_of_state, US, halo=1) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 38d27b3563..9d1c12f381 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -155,7 +155,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & 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]. @@ -223,8 +223,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(:), G%HI, & + tv%eqn_of_state, US, halo=1) 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) @@ -473,7 +473,7 @@ 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). + ! density [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -563,8 +563,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(:), G%HI, & + tv%eqn_of_state, US, halo=1) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 09cbd14c60..52991a0278 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -80,7 +80,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/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 8c69853f3d..2aa0dee688 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -232,7 +232,7 @@ 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] or [Pa] real :: wt, wt_p real :: f2_h ! Squared Coriolis parameter at to h-points [T-2 ~> s-2] @@ -347,7 +347,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & do j=js,je if (associated(p_surf)) then ! Pressure loading at top of surface layer [R L2 T-2 ~> Pa] do i=is,ie - pressure_1d(i) = US%RL2_T2_to_Pa * p_surf(i,j) + pressure_1d(i) = p_surf(i,j) enddo else do i=is,ie @@ -356,16 +356,16 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & 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) + 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, G%HI, & + tv%eqn_of_state, US) 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) + pressure_1d(i) = pressure_1d(i) + 0.5*(GV%H_to_RZ*GV%g_Earth)*h(i,j,k) enddo enddo ! k enddo ! j @@ -465,8 +465,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = tv%P_Ref !$OMP parallel do default(shared) do k=1,nz ; do j=js-1,je+1 - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, & - Rcv(:,j,k), 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), G%HI, & + tv%eqn_of_state, US, halo=1) 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 diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 63461df157..d4afa115af 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -89,11 +89,11 @@ 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, US%RL2_T2_to_Pa*tv%P_Ref) case ("ts_profile") - call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, eos, US%RL2_T2_to_Pa*tv%P_Ref) case ("ts_range") - call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, eos, US%RL2_T2_to_Pa*tv%P_Ref) case ("file") call set_coord_from_file(GV%Rlay, GV%g_prime, GV, US, PF) case ("USER") diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 95faef5449..6339211d3e 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -291,9 +291,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("ISOMIP"); call ISOMIP_initialize_thickness(h, G, GV, US, PF, tv, & just_read_params=just_read) case ("benchmark"); call benchmark_initialize_thickness(h, G, GV, US, PF, & - tv%eqn_of_state, tv%P_Ref, just_read_params=just_read) + tv%eqn_of_state, US%RL2_T2_to_Pa*tv%P_Ref, just_read_params=just_read) case ("Neverland"); call Neverland_initialize_thickness(h, G, GV, US, PF, & - tv%eqn_of_state, tv%P_Ref) + tv%eqn_of_state, US%RL2_T2_to_Pa*tv%P_Ref) case ("search"); call initialize_thickness_search case ("circle_obcs"); call circle_obcs_initialize_thickness(h, G, GV, PF, & just_read_params=just_read) @@ -348,11 +348,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! " \t baroclinic_zone - an analytic baroclinic zone. \n"//& select case (trim(config)) case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, US, PF, & - eos, tv%P_Ref, just_read_params=just_read) + eos, US%RL2_T2_to_Pa*tv%P_Ref, just_read_params=just_read) case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, & PF, just_read_params=just_read) case ("benchmark"); call benchmark_init_temperature_salinity(tv%T, tv%S, & - G, GV, US, PF, eos, tv%P_Ref, just_read_params=just_read) + G, GV, US, PF, eos, US%RL2_T2_to_Pa*tv%P_Ref, just_read_params=just_read) case ("TS_profile") ; call initialize_temp_salt_from_profile(tv%T, tv%S, & G, PF, just_read_params=just_read) case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, PF, & @@ -1734,7 +1734,7 @@ 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 :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed @@ -1870,8 +1870,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, C 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), G%HI, tv%eqn_of_state, US) enddo call set_up_sponge_ML_density(tmp_2d, G, CSp) @@ -2016,7 +2015,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 +2184,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 + press(:) = US%RL2_T2_to_Pa*tv%P_Ref call convert_temp_salt_for_TEOS10(temp_z, salt_z, press, G, kd, mask_z, eos) + press(:) = tv%P_Ref 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), G%HI, eos, US) enddo ; enddo call pass_var(temp_z,G%Domain) @@ -2399,7 +2397,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), US%RL2_T2_to_Pa*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) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 88c9e47ba4..eae9c94f17 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -376,7 +376,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Idt_diag = 1.0 / (dt__diag) write_diags = .true. ; if (present(last_call)) write_diags = last_call - p_ref(:) = 0.0 ; p_ref_cv(:) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref + p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref nsw = CS%nsw diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 32a909fed4..c67fd65679 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -427,7 +427,7 @@ 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(:) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref + p_ref_cv(:) = tv%P_Ref brine_dz = 1.0*GV%m_to_H inject_layer(:,:) = nz @@ -458,7 +458,8 @@ subroutine insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS, dt, id_brine_lay) if ((G%mask2dT(i,j) > 0.0) .and. dzbr(i) < brine_dz .and. salt(i) > 0.) then s_new = S(i,k) + salt(i) / (GV%H_to_RZ * h_2d(i,k)) t0 = T(i,k) - call calculate_density(t0, s_new, tv%P_Ref, R_new, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(t0, s_new, tv%P_Ref, R_new, tv%eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) if (R_new < 0.5*(Rcv(i,k)+Rcv(i,k+1)) .and. s_new0) .and. .not.use_BBL_EOS) then - do i=Isq,Ieq+1 ; p_ref(i) = US%kg_m3_to_R*US%m_s_to_L_T**2*tv%P_Ref ; enddo + do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo !$OMP parallel do default(shared) 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), G%HI, & diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index d18bb3e330..93ca34257c 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -671,7 +671,7 @@ 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 :: k_max, k_min, k_test, itmp integer :: i, j, k, k2, m, is, ie, js, je, nz, nkmb @@ -698,8 +698,8 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & ! Determine which layers the mixed- and buffer-layers map into... !$OMP parallel do default(shared) do k=1,nkmb ; do j=js-2,je+2 - call calculate_density(tv%T(:,j,k),tv%S(:,j,k), p_ref_cv, & - rho_coord(:,j,k), 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), G%HI, & + tv%eqn_of_state, US, halo=2) enddo ; enddo do j=js-2,je+2 ; do i=is-2,ie+2 diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index f582ca0c7a..4dfa145746 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,17 @@ 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, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, tv%eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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, 1, nz, tv%eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, tv%eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) do k=1,nz ; T0(k) = T0(k) + (GV%Rlay(k)-rho_guess(k)) / drho_dT(k) ; enddo enddo diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index ae28bb36c6..6dbee6cea7 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -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. @@ -213,8 +213,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo do j=js,je - call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & - is, ie-is+1, tv%eqn_of_state, scale=US%kg_m3_to_R) + call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), G%HI, tv%eqn_of_state, US) enddo call set_up_sponge_ML_density(tmp, G, CSp) diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 86f3e6e99a..f33d772352 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -66,7 +66,7 @@ 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 @@ -107,13 +107,11 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i 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), G%HI, tv%eqn_of_state, US) 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), G%HI, tv%eqn_of_state, US) enddo endif From fb820c1e757f6b321eea1ff33c9e046c6be4602c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 Apr 2020 21:03:18 -0400 Subject: [PATCH 17/55] +Rescaled pressure arguments to multiple routines Rescaled the reference pressure arguments to 3 set_coord routines, 5 initialization routines, and kappa_shear_column. Also removed the unused pres argument to convert_temp_salt_for_TEOS10 and replaced its ocean_grid_type argument with a hor_index_type. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS.F90 | 27 +++++++------- .../MOM_coord_initialization.F90 | 37 ++++++++++--------- .../MOM_state_initialization.F90 | 35 ++++++++++-------- .../vertical/MOM_kappa_shear.F90 | 34 ++++++++--------- src/tracer/MOM_tracer_Z_init.F90 | 14 ++++--- src/user/Neverland_initialization.F90 | 2 +- src/user/benchmark_initialization.F90 | 35 +++++++++++------- 7 files changed, 101 insertions(+), 83 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index cfd286450e..fb2a1b1ca6 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -3129,19 +3129,16 @@ 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 real :: gsw_sr_from_sp, gsw_ct_from_pt, gsw_sa_from_sp @@ -3152,12 +3149,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 diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index d4afa115af..691ca4a60c 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -89,11 +89,11 @@ 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, US%RL2_T2_to_Pa*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, US%RL2_T2_to_Pa*tv%P_Ref) + call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) case ("ts_range") - call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, eos, US%RL2_T2_to_Pa*tv%P_Ref) + call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) case ("file") call set_coord_from_file(GV%Rlay, GV%g_prime, GV, US, PF) case ("USER") @@ -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 @@ -240,7 +240,8 @@ 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, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) ! 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 +250,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 +260,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]. @@ -289,16 +291,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, 1, nz, eqn_of_state, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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 +309,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 @@ -369,8 +371,9 @@ 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, k_light, nz-k_light+1, eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) ! 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) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 6339211d3e..d58a6b4704 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -291,9 +291,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("ISOMIP"); call ISOMIP_initialize_thickness(h, G, GV, US, PF, tv, & just_read_params=just_read) case ("benchmark"); call benchmark_initialize_thickness(h, G, GV, US, PF, & - tv%eqn_of_state, US%RL2_T2_to_Pa*tv%P_Ref, just_read_params=just_read) + tv%eqn_of_state, tv%P_Ref, just_read_params=just_read) case ("Neverland"); call Neverland_initialize_thickness(h, G, GV, US, PF, & - tv%eqn_of_state, US%RL2_T2_to_Pa*tv%P_Ref) + tv%eqn_of_state, tv%P_Ref) case ("search"); call initialize_thickness_search case ("circle_obcs"); call circle_obcs_initialize_thickness(h, G, GV, PF, & just_read_params=just_read) @@ -348,11 +348,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! " \t baroclinic_zone - an analytic baroclinic zone. \n"//& select case (trim(config)) case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, US, PF, & - eos, US%RL2_T2_to_Pa*tv%P_Ref, just_read_params=just_read) + eos, tv%P_Ref, just_read_params=just_read) case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, & PF, just_read_params=just_read) case ("benchmark"); call benchmark_init_temperature_salinity(tv%T, tv%S, & - G, GV, US, PF, eos, US%RL2_T2_to_Pa*tv%P_Ref, just_read_params=just_read) + G, GV, US, PF, eos, tv%P_Ref, just_read_params=just_read) case ("TS_profile") ; call initialize_temp_salt_from_profile(tv%T, tv%S, & G, PF, just_read_params=just_read) case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, PF, & @@ -1561,7 +1561,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 +1569,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 +1601,10 @@ 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, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) if (fit_salin) then ! A first guess of the layers' temperatures. @@ -1611,8 +1613,10 @@ 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, 1, nz, eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) do k=1,nz S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS(k)) enddo @@ -1623,8 +1627,10 @@ 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, 1, nz, eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -2185,8 +2191,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param allocate(frac_shelf_h(isd:ied,jsd:jed)) ! Convert T&S to Absolute Salinity and Conservative Temperature if using TEOS10 or NEMO - press(:) = US%RL2_T2_to_Pa*tv%P_Ref - 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 do k=1,kd ; do j=js,je @@ -2397,7 +2402,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), US%RL2_T2_to_Pa*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) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 6d773c67a0..781085e794 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -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]. @@ -283,7 +283,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & endif f2 = 0.25 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = US%RL2_T2_to_Pa*p_surf(i,j) + surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = p_surf(i,j) ! ---------------------------------------------------- I_Ld2_1d, dz_Int_1d @@ -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]. @@ -585,8 +585,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ endif f2 = G%CoriolisBu(I,J)**2 surface_pres = 0.0 ; if (associated(p_surf)) & - surface_pres = 0.25 * US%RL2_T2_to_Pa*((p_surf(i,j) + p_surf(i+1,j+1)) + & - (p_surf(i+1,j) + p_surf(i,j+1))) + surface_pres = 0.25 * ((p_surf(i,j) + p_surf(i+1,j+1)) + & + (p_surf(i+1,j) + p_surf(i,j+1))) ! ---------------------------------------------------- ! Set the initial guess for kappa, here defined at interfaces. @@ -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, 2, nzc-1, & + tv%eqn_of_state, scale=-g_R0*US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index aaa670070b..948705f4b3 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,10 @@ 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(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, & - eos, scale=US%kg_m3_to_R) + eos, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) enddo do k=k_start,nz ; do i=1,nx @@ -831,9 +832,10 @@ 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(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, & - eos, scale=US%kg_m3_to_R) + eos, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) 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/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/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 5641035ded..a173150b9d 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,10 @@ 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, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) ! A first guess of the layers' temperatures. do k=1,nz @@ -161,8 +164,10 @@ 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, 1, nz, eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -227,12 +232,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 +261,10 @@ 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, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) ! A first guess of the layers' temperatures. ! do k=1,nz @@ -266,8 +273,10 @@ 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,1,nz,eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, & + scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo From 6948cb7439fe78fba804271d800e5c1ca9538c09 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 12 Apr 2020 08:39:04 -0400 Subject: [PATCH 18/55] +Replaced optional pres_scale args with US args Replaced the remaining pres_scale arguments the various calculate_density and calc_spec_vol routines in MOM_EOS.F90 with new optional unit_scale_type arguments. When the scale and US arguments are present, density is scaled by the product of the indicated scaling factors. Calls to these routines in 11 files were modified accordingly. All answers are bitwise identical. --- src/core/MOM_isopycnal_slopes.F90 | 4 +- src/equation_of_state/MOM_EOS.F90 | 309 +++++++++--------- .../MOM_coord_initialization.F90 | 8 +- .../MOM_state_initialization.F90 | 18 +- .../vertical/MOM_diabatic_aux.F90 | 3 +- .../vertical/MOM_diabatic_driver.F90 | 1 - .../vertical/MOM_geothermal.F90 | 6 +- .../vertical/MOM_kappa_shear.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 4 +- src/tracer/MOM_tracer_Z_init.F90 | 10 +- src/user/DOME_initialization.F90 | 12 +- src/user/benchmark_initialization.F90 | 24 +- 12 files changed, 195 insertions(+), 206 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 00b5264251..78fdc51077 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -176,7 +176,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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, pres_scale=US%RL2_T2_to_Pa) + tv%eqn_of_state, US=US) endif do I=is-1,ie @@ -262,7 +262,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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, pres_scale=US%RL2_T2_to_Pa) + tv%eqn_of_state, US=US) endif do i=is,ie if (use_EOS) then diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index fb2a1b1ca6..2c518f5af1 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -140,24 +140,27 @@ 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. -subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale, pres_scale) +!! 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, US, 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 [other ~> 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + 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. if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -175,15 +178,17 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale, pr 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 + if (present(US) .or. present(scale)) then + rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + if (present(scale)) rho_scale = rho_scale * scale + rho = rho_scale * rho + endif end subroutine calculate_density_scalar !> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. -subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref, scale, pres_scale) +subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref, US, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [other ~> Pa] @@ -191,19 +196,20 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + !! in combination with scaling given by US [various] - real :: p_scale ! A factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa. + real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_array called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -240,16 +246,18 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re end select endif - if (present(scale)) then ; if (scale /= 1.0) then - do j=start,start+npts-1 ; rho(j) = scale * rho(j) ; enddo - endif ; endif + rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + if (present(scale)) rho_scale = rho_scale * scale + if (rho_scale /= 1.0) then + do j=start,start+npts-1 ; rho(j) = rho_scale * rho(j) ; enddo + endif end subroutine calculate_density_array !> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs !! using array extents determined from a hor_index_type. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. -subroutine calculate_density_HI_1d(T, S, pressure, rho, HI, EOS, US, halo, rho_ref) +subroutine calculate_density_HI_1d(T, S, pressure, rho, HI, EOS, US, halo) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] @@ -258,11 +266,9 @@ subroutine calculate_density_HI_1d(T, S, pressure, rho, HI, EOS, US, halo, rho_r type(EOS_type), pointer :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. - real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables real, dimension(HI%isd:HI%ied) :: pres ! Pressure converted to [Pa] - real :: rho_reference ! rho_ref converted to [kg m-3] integer :: i, is, ie, start, npts, halo_sz if (.not.associated(EOS)) call MOM_error(FATAL, & @@ -278,38 +284,19 @@ subroutine calculate_density_HI_1d(T, S, pressure, rho, HI, EOS, US, halo, rho_r 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_HI_1d: EOS%form_of_EOS is not valid.") - end select - 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo - rho_reference = 0.0 ; if (present(rho_ref)) rho_reference = US%R_to_kg_m3*rho_ref - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_linear(T, S, pres, rho, start, npts, & - EOS%Rho_T0_S0-rho_reference, EOS%dRho_dT, EOS%dRho_dS) + EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) case (EOS_UNESCO) - call calculate_density_unesco(T, S, pres, rho, start, npts, rho_reference) + call calculate_density_unesco(T, S, pressure, rho, start, npts) case (EOS_WRIGHT) - call calculate_density_wright(T, S, pres, rho, start, npts, rho_reference) + call calculate_density_wright(T, S, pressure, rho, start, npts) case (EOS_TEOS10) - call calculate_density_teos10(T, S, pres, rho, start, npts, rho_reference) + call calculate_density_teos10(T, S, pressure, rho, start, npts) case (EOS_NEMO) - call calculate_density_nemo(T, S, pres, rho, start, npts, rho_reference) + call calculate_density_nemo(T, S, pressure, rho, start, npts) case default call MOM_error(FATAL, "calculate_density_HI_1d: EOS%form_of_EOS is not valid.") end select - 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. + else ! There is rescaling of variables, including pressure. do i=is,ie ; pres(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -336,24 +323,25 @@ end subroutine calculate_density_HI_1d !> 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, pres_scale) +subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, US, 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) :: 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]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + !! volume in combination with scaling given by US [various] real :: p_scale ! A factor to convert pressure to units of Pa. - real :: rho + real :: rho ! Density [kg m-3] + 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, & "calculate_spec_vol_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -376,36 +364,39 @@ subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scal call MOM_error(FATAL, "calculate_spec_vol_scalar: EOS is not valid.") end select - if (present(scale)) then ; if (scale /= 1.0) then - specvol = scale * specvol - endif ; endif + spv_scale = 1.0 ; if (present(US)) spv_scale = US%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 calculate_spec_vol_scalar !> 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, pres_scale) +subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, spv_ref, US, 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(in) :: pressure !< pressure [Pa] or [R L2 T-2 ~> Pa]. real, dimension(:), intent(inout) :: specvol !< in situ specific volume [kg m-3] or [R-1 ~> m3 kg-1]. 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific + !! volume in combination with scaling given by US [various] - real :: p_scale ! A factor to convert pressure to units of Pa. real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] - real, dimension(size(specvol)) :: rho + real, dimension(size(specvol)) :: rho ! Density [kg m-3] + real :: p_scale ! A factor to convert pressure to units of Pa. + real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_spec_vol_array called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -452,9 +443,11 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s end select endif - if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 - specvol(j) = scale * specvol(j) - enddo ; endif ; endif + spv_scale = 1.0 ; if (present(US)) spv_scale = US%R_to_kg_m3 + if (present(scale)) spv_scale = spv_scale * scale + if (spv_scale /= 1.0) then ; do j=start,start+npts-1 + specvol(j) = spv_scale * specvol(j) + enddo ; endif end subroutine calculate_spec_vol_array @@ -635,10 +628,10 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca end subroutine calculate_TFreeze_array !> Calls the appropriate subroutine to calculate density derivatives for 1-D array inputs. -subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS, scale, pres_scale) +subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS, US, 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]. real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity, @@ -646,19 +639,20 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + 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. integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -695,10 +689,12 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star end select endif - if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 - drho_dT(j) = scale * drho_dT(j) - drho_dS(j) = scale * drho_dS(j) - enddo ; endif ; endif + rho_scale = 1.0 ; if (present(US)) rho_scale = US%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_dT(j) = rho_scale * drho_dT(j) + drho_dS(j) = rho_scale * drho_dS(j) + enddo ; endif end subroutine calculate_density_derivs_array @@ -719,7 +715,6 @@ subroutine calculate_density_derivs_HI_1d(T, S, pressure, drho_dT, drho_dS, HI, ! Local variables real, dimension(HI%isd:HI%ied) :: pres ! Pressure converted to [Pa] - real :: rho_reference ! rho_ref converted to [kg m-3] integer :: i, is, ie, start, npts, halo_sz if (.not.associated(EOS)) call MOM_error(FATAL, & @@ -776,25 +771,28 @@ end subroutine calculate_density_derivs_HI_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, pres_scale) +subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS, US, 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 - 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + type(EOS_type), pointer :: EOS !< Equation of state structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + !! in combination with scaling given by US [various] + ! Local variables + real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa. + integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -808,19 +806,21 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS 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 = 1.0 ; if (present(US)) rho_scale = US%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 !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs. subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & - drho_dS_dP, drho_dT_dP, start, npts, EOS, scale, pres_scale) + drho_dS_dP, drho_dT_dP, start, npts, EOS, US, 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 @@ -832,21 +832,23 @@ 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] - real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + integer, intent(in) :: npts !< The number of values to calculate + type(EOS_type), pointer :: EOS !< Equation of state structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + 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. 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. real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa. integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -879,13 +881,15 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh 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 = 1.0 ; if (present(US)) rho_scale = US%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 @@ -899,7 +903,7 @@ end subroutine calculate_density_second_derivs_array !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & - drho_dS_dP, drho_dT_dP, EOS, scale, pres_scale) + drho_dS_dP, drho_dT_dP, EOS, US, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] @@ -914,17 +918,18 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] 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) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + 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. + 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. real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa. if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -940,13 +945,15 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr 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 = 1.0 ; if (present(US)) rho_scale = US%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 @@ -957,10 +964,10 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr end subroutine calculate_density_second_derivs_scalar !> Calls the appropriate subroutine to calculate specific volume derivatives for an array. -subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS, scale, pres_scale) +subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS, US, 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) :: 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] real, dimension(:), intent(inout) :: dSV_dS !< The partial derivative of specific volume with salinity @@ -968,22 +975,23 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start 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] - real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + 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(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] - real :: p_scale ! A factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa. + real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_spec_vol_derivs_array called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -1040,10 +1048,12 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start end select endif - 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 + spv_scale = 1.0 ; if (present(US)) spv_scale = US%R_to_kg_m3 + if (present(scale)) spv_scale = spv_scale * scale + if (spv_scale /= 1.0) then ; do j=start,start+npts-1 + dSV_dT(j) = spv_scale * dSV_dT(j) + dSV_dS(j) = spv_scale * dSV_dS(j) + enddo ; endif end subroutine calculate_spec_vol_derivs_array @@ -1195,6 +1205,8 @@ 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 !! integrals in pressure across layers of geopotential anomalies, which are !! required for calculating the finite-volume form pressure accelerations in a @@ -1658,9 +1670,9 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, p5(n) = -GxRho*(z_t(i,j) - 0.25*real(n-1)*dz) enddo if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) + 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_mks) + 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. @@ -1704,9 +1716,9 @@ 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 if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) + 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_mks) + 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. @@ -1750,9 +1762,9 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, p5(n) = p5(n-1) + GxRho*0.25*dz enddo if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) + 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_mks) + 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. @@ -1893,9 +1905,9 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & enddo enddo if (rho_scale /= 1.0) then - call calculate_density_array(T5, S5, p5, r5, 1, (ieq-isq+2)*5, EOS, rho_ref_mks, scale=rho_scale) + 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_mks) + 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 @@ -1977,9 +1989,9 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & enddo if (rho_scale /= 1.0) then - call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, rho_ref_mks, scale=rho_scale) + 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_mks) + 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 @@ -2061,10 +2073,11 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, 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_mks, scale=rho_scale) + 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_mks) + 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) @@ -2329,9 +2342,9 @@ subroutine int_density_dz_generic_ppm(T, T_t, T_b, S, S_t, S_b, & enddo if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) + 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_mks) + 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. @@ -2392,9 +2405,9 @@ subroutine int_density_dz_generic_ppm(T, T_t, T_b, S, S_t, S_b, & enddo if (rho_scale /= 1.0) then - call calculate_density(T5, S5, p5, r5, 1, 5, EOS, rho_ref_mks, scale=rho_scale) + 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_mks) + 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. @@ -2443,9 +2456,9 @@ subroutine int_density_dz_generic_ppm(T, T_t, T_b, S, S_t, S_b, & S_node(7) = 0.5 * ( S_node(3) + S_node(4) ) if (rho_scale /= 1.0) then - call calculate_density( T_node, S_node, p_node, r_node, 1, 9, EOS, rho_ref_mks, scale=rho_scale ) + 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_mks) + 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 diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 691ca4a60c..b0155ae603 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -240,8 +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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state, US=US) ! These statements set the layer densities. ! do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo @@ -292,7 +291,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s ! 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0, S0, Pref, Rlay, 1, nz, eqn_of_state, US=US) do k=2,nz; g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) ; enddo call callTree_leave(trim(mdl)//'()') @@ -372,8 +371,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta 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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0, S0, Pref, Rlay, k_light, nz-k_light+1, eqn_of_state, US=US) ! 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) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index d58a6b4704..a9ba5eee85 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1601,10 +1601,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, pres_scale=US%RL2_T2_to_Pa) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, eqn_of_state, & - scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0(1), S0(1), pres(1), rho_guess(1), eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, eqn_of_state, US=US) if (fit_salin) then ! A first guess of the layers' temperatures. @@ -1613,10 +1611,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, pres_scale=US%RL2_T2_to_Pa) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, & - scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) do k=1,nz S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS(k)) enddo @@ -1627,10 +1623,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, pres_scale=US%RL2_T2_to_Pa) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, & - scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index c67fd65679..55667085ea 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -458,8 +458,7 @@ subroutine insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS, dt, id_brine_lay) if ((G%mask2dT(i,j) > 0.0) .and. dzbr(i) < brine_dz .and. salt(i) > 0.) then s_new = S(i,k) + salt(i) / (GV%H_to_RZ * h_2d(i,k)) t0 = T(i,k) - call calculate_density(t0, s_new, tv%P_Ref, R_new, tv%eqn_of_state, & - scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(t0, s_new, tv%P_Ref, R_new, tv%eqn_of_state, US=US) if (R_new < 0.5*(Rcv(i,k)+Rcv(i,k+1)) .and. s_new 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, pres_scale=US%RL2_T2_to_Pa) + tv%eqn_of_state, US=US) 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, pres_scale=US%RL2_T2_to_Pa) + Rcv, tv%eqn_of_state, US=US) 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, pres_scale=US%RL2_T2_to_Pa) + tv%eqn_of_state, US=US) dRcv_dT = 0.5*(dRcv_dT_(1) + dRcv_dT_(2)) endif diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 781085e794..5e11ecee60 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -911,7 +911,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & 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, pres_scale=US%RL2_T2_to_Pa) + tv%eqn_of_state, US=US, scale=-g_R0) else do K=1,nzc+1 ; dbuoy_dT(K) = -g_R0 ; dbuoy_dS(K) = 0.0 ; enddo endif diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index e8bdc25ba4..da3adc1ac5 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1397,7 +1397,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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, pres_scale=US%RL2_T2_to_PA) + Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state, US=US) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1634,7 +1634,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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, pres_scale=US%RL2_T2_to_PA) + is-G%IsdB+1, ie-is+1, tv%eqn_of_state, US=US) endif do i=is,ie ; if (do_i(i)) then diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 948705f4b3..76ca2dac4a 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -801,10 +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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos, US=US) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, & - eos, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + eos, US=US) enddo do k=k_start,nz ; do i=1,nx @@ -832,10 +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, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos, US=US) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, & - eos, scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + eos, US=US) 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/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 4dfa145746..315e56051c 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -359,17 +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, pres_scale=US%RL2_T2_to_Pa) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, tv%eqn_of_state, & - scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0(1), S0(1), pres(1), rho_guess(1), tv%eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, tv%eqn_of_state, US=US) 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, pres_scale=US%RL2_T2_to_Pa) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, tv%eqn_of_state, & - scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, tv%eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, tv%eqn_of_state, US=US) do k=1,nz ; T0(k) = T0(k) + (GV%Rlay(k)-rho_guess(k)) / drho_dT(k) ; enddo enddo diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index a173150b9d..766474b364 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -152,10 +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, pres_scale=US%RL2_T2_to_Pa) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, & - scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, US=US) ! A first guess of the layers' temperatures. do k=1,nz @@ -164,10 +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, pres_scale=US%RL2_T2_to_Pa) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, & - scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -261,10 +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, pres_scale=US%RL2_T2_to_Pa) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, & - scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, US=US) ! A first guess of the layers' temperatures. ! do k=1,nz @@ -273,10 +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, pres_scale=US%RL2_T2_to_Pa) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state, & - scale=US%kg_m3_to_R, pres_scale=US%RL2_T2_to_Pa) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo From 1e8c50166b6185f65c9ffcbbe58720add0c8bf19 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Apr 2020 06:44:28 -0400 Subject: [PATCH 19/55] Corrected pressure units in comments Corrected pressure unit documentation in comments in 5 files. Also fixed punctuation in comments in MOM_EOS.F90. All answers are bitwise identical. --- src/core/MOM_PressureForce_analytic_FV.F90 | 4 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 6 +- src/equation_of_state/MOM_EOS.F90 | 340 +++++++++--------- .../vertical/MOM_bulk_mixed_layer.F90 | 2 +- .../vertical/MOM_vert_friction.F90 | 4 +- 5 files changed, 178 insertions(+), 178 deletions(-) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index ca6f7ae283..4f85980f00 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -172,7 +172,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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-12 ~> H Pa-1]. + 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 @@ -490,7 +490,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). - real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. + 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 :: I_Rho0 ! The inverse of the Boussinesq reference density [R-1 ~> m3 kg-1]. diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 9d1c12f381..d618060951 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -158,7 +158,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, ! 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]. + ! 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 [R-1 ~> 3 kg-1]. @@ -169,7 +169,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, 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-12 ~> H Pa-1]. + 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 @@ -474,7 +474,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). - real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. + 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 ! The inverse of the Boussinesq reference density [R-1 ~> m3 kg-1]. diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 2c518f5af1..e4da6df2bc 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -102,14 +102,14 @@ 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] ! logical :: test_EOS = .true. ! If true, test the equation of state end type EOS_type @@ -149,13 +149,13 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, US, scale 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) :: rho_ref !< A reference density [kg m-3] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type 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. + 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.") @@ -191,17 +191,17 @@ end subroutine calculate_density_scalar subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref, US, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [other ~> 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) :: rho_ref !< A reference density [kg m-3] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] - real :: p_scale ! A factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] integer :: j @@ -329,12 +329,12 @@ subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, US, 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]. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] - real :: p_scale ! A factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: rho ! Density [kg m-3] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] @@ -375,21 +375,21 @@ end subroutine calculate_spec_vol_scalar !> 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, US, 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] or [R L2 T-2 ~> 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] or [R L2 T-2 ~> Pa] + real, dimension(:), intent(inout) :: specvol !< in situ specific volume [kg m-3] or [R-1 ~> m3 kg-1] 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) :: spv_ref !< A reference specific volume [m3 kg-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type 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(pressure)) :: pres ! Pressure converted to [Pa] real, dimension(size(specvol)) :: rho ! Density [kg m-3] - real :: p_scale ! A factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] integer :: j @@ -462,7 +462,7 @@ subroutine calculate_spec_vol_HI_1d(T, S, pressure, specvol, HI, EOS, US, halo, type(EOS_type), pointer :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. - real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1]. + real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1] ! Local variables real, dimension(HI%isd:HI%ied) :: pres ! Pressure converted to [Pa] @@ -549,11 +549,11 @@ end subroutine calculate_spec_vol_HI_1d !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs. subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) real, intent(in) :: S !< Salinity [ppt] - real, intent(in) :: pressure !< Pressure [Pa] + 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. + 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. @@ -580,7 +580,7 @@ end subroutine calculate_TFreeze_scalar !> Calls the appropriate subroutine to calculate the freezing point for a 1-D array. subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_scale) real, dimension(:), intent(in) :: S !< Salinity [ppt] - real, dimension(:), intent(in) :: pressure !< Pressure [Pa] + 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 @@ -633,9 +633,9 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star real, dimension(:), intent(in) :: S !< Salinity [ppt] 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 @@ -646,7 +646,7 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star ! 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. + 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, & @@ -778,7 +778,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS 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]. + !! in [kg m-3 ppt-1] or [R ppt-1 ~> kg m-3 ppt-1] type(EOS_type), pointer :: EOS !< Equation of state structure type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density @@ -786,7 +786,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS ! 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. + 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, & @@ -841,8 +841,8 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh ! 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. - real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] + real :: 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, & @@ -906,7 +906,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr drho_dS_dP, drho_dT_dP, EOS, US, 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 @@ -923,8 +923,8 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr !! 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. - real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] + real :: 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.") @@ -971,7 +971,7 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start 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] 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] or [R-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 @@ -984,7 +984,7 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start 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] - real :: p_scale ! A factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] integer :: j @@ -1066,7 +1066,7 @@ subroutine calculate_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, E real, dimension(HI%isd:HI%ied), intent(inout) :: dSV_dT !< The partial derivative of specific volume with potential !! temperature [R-1 degC-1 ~> m3 kg-1 degC-1] real, dimension(HI%isd:HI%ied), intent(inout) :: dSV_dS !< The partial derivative of specific volume with salinity - !! [R-1 ppt-1 ~> m3 kg-1 ppt-1]. + !! [R-1 ppt-1 ~> m3 kg-1 ppt-1] type(EOS_type), pointer :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. @@ -1156,9 +1156,9 @@ subroutine calculate_compress_array(T, S, pressure, rho, drho_dp, start, npts, E 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(inout) :: rho !< In situ density [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] 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 @@ -1192,7 +1192,7 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) real, intent(in) :: pressure !< Pressure [Pa] real, intent(out) :: rho !< In situ density [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]. + !! (also the inverse of the square of sound speed) [s2 m-2] type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa @@ -1222,29 +1222,29 @@ 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 [R L2 T-2 ~> Pa] or [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 [R L2 T-2 ~> Pa] or [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 [R-1 ~> m3 kg-1]. + !! 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 [T-2 ~> m2 s-2] or [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 [R L4 T-4 ~> Pa m2 s-2] or [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 [L2 T-2 ~> m2 s-2] or [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 [L2 T-2 ~> m2 s-2] or [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 [R L2 T-2 ~> Pa] or [Pa] @@ -1308,9 +1308,9 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dp 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]. + 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. @@ -1318,34 +1318,34 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dp !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration - !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2] 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 [R L2 T-2 ~> Pa] or [Pa]. + !! 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 [R L2 Z T-2 ~> 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 !! the pressure anomaly at the top and bottom of the - !! layer divided by the x grid spacing [R L2 T-2 ~> 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 [R L2 T-2 ~> 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. type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! 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]. + ! 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.") @@ -1509,11 +1509,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 @@ -1577,13 +1577,13 @@ 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]. + 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. @@ -1591,26 +1591,26 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration - !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2] 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 [R L2 T-2 ~> Pa] or [Pa]. + !! 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 [R L2 Z T-2 ~> 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 !! the pressure anomaly at the top and bottom of the - !! layer divided by the x grid spacing [R L2 T-2 ~> 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 [R L2 T-2 ~> 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. type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type @@ -1619,23 +1619,23 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, 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 :: 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 ! 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 :: 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 [R L2 T-2 ~> Pa] or [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 @@ -1794,32 +1794,32 @@ 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 [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]. + 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, 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 [R L2 T-2 ~> 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 [R L2 Z T-2 ~> 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 [R L2 T-2 ~> 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 [R L2 T-2 ~> 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. type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type @@ -1836,37 +1836,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 :: 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]. + ! 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]. + ! 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]. + ! [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 [R L2 T-2 ~> Pa] or [Pa]. - real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim]. + ! 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. - 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]. + 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 @@ -2108,16 +2108,16 @@ 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) :: 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] 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) :: 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 @@ -2185,7 +2185,7 @@ 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) :: rho_ref !< A mean density [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) :: pos !< The fractional vertical position, 0 to 1 [nondim] type(EOS_type), pointer :: EOS !< Equation of state structure ! Local variables real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. @@ -2235,9 +2235,9 @@ 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]. + 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 @@ -2245,19 +2245,19 @@ subroutine int_density_dz_generic_ppm(T, T_t, T_b, S, S_t, S_b, & 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] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine calculates (by numerical quadrature) integrals of @@ -2278,9 +2278,9 @@ subroutine int_density_dz_generic_ppm(T, T_t, T_b, S, S_t, S_b, & 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 :: w_left, w_right ! Left and right weights [nondim] real :: intz(5) ! The gravitational acceleration times the integrals of density - ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] or [Pa]. + ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] or [Pa] real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho ! The gravitational acceleration times density and unit conversion factors [Pa Z-1 ~> kg m-2 s-2] real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] or [m3 kg-1] @@ -2679,34 +2679,34 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, dza, & bathyP, dP_neglect, useMassWghtInterp, US) 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 [R L2 T-2 ~> Pa] or [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 [R L2 T-2 ~> Pa] or [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]. + !! 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 [L2 T-2 ~> m2 s-2] or [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 [R L4 T-4 ~> Pa m2 s-2] or [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 [L2 T-2 ~> m2 s-2] or [m2 s-2]. + !! 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 [L2 T-2 ~> m2 s-2] or [m2 s-2]. + !! 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 [R L2 T-2 ~> Pa] or [Pa] @@ -2728,18 +2728,18 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, dza, & 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_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 :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2] + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim] + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim] + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim] + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim] real :: intp(5) ! The integrals of specific volume with pressure at the - ! 5 sub-column locations [L2 T-2 ~> m2 s-2]. + ! 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] @@ -2894,19 +2894,19 @@ 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, US) 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 [R L2 T-2 ~> Pa] or [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 [R L2 T-2 ~> Pa] or [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]. + !! 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. @@ -2917,19 +2917,19 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, 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 [L2 T-2 ~> 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 [R L4 T-4 ~> Pa m2 s-2] or [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 [L2 T-2 ~> m2 s-2] or [m2 s-2]. + !! 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 [L2 T-2 ~> m2 s-2] or [m2 s-2]. + !! 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. type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type @@ -2952,19 +2952,19 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, 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 [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_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 :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2] + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim] + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim] + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim] + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim] real :: intp(5) ! The integrals of specific volume with pressure at the - ! 5 sub-column locations [L2 T-2 ~> m2 s-2]. + ! 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] @@ -3189,11 +3189,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/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index eae9c94f17..cc3a6e3f69 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -461,7 +461,7 @@ 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_RZ*GV%g_Earth)*h(i,k) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 5a610095ce..3635f71209 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 From 8df34f4e2fd33988aa120c4c7bce41ef3ab0eed4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Apr 2020 06:56:38 -0400 Subject: [PATCH 20/55] Rescaled internal MOM_diapyc_energy_req variables Rescaled internal pressure, specific volume and energy variables in MOM_diapyc_energy_req.F90. This file is mostly used for testing, and all answers are bitwise identical. --- .../vertical/MOM_diapyc_energy_req.F90 | 125 +++++++++--------- 1 file changed, 66 insertions(+), 59 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index fd8d19aa61..cde4b9e484 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, 1, nz, tv%eqn_of_state, US=US) 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) @@ -940,7 +939,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & N2(1) = 0.0 ; N2(nz+1) = 0.0 do K=2,nz call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), & - pres(K), rho_here, tv%eqn_of_state) + pres(K), rho_here, tv%eqn_of_state, US=US) N2(K) = ((US%L_to_Z**2*GV%g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) @@ -951,7 +950,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & N2(1) = 0.0 ; N2(nz+1) = 0.0 do K=2,nz call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), & - pres(K), rho_here, tv%eqn_of_state) + pres(K), rho_here, tv%eqn_of_state, US=US) N2(K) = ((US%L_to_Z**2*GV%g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) @@ -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, & From 500c9e3134eba614eb3acb1a25982b2e89045705 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Apr 2020 07:06:12 -0400 Subject: [PATCH 21/55] Rescaled pressures in 17 calculate_density calls Rescaled pressures in 17 calculate_density or related calls and internal pressure variables in MOM_diabatic_aux. All answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 19 +++----- .../lateral/MOM_mixed_layer_restrat.F90 | 19 ++++---- .../lateral/MOM_thickness_diffuse.F90 | 24 +++++----- .../vertical/MOM_diabatic_aux.F90 | 45 ++++++++----------- .../vertical/MOM_set_diffusivity.F90 | 10 ++--- .../vertical/MOM_set_viscosity.F90 | 18 ++++---- 6 files changed, 62 insertions(+), 73 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 80753e0614..652ca5278c 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -851,10 +851,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,& @@ -891,7 +888,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 @@ -899,7 +896,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 @@ -917,10 +914,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 @@ -931,7 +926,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) @@ -942,8 +937,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, G%HI, & + tv%eqn_of_state, US) ! 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 diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index c535cc9334..744a801391 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -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] @@ -176,7 +176,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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] @@ -206,8 +207,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var pRef_MLD(:) = 0. 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, G%HI, & + tv%eqn_of_state, US, halo=1) deltaRhoAtK(:) = 0. MLD_fast(:,j) = 0. do k = 2, nz @@ -215,8 +216,8 @@ 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, G%HI, & + tv%eqn_of_state, US, halo=1) do i = is-1,ie+1 deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface enddo @@ -321,7 +322,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(:), G%HI, tv%eqn_of_state, US, halo=1) line_is_empty = .true. do i=is-1,ie+1 if (htot_fast(i,j) < MLD_fast(i,j)) then @@ -585,7 +586,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] @@ -645,7 +646,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(:), G%HI, tv%eqn_of_state, US, halo=1) 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 4da62ed5df..453a71467b 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -594,7 +594,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] @@ -607,11 +607,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]. @@ -720,7 +720,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 @@ -729,7 +729,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 @@ -778,7 +778,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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) + drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state, US=US) endif do I=is-1,ie @@ -1028,8 +1028,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, G%HI, & + tv%eqn_of_state, US) endif do i=is,ie if (calc_derivatives) then @@ -1260,8 +1260,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, & + (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state, US=US) endif do I=is-1,ie uhD(I,j,1) = -uhtot(I,j) @@ -1290,8 +1290,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, G%HI, & + tv%eqn_of_state, US) endif do i=is,ie vhD(i,J,1) = -vhtot(i,J) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 55667085ea..4150c82828 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -518,9 +518,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]. @@ -737,7 +737,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]. @@ -767,8 +767,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, pRef_MLD(:) = 0.0 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, G%HI, tv%eqn_of_state, US) do i=is,ie deltaRhoAtK(i) = 0. MLD(i,j) = 0. @@ -809,8 +808,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, G%HI, tv%eqn_of_state, US) do i = is, ie deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface ddRho = deltaRhoAtK(i) - deltaRhoAtKm1(i) @@ -827,16 +825,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, G%HI, tv%eqn_of_state, US) + call calculate_density(T_deeper, S_deeper, pRef_N2, rho_deeper, G%HI, tv%eqn_of_state, US) 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 @@ -897,9 +893,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 @@ -909,7 +905,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] @@ -942,7 +938,6 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t logical :: calculate_energetics logical :: calculate_buoyancy 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 @@ -960,10 +955,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then - SurfPressure(:) = 0.0 + 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 @@ -991,7 +984,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 @@ -1006,15 +999,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) + dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state, US=US) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo enddo pen_TKE_2d(:,:) = 0.0 @@ -1355,8 +1348,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, G%HI, & + tv%eqn_of_state, US) ! 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_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 03fa62f2f9..b3eeac08c9 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1036,7 +1036,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] @@ -1054,18 +1054,18 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) 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 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, G%HI, & + tv%eqn_of_state, US) do i=is,ie alpha_dT = -1.0*dRho_dT(i) * (T_f(i,j,k-1) - T_f(i,j,k)) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index da3adc1ac5..f7ae639fa0 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]. @@ -566,14 +566,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) + is-G%IsdB+1, ie-is+1, tv%eqn_of_state, US=US) endif do i=is,ie ; if (do_i(i)) then @@ -1086,7 +1086,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)) :: & @@ -1269,14 +1269,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) + Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state, US=US) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1506,14 +1506,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) + is-G%IsdB+1, ie-is+1, tv%eqn_of_state, US=US) endif do i=is,ie ; if (do_i(i)) then From 00db8d5fbb03ac91437b78195a7e862e276ddd8f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Apr 2020 08:16:25 -0400 Subject: [PATCH 22/55] Corrected a bug in calculate_spec_vol_derivs_H1_1d Corrected a rescaling bug in calculate_spec_vol_derivs_H1_1d, but as this code was not yet being exercised, there are no answer changes. Also modified applyBoundaryFluxesInOut to use this fixed routine. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS.F90 | 62 ++----------------- .../vertical/MOM_diabatic_aux.F90 | 4 +- 2 files changed, 7 insertions(+), 59 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index e4da6df2bc..9e66248cb3 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1072,11 +1072,7 @@ subroutine calculate_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, E integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. ! Local variables - real, dimension(HI%isd:HI%ied) :: rho ! In situ density [kg m-3] - real, dimension(HI%isd:HI%ied) :: dRho_dT ! Derivative of density with temperature [kg m-3 degC-1] - real, dimension(HI%isd:HI%ied) :: dRho_dS ! Derivative of density with salinity [kg m-3 ppt-1] real, dimension(HI%isd:HI%ied) :: press ! Pressure converted to [Pa] - real :: rho_reference ! rho_ref converted to [kg m-3] integer :: i, is, ie, start, npts, halo_sz if (.not.associated(EOS)) call MOM_error(FATAL, & @@ -1089,63 +1085,15 @@ subroutine calculate_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, E is = HI%isc - halo_sz ; ie = HI%iec + halo_sz if (US%RL2_T2_to_Pa == 1.0) then - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & - npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) - case (EOS_UNESCO) - call calculate_density_unesco(T, S, pressure, rho, start, npts) - call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) - do i=is,ie - dSV_dT(i) = -dRho_DT(i)/(rho(i)**2) - dSV_dS(i) = -dRho_DS(i)/(rho(i)**2) - enddo - case (EOS_WRIGHT) - call calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) - case (EOS_TEOS10) - call calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start, npts) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho, start, npts) - call calculate_density_derivs_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) - do i=is,ie - dSV_dT(i) = -dRho_DT(i)/(rho(i)**2) - dSV_dS(i) = -dRho_DS(i)/(rho(i)**2) - enddo - case default - call MOM_error(FATAL, "calculate_spec_vol_derivs_HI_1d: EOS%form_of_EOS is not valid.") - end select + call calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS) else do i=is,ie ; press(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_specvol_derivs_linear(T, S, press, dSV_dT, dSV_dS, start, & - npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) - case (EOS_UNESCO) - call calculate_density_unesco(T, S, press, rho, start, npts) - call calculate_density_derivs_unesco(T, S, press, drho_dT, drho_dS, start, npts) - do i=is,ie - dSV_dT(i) = -dRho_DT(i)/(rho(i)**2) - dSV_dS(i) = -dRho_DS(i)/(rho(i)**2) - enddo - case (EOS_WRIGHT) - call calculate_specvol_derivs_wright(T, S, press, dSV_dT, dSV_dS, start, npts) - case (EOS_TEOS10) - call calculate_specvol_derivs_teos10(T, S, press, dSV_dT, dSV_dS, start, npts) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho, start, npts) - call calculate_density_derivs_nemo(T, S, press, drho_dT, drho_dS, start, npts) - do i=is,ie - dSV_dT(i) = -dRho_DT(i)/(rho(i)**2) - dSV_dS(i) = -dRho_DS(i)/(rho(i)**2) - enddo - case default - call MOM_error(FATAL, "calculate_spec_vol_derivs_HI_1d: EOS%form_of_EOS is not valid.") - end select + call calculate_spec_vol_derivs_array(T, S, press, dSV_dT, dSV_dS, start, npts, EOS) endif if (US%R_to_kg_m3 /= 1.0) then ; do i=is,ie - drho_dT(i) = US%R_to_kg_m3 * drho_dT(i) - drho_dS(i) = US%R_to_kg_m3 * drho_dS(i) + dSV_dT(i) = US%R_to_kg_m3 * dSV_dT(i) + dSV_dS(i) = US%R_to_kg_m3 * dSV_dS(i) enddo ; endif end subroutine calculate_spec_vol_derivs_HI_1d @@ -1207,7 +1155,7 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) end subroutine calculate_compress_scalar -!> Calls the appropriate subroutine to alculate analytical and nearly-analytical +!> 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 diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 4150c82828..dc8bbc2409 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1006,8 +1006,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t 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, US=US) + call calculate_specific_vol_derivs(T2d(:,k), tv%S(:,j,k), p_lay(:), & + dSV_dT(:,j,k), dSV_dS(:,j,k), G%HI, tv%eqn_of_state, US=US) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo enddo pen_TKE_2d(:,:) = 0.0 From 2a951e7b7ec5bda1a3e3241e79e44c2d77d85d09 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Apr 2020 11:57:16 -0400 Subject: [PATCH 23/55] Redirected various EOS interfaces to common code Redirected complicated equation of state routines to all work via the same 1-d array versions of the code. This shortens the MOM_EOS.F90 code even as new routines are added under the same overloaded interfaces. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS.F90 | 434 ++++++++++++------------------ 1 file changed, 165 insertions(+), 269 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 9e66248cb3..82f59ca012 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -64,7 +64,7 @@ module MOM_EOS !> 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, calculate_spec_vol_HI_1d + module procedure calc_spec_vol_scalar, calculate_spec_vol_array, calc_spec_vol_HI_1d, calc_spec_vol_US end interface calculate_spec_vol !> Calculate the derivatives of density with temperature and salinity from T, S, and P @@ -74,7 +74,7 @@ module MOM_EOS end interface calculate_density_derivs interface calculate_specific_vol_derivs - module procedure calculate_spec_vol_derivs_array, calculate_spec_vol_derivs_HI_1d + module procedure calculate_spec_vol_derivs_array, calc_spec_vol_derivs_US, calc_spec_vol_derivs_HI_1d end interface calculate_specific_vol_derivs !> Calculates the second derivatives of density with various combinations of temperature, @@ -280,39 +280,11 @@ subroutine calculate_density_HI_1d(T, S, pressure, rho, HI, EOS, US, halo) npts = HI%iec - HI%isc + 1 + 2*halo_sz is = HI%isc - halo_sz ; ie = HI%iec + halo_sz - if ((US%RL2_T2_to_Pa == 1.0) .and. (US%R_to_kg_M3 == 1.0)) then - 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) - case (EOS_UNESCO) - call calculate_density_unesco(T, S, pressure, rho, start, npts) - case (EOS_WRIGHT) - call calculate_density_wright(T, S, pressure, rho, start, npts) - case (EOS_TEOS10) - call calculate_density_teos10(T, S, pressure, rho, start, npts) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho, start, npts) - case default - call MOM_error(FATAL, "calculate_density_HI_1d: EOS%form_of_EOS is not valid.") - end select + if (US%RL2_T2_to_Pa == 1.0) then + call calculate_density_array(T, S, pressure, rho, start, npts, EOS) else ! There is rescaling of variables, including pressure. do i=is,ie ; pres(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_linear(T, S, pres, rho, start, npts, & - EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) - case (EOS_UNESCO) - call calculate_density_unesco(T, S, pres, rho, start, npts) - case (EOS_WRIGHT) - call calculate_density_wright(T, S, pres, rho, start, npts) - case (EOS_TEOS10) - call calculate_density_teos10(T, S, pres, rho, start, npts) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pres, rho, start, npts) - case default - call MOM_error(FATAL, "calculate_density_HI_1d: EOS%form_of_EOS is not valid.") - end select + call calculate_density_array(T, S, pres, rho, start, npts, EOS) endif if (US%kg_m3_to_R /= 1.0) then ; do i=is,ie @@ -321,48 +293,83 @@ subroutine calculate_density_HI_1d(T, S, pressure, rho, HI, EOS, US, halo) end subroutine calculate_density_HI_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] + 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 in combination with scaling given by US [various] + + real, dimension(size(specvol)) :: rho ! Density [kg m-3] + integer :: j + + if (.not.associated(EOS)) call MOM_error(FATAL, & + "calculate_spec_vol_array 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, start, npts, & + EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) + case (EOS_UNESCO) + call calculate_spec_vol_unesco(T, S, pressure, specvol, start, npts, spv_ref) + case (EOS_WRIGHT) + call calculate_spec_vol_wright(T, S, pressure, specvol, start, npts, spv_ref) + 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) + 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.") + 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 + +end subroutine calculate_spec_vol_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, US, scale) +subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, US, 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] + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] or [R-1 m3 kg-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - real :: rho ! Density [kg m-3] + 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, & - "calculate_spec_vol_scalar called with an unassociated EOS_type EOS.") + "calc_spec_vol_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + pres(1) = pressure ; if (present(US)) pres(1) = US%RL2_T2_to_Pa*pressure + Ta(1) = T ; Sa(1) = S - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_spec_vol_linear(T, S, p_scale*pressure, specvol, & - EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) - case (EOS_UNESCO) - call calculate_spec_vol_unesco(T, S, p_scale*pressure, specvol, spv_ref) - case (EOS_WRIGHT) - call calculate_spec_vol_wright(T, S, p_scale*pressure, specvol, spv_ref) - case (EOS_TEOS10) - call calculate_spec_vol_teos10(T, S, p_scale*pressure, specvol, spv_ref) - case (EOS_NEMO) - call calculate_density_nemo(T, S, p_scale*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(spv_ref)) then + spv_reference = spv_ref ; if (present(US)) spv_reference = US%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 = 1.0 ; if (present(US)) spv_scale = US%R_to_kg_m3 if (present(scale)) spv_scale = spv_scale * scale @@ -370,11 +377,11 @@ subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, US, specvol = spv_scale * specvol endif -end subroutine calculate_spec_vol_scalar +end subroutine calc_spec_vol_scalar !> 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, US, scale) +!! for 1-D array inputs with dimensional rescaling. +subroutine calc_spec_vol_US(T, S, pressure, specvol, start, npts, EOS, US, 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] or [R L2 T-2 ~> Pa] @@ -382,78 +389,45 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type 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(pressure)) :: pres ! Pressure converted to [Pa] - real, dimension(size(specvol)) :: rho ! Density [kg m-3] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] + 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] - integer :: j + integer :: i, is, ie if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_spec_vol_array called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + is = start ; ie = is + npts - 1 - if (p_scale == 1.0) then - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_spec_vol_linear(T, S, pressure, specvol, start, npts, & - EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) - case (EOS_UNESCO) - call calculate_spec_vol_unesco(T, S, pressure, specvol, start, npts, spv_ref) - case (EOS_WRIGHT) - call calculate_spec_vol_wright(T, S, pressure, specvol, start, npts, spv_ref) - 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) - 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.") - 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_spec_vol_linear(T, S, pres, specvol, start, npts, & - EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) - case (EOS_UNESCO) - call calculate_spec_vol_unesco(T, S, pres, specvol, start, npts, spv_ref) - case (EOS_WRIGHT) - call calculate_spec_vol_wright(T, S, pres, specvol, start, npts, spv_ref) - case (EOS_TEOS10) - call calculate_spec_vol_teos10(T, S, pres, specvol, start, npts, spv_ref) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pres, 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.") - end select + if ((US%RL2_T2_to_Pa == 1.0) .and. (US%R_to_kg_m3 == 1.0)) then + call calculate_spec_vol_array(T, S, pressure, specvol, start, 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo + spv_reference = US%kg_m3_to_R*spv_ref + call calculate_spec_vol_array(T, S, pres, specvol, start, 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo + call calculate_spec_vol_array(T, S, pres, specvol, start, npts, EOS) endif - spv_scale = 1.0 ; if (present(US)) spv_scale = US%R_to_kg_m3 + spv_scale = US%R_to_kg_m3 if (present(scale)) spv_scale = spv_scale * scale - if (spv_scale /= 1.0) then ; do j=start,start+npts-1 - specvol(j) = spv_scale * specvol(j) + if (spv_scale /= 1.0) then ; do i=is,ie + specvol(i) = spv_scale * specvol(i) enddo ; endif -end subroutine calculate_spec_vol_array +end subroutine calc_spec_vol_US + !> Calls the appropriate subroutine to calculate the specific volume of sea water for 1-D array !! inputs using array extents determined from a hor_index_type. -subroutine calculate_spec_vol_HI_1d(T, S, pressure, specvol, HI, EOS, US, halo, spv_ref) +subroutine calc_spec_vol_HI_1d(T, S, pressure, specvol, HI, EOS, US, halo, spv_ref) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] @@ -466,12 +440,11 @@ subroutine calculate_spec_vol_HI_1d(T, S, pressure, specvol, HI, EOS, US, halo, ! Local variables real, dimension(HI%isd:HI%ied) :: pres ! Pressure converted to [Pa] - real, dimension(HI%isd:HI%ied) :: rho ! Density [kg m-3] real :: spv_reference ! spv_ref converted to [m3 kg-1] integer :: i, is, ie, start, npts, halo_sz if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_HI_1d called with an unassociated EOS_type EOS.") + "calc_spec_vol_HI_1d called with an unassociated EOS_type EOS.") halo_sz = 0 ; if (present(halo)) halo_sz = halo @@ -480,71 +453,22 @@ subroutine calculate_spec_vol_HI_1d(T, S, pressure, specvol, HI, EOS, US, halo, is = HI%isc - halo_sz ; ie = HI%iec + halo_sz if ((US%RL2_T2_to_Pa == 1.0) .and. (US%R_to_kg_m3 == 1.0)) then - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_spec_vol_linear(T, S, pressure, specvol, start, npts, & - EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_ref) - case (EOS_UNESCO) - call calculate_spec_vol_unesco(T, S, pressure, specvol, start, npts, spv_ref) - case (EOS_WRIGHT) - call calculate_spec_vol_wright(T, S, pressure, specvol, start, npts, spv_ref) - 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) - 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_HI_1d: EOS%form_of_EOS is not valid.") - end select + call calculate_spec_vol_array(T, S, pressure, specvol, start, 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo spv_reference = US%kg_m3_to_R*spv_ref - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_spec_vol_linear(T, S, pres, specvol, start, npts, & - EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS, spv_reference) - case (EOS_UNESCO) - call calculate_spec_vol_unesco(T, S, pres, specvol, start, npts, spv_reference) - case (EOS_WRIGHT) - call calculate_spec_vol_wright(T, S, pres, specvol, start, npts, spv_reference) - case (EOS_TEOS10) - call calculate_spec_vol_teos10(T, S, pres, specvol, start, npts, spv_reference) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pres, rho, start, npts) - specvol = 1.0 / rho - spv_reference - case default - call MOM_error(FATAL, "calculate_spec_vol_HI_1d: EOS%form_of_EOS is not valid.") - end select + call calculate_spec_vol_array(T, S, pres, specvol, start, 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_spec_vol_linear(T, S, pres, specvol, start, npts, & - EOS%rho_T0_S0, EOS%drho_dT, EOS%drho_dS) - case (EOS_UNESCO) - call calculate_spec_vol_unesco(T, S, pres, specvol, start, npts) - case (EOS_WRIGHT) - call calculate_spec_vol_wright(T, S, pres, specvol, start, npts) - case (EOS_TEOS10) - call calculate_spec_vol_teos10(T, S, pres, specvol, start, npts) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pres, rho, start, npts) - do i=is,ie ; specvol(i) = 1.0 / rho(i) ; enddo - case default - call MOM_error(FATAL, "calculate_spec_vol_HI_1d: EOS%form_of_EOS is not valid.") - end select + call calculate_spec_vol_array(T, S, pres, specvol, start, npts, EOS) endif if (US%R_to_kg_m3 /= 1.0) then ; do i=is,ie specvol(i) = US%R_to_kg_m3 * specvol(i) enddo ; endif -end subroutine calculate_spec_vol_HI_1d +end subroutine calc_spec_vol_HI_1d !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs. subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) @@ -727,38 +651,10 @@ subroutine calculate_density_derivs_HI_1d(T, S, pressure, drho_dT, drho_dS, HI, is = HI%isc - halo_sz ; ie = HI%iec + halo_sz if (US%RL2_T2_to_Pa == 1.0) then - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & - EOS%dRho_dT, EOS%dRho_dS, start, npts) - case (EOS_UNESCO) - call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) - case (EOS_WRIGHT) - call calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS, start, npts) - case (EOS_TEOS10) - call calculate_density_derivs_teos10(T, S, pressure, drho_dT, drho_dS, start, npts) - 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_HI_1d: EOS%form_of_EOS is not valid.") - end select + call calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS) else do i=is,ie ; pres(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_derivs_linear(T, S, pres, drho_dT, drho_dS, EOS%Rho_T0_S0, & - EOS%dRho_dT, EOS%dRho_dS, start, npts) - case (EOS_UNESCO) - call calculate_density_derivs_unesco(T, S, pres, drho_dT, drho_dS, start, npts) - case (EOS_WRIGHT) - call calculate_density_derivs_wright(T, S, pres, drho_dT, drho_dS, start, npts) - case (EOS_TEOS10) - call calculate_density_derivs_teos10(T, S, pres, drho_dT, drho_dS, start, npts) - case (EOS_NEMO) - call calculate_density_derivs_nemo(T, S, pres, drho_dT, drho_dS, start, npts) - case default - call MOM_error(FATAL, "calculate_density_derivs_HI_1d: EOS%form_of_EOS is not valid.") - end select + call calculate_density_derivs_array(T, S, pres, drho_dT, drho_dS, start, npts, EOS) endif if (US%kg_m3_to_R /= 1.0) then ; do i=is,ie @@ -964,101 +860,101 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr end subroutine calculate_density_second_derivs_scalar !> Calls the appropriate subroutine to calculate specific volume derivatives for an array. -subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS, US, 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] or [R L2 T-2 ~> Pa] + 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 - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type - 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(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] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_spec_vol_derivs_array called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & + npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) + case (EOS_UNESCO) + call calculate_density_unesco(T, S, pressure, rho, start, npts) + call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) + do j=start,start+npts-1 + dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) + dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) + enddo + case (EOS_WRIGHT) + call calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) + case (EOS_TEOS10) + call calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start, npts) + case (EOS_NEMO) + call calculate_density_nemo(T, S, pressure, rho, start, npts) + call calculate_density_derivs_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) + do j=start,start+npts-1 + dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) + dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) + enddo + case default + call MOM_error(FATAL, "calculate_spec_vol_derivs_array: EOS%form_of_EOS is not valid.") + end select - if (p_scale == 1.0) then - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & - npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) - case (EOS_UNESCO) - call calculate_density_unesco(T, S, pressure, rho, start, npts) - call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) - do j=start,start+npts-1 - dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) - dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) - enddo - case (EOS_WRIGHT) - call calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) - case (EOS_TEOS10) - call calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start, npts) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho, start, npts) - call calculate_density_derivs_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) - do j=start,start+npts-1 - dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) - dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) - enddo - case default - call MOM_error(FATAL, "calculate_spec_vol_derivs_array: EOS%form_of_EOS is not valid.") - end select +end subroutine calculate_spec_vol_derivs_array + + +!> Calls the appropriate subroutine to calculate specific volume derivatives for an array with unit scaling. +subroutine calc_spec_vol_derivs_US(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS, US, 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] + 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + 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(T)) :: 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] + integer :: i, is, ie + + if (.not.associated(EOS)) call MOM_error(FATAL, & + "calculate_spec_vol_derivs_array called with an unassociated EOS_type EOS.") + + is = start ; ie = is + npts - 1 + + if (US%RL2_T2_to_Pa == 1.0) then + call calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS) else - do j=start,start+npts-1 ; press(j) = p_scale * pressure(j) ; enddo - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_specvol_derivs_linear(T, S, press, dSV_dT, dSV_dS, start, & - npts, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS) - case (EOS_UNESCO) - call calculate_density_unesco(T, S, press, rho, start, npts) - call calculate_density_derivs_unesco(T, S, press, drho_dT, drho_dS, start, npts) - do j=start,start+npts-1 - dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) - dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) - enddo - case (EOS_WRIGHT) - call calculate_specvol_derivs_wright(T, S, press, dSV_dT, dSV_dS, start, npts) - case (EOS_TEOS10) - call calculate_specvol_derivs_teos10(T, S, press, dSV_dT, dSV_dS, start, npts) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pressure, rho, start, npts) - call calculate_density_derivs_nemo(T, S, press, drho_dT, drho_dS, start, npts) - do j=start,start+npts-1 - dSV_dT(j) = -dRho_DT(j)/(rho(j)**2) - dSV_dS(j) = -dRho_DS(j)/(rho(j)**2) - enddo - case default - call MOM_error(FATAL, "calculate_spec_vol_derivs_array: EOS%form_of_EOS is not valid.") - end select + do i=is,ie ; press(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo + call calculate_spec_vol_derivs_array(T, S, press, dSV_dT, dSV_dS, start, npts, EOS) endif - spv_scale = 1.0 ; if (present(US)) spv_scale = US%R_to_kg_m3 + spv_scale = US%R_to_kg_m3 if (present(scale)) spv_scale = spv_scale * scale - if (spv_scale /= 1.0) then ; do j=start,start+npts-1 - dSV_dT(j) = spv_scale * dSV_dT(j) - dSV_dS(j) = spv_scale * dSV_dS(j) + 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_spec_vol_derivs_array +end subroutine calc_spec_vol_derivs_US !> Calls the appropriate subroutine to calculate specific volume derivatives for an array. -subroutine calculate_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, EOS, US, halo) +subroutine calc_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, EOS, US, halo) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] @@ -1096,7 +992,7 @@ subroutine calculate_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, E dSV_dS(i) = US%R_to_kg_m3 * dSV_dS(i) enddo ; endif -end subroutine calculate_spec_vol_derivs_HI_1d +end subroutine calc_spec_vol_derivs_HI_1d !> Calls the appropriate subroutine to calculate the density and compressibility for 1-D array inputs. From 04fcfd4567cc5307eca96ba8421c29d1c873c18d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Apr 2020 09:50:55 -0400 Subject: [PATCH 24/55] +Rescaled args to find_depth_of_pressure_in_cell Rescaled the units of the pressure, density, and gravitational acceleration arguments to find_depth_of_pressure_in_cell, frac_dp_at_pos, trim_for_ice and cut_off_column_top for dimensional consistency testing and code simplification. One change corrected an omitted scaling factor when the optional z_tol argument is omitted, but this does not impact any solutions as this argument is present in all active cases. Also cleaned up some bizarre error messages starting with 'Blurgh!', which is apparently an artificial expletive invented to circumvent censors, but has now been censored and replaced with a more informative message. All answers are bitwise identical, but the units of some arguments have changed and there are new unit_scale_type arguments to some routines. --- src/equation_of_state/MOM_EOS.F90 | 64 +++++++++------ .../MOM_state_initialization.F90 | 77 +++++++++++-------- 2 files changed, 83 insertions(+), 58 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 82f59ca012..c1fd5fd42f 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1947,29 +1947,34 @@ end subroutine int_density_dz_generic_plm !> Find the depth at which the reconstructed pressure matches P_tgt subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_tgt, & - rho_ref, G_e, EOS, P_b, z_out, z_tol) + rho_ref, G_e, EOS, US, P_b, z_out, z_tol) real, intent(in) :: T_t !< Potential temperatue at the cell top [degC] 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) :: 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] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + 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 ! Anomalous pressure difference across whole cell - dp = frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, 1.0, EOS) + dp = frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, 1.0, EOS, US) P_b = P_t + dp ! Anomalous pressure at bottom of cell @@ -1987,31 +1992,32 @@ 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*US%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 ) z_out = z_t + ( z_b - z_t ) * F_guess - 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 ) + Pa = frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, F_guess, EOS, US) - ( 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 @@ -2019,22 +2025,30 @@ end subroutine find_depth_of_pressure_in_cell !> Returns change in anomalous pressure change from top to non-dimensional !! position pos between z_t and z_b -real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EOS) +real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EOS, US) real, intent(in) :: T_t !< Potential temperatue at the cell top [degC] 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 !< 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) :: 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + 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 @@ -2046,10 +2060,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_array(T5, S5, p5, rho5, 1, 5, EOS, US=US) 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 diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index a9ba5eee85..3cdcb5bcfd 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1094,12 +1094,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 +1113,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 +1140,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 +1160,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 +1176,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 +1186,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 +1198,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 +1218,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, US, & P_b, z_out, z_tol=z_tol) if (z_out>=e(K)) then ! Imposed pressure was less that pressure at top of cell @@ -2417,51 +2419,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), & - rho(k), tv%eqn_of_state) - P_tot = P_tot + GV%mks_g_Earth * rho(k) * h(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, US=US) + 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, US, 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 From b72afce2b01521950630393e75340f795fee6b9f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Apr 2020 16:44:14 -0400 Subject: [PATCH 25/55] +Made arguments to unit_scaling_init optional Made both arguments to unit_scaling_init optional to enable the use of this routine to initialize unscaled unit_scale_types for certain types of unit testing. All answers are bitwise identical. --- src/framework/MOM_unit_scaling.F90 | 31 ++++++++++++++++++------------ 1 file changed, 19 insertions(+), 12 deletions(-) diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index 7ef0486c0e..ffd2452c19 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -54,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). @@ -66,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 "//& "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 "//& "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 "//& "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 "//& "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 "//& - "internal units of heat content. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + "internal units of heat content. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) + 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: "//& From a7836f0a7cec7bc36b8e79095cde743114d89147 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Apr 2020 16:45:24 -0400 Subject: [PATCH 26/55] +Rescaled variables in MOM_neutral_diffusion.F90 Rescaled pressure and density variables in MOM_neutral_diffusion and added numerous comments describing internal variables and their units. Some unused variables were deleted, including unused pressure arguments to find_neutral_pos_linear. In addition unit_scale_type arguments were added to 8 subroutines, including neutral_diffusion_init and tracer_hor_diff_init. All answers are bitwise identical, but there are changes to public interfaces. --- src/tracer/MOM_neutral_diffusion.F90 | 661 ++++++++++++++------------- src/tracer/MOM_tracer_hor_diff.F90 | 6 +- 2 files changed, 347 insertions(+), 320 deletions(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 26873900cc..0f025c3d39 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -19,7 +19,7 @@ module MOM_neutral_diffusion use MOM_remapping, only : extract_member_remapping_CS, build_reconstructions_1d use MOM_remapping, only : average_value_ppoly, remappingSchemesDoc, remappingDefaultScheme use MOM_tracer_registry, only : tracer_registry_type, tracer_type -use MOM_unit_scaling, only : unit_scale_type +use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init use MOM_verticalGrid, only : verticalGrid_type use polynomial_functions, only : evaluation_polynomial, first_derivative_polynomial use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation @@ -45,9 +45,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 @@ -69,17 +70,17 @@ 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 type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -91,7 +92,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 @@ -108,9 +108,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 @@ -154,9 +155,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.) @@ -203,7 +204,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.", & @@ -287,7 +288,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) 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 @@ -295,9 +296,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. @@ -340,10 +341,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 @@ -351,11 +353,11 @@ 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 @@ -386,27 +388,25 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) 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) + CS%dRdT(:,j,k), CS%dRdS(:,j,k), G%isc-1, G%iec-G%isc+3, CS%EOS, US) 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 + CS%dRdT_i(:,j,k,1), CS%dRdS_i(:,j,k,1), G%isc-1, G%iec-G%isc+3, CS%EOS, US) + if (CS%ref_pres<0) ref_pres(:) = CS%Pint(:,j,k+1) ! 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) + CS%dRdT_i(:,j,k,2), CS%dRdS_i(:,j,k,2), G%isc-1, G%iec-G%isc+3, CS%EOS, US) enddo endif enddo if (.not. CS%continuous_reconstruction) then do j = G%jsc-1, G%jec+1 ; do i = G%isc-1, G%iec+1 - call mark_unstable_cells( CS, G%ke, CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%P_i(i,j,:,:), CS%stable_cell(i,j,:) ) + call mark_unstable_cells( CS, G%ke, CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%P_i(i,j,:,:), US, CS%stable_cell(i,j,:) ) if (CS%interior_only) then if (.not. CS%stable_cell(i,j,k_bot(i,j))) zeta_bot(i,j) = -1. ! set values in the surface and bottom boundary layer to false. @@ -438,7 +438,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, US, 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,:,:), & @@ -456,10 +456,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, US, 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,:,:), & @@ -472,8 +472,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 @@ -906,23 +906,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) @@ -933,14 +934,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 @@ -1003,7 +1005,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 @@ -1032,11 +1034,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) @@ -1046,7 +1048,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 @@ -1108,21 +1110,25 @@ 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(0,*) 'dRhoNeg, Pneg, dRhoPos, Ppos=',dRhoNeg, Pneg, dRhoPos, Ppos + character(len=120) :: mesg + + if (Ppos < Pneg) then + call MOM_error(FATAL, 'interpolate_for_nondim_position: Houston, we have a problem! PposdRhoPos) 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 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 @@ -1140,42 +1146,46 @@ 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, US, 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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 @@ -1194,17 +1204,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 @@ -1272,11 +1278,11 @@ 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, US, & + 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(*,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",dRho, & + if (CS%debug) write(*,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",US%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 @@ -1300,7 +1306,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hcol_l, ! Position of the right interface is known and all quantities are fixed PoR(k_surface) = ki_right - 1. KoR(k_surface) = kl_right - PoL(k_surface) = search_other_column(CS, k_surface, lastP_left, & + PoL(k_surface) = search_other_column(CS, US, k_surface, lastP_left, & Tr(kl_right, ki_right), Sr(kl_right, ki_right), Pres_r(kl_right, ki_right), & Tl(kl_left,1), Sl(kl_left,1), Pres_l(kl_left,1), & Tl(kl_left,2), Sl(kl_left,2), Pres_l(kl_left,2), & @@ -1323,7 +1329,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hcol_l, ! Position of the right interface is known and all quantities are fixed PoL(k_surface) = ki_left - 1. KoL(k_surface) = kl_left - PoR(k_surface) = search_other_column(CS, k_surface, lastP_right, & + PoR(k_surface) = search_other_column(CS, US, k_surface, lastP_right, & Tl(kl_left, ki_left), Sl(kl_left, ki_left), Pres_l(kl_left, ki_left), & Tr(kl_right,1), Sr(kl_right,1), Pres_r(kl_right,1), & Tr(kl_right,2), Sr(kl_right,2), Pres_r(kl_right,2), & @@ -1365,15 +1371,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. @@ -1383,56 +1389,59 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hcol_l, end subroutine find_neutral_surface_positions_discontinuous !> Sweep down through the column and mark as stable if the bottom interface of a cell is denser than the top -subroutine mark_unstable_cells(CS, nk, T, S, P, stable_cell) +subroutine mark_unstable_cells(CS, nk, T, S, P, US, 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] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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, US, 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, & +real function search_other_column(CS, US, 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) type(neutral_diffusion_CS), intent(in ) :: CS !< Neutral diffusion control structure + type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type 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) + call calc_delta_rho_and_derivs(CS, US, T_top, S_top, P_top, T_from, S_from, P_from, dRhoTop) + call calc_delta_rho_and_derivs(CS, US, 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, US, 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, US, T_bot, S_bot, P_bot, T_from, S_from, P_from, dRhoBot, & dRdT_bot, dRdS_bot, dRdT_from, dRdS_from) endif @@ -1461,11 +1470,10 @@ 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) + pos = find_neutral_pos_full( CS, US, pos_last, T_from, S_from, P_from, P_top, P_bot, T_poly, S_poly) endif end function search_other_column @@ -1505,43 +1513,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) @@ -1551,14 +1568,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 @@ -1581,14 +1595,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 @@ -1604,7 +1611,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] @@ -1626,43 +1634,48 @@ 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, US, 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + 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 Tb = evaluation_polynomial( ppoly_T, nterm, b ) Sb = evaluation_polynomial( ppoly_S, nterm, b ) Pb = P_top*(1.-b) + P_bot*b - call calc_delta_rho_and_derivs(CS, Tb, Sb, Pb, T_ref, S_ref, P_ref, drho_b) + call calc_delta_rho_and_derivs(CS, US, Tb, Sb, Pb, T_ref, S_ref, P_ref, drho_b) ! Calculate drho at the maximum bound Tc = evaluation_polynomial( ppoly_T, nterm, 1. ) Sc = evaluation_polynomial( ppoly_S, nterm, 1. ) Pc = P_Bot - call calc_delta_rho_and_derivs(CS, Tc, Sc, Pc, T_ref, S_ref, P_ref, drho_c) + call calc_delta_rho_and_derivs(CS, US, Tc, Sc, Pc, T_ref, S_ref, P_ref, drho_c) if (drho_b >= 0.) then z = z0 @@ -1682,7 +1695,7 @@ function find_neutral_pos_full( CS, z0, T_ref, S_ref, P_ref, P_top, P_bot, ppoly Ta = evaluation_polynomial( ppoly_T, nterm, a ) Sa = evaluation_polynomial( ppoly_S, nterm, a ) Pa = P_top*(1.-a) + P_bot*a - call calc_delta_rho_and_derivs(CS, Ta, Sa, Pa, T_ref, S_ref, P_ref, drho_a) + call calc_delta_rho_and_derivs(CS, US, Ta, Sa, Pa, T_ref, S_ref, P_ref, drho_a) if (ABS(drho_a) < CS%drho_tol) then z = a return @@ -1715,23 +1728,27 @@ 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, US, 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + 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 @@ -1745,20 +1762,20 @@ 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, US=US ) + call calculate_density( T2, S2, pmid, rho2, CS%EOS, US=US ) 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 pmid = 0.5 * (p1 + p2) 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) + call calculate_density_derivs(T1, S1, pmid, drdt1, drds1, CS%EOS, US) + call calculate_density_derivs(T2, S2, pmid, drdt2, drds2, CS%EOS, US) + 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) + call calculate_density_derivs(T1, S1, p1, drdt1, drds1, CS%EOS, US) + call calculate_density_derivs(T2, S2, p2, drdt2, drds2, CS%EOS, US) + 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 @@ -1776,30 +1793,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 @@ -1811,13 +1831,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 @@ -1834,8 +1855,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 @@ -1844,16 +1865,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 @@ -2313,18 +2334,23 @@ 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 type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure type(EOS_type), pointer :: EOS !< Structure for linear equation of state + type(unit_scale_type), pointer :: US !< A dimensional unit scaling type 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 @@ -2338,7 +2364,8 @@ 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 unit_scaling_init(US=US) + 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. @@ -2358,10 +2385,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 22.00, 18.00 /); TiL(2,:) = (/ 18.00, 14.00 /); TiL(3,:) = (/ 14.00, 10.00 /); TiR(1,:) = (/ 22.00, 18.00 /); TiR(2,:) = (/ 18.00, 14.00 /); TiR(3,:) = (/ 14.00, 10.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2372,10 +2399,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 22.00, 18.00 /); TiL(2,:) = (/ 18.00, 14.00 /); TiL(3,:) = (/ 14.00, 10.00 /); TiR(1,:) = (/ 20.00, 16.00 /); TiR(2,:) = (/ 16.00, 12.00 /); TiR(3,:) = (/ 12.00, 8.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2386,10 +2413,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 20.00, 16.00 /); TiL(2,:) = (/ 16.00, 12.00 /); TiL(3,:) = (/ 12.00, 8.00 /); TiR(1,:) = (/ 22.00, 18.00 /); TiR(2,:) = (/ 18.00, 14.00 /); TiR(3,:) = (/ 14.00, 10.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2400,10 +2427,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 22.00, 20.00 /); TiL(2,:) = (/ 18.00, 16.00 /); TiL(3,:) = (/ 14.00, 12.00 /); TiR(1,:) = (/ 32.00, 24.00 /); TiR(2,:) = (/ 22.00, 14.00 /); TiR(3,:) = (/ 12.00, 4.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2414,10 +2441,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 22.00, 18.00 /); TiL(2,:) = (/ 18.00, 14.00 /); TiL(3,:) = (/ 14.00, 10.00 /); TiR(1,:) = (/ 14.00, 14.00 /); TiR(2,:) = (/ 14.00, 14.00 /); TiR(3,:) = (/ 12.00, 8.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2428,10 +2455,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 14.00, 14.00 /); TiL(2,:) = (/ 14.00, 12.00 /); TiL(3,:) = (/ 10.00, 8.00 /); TiR(1,:) = (/ 14.00, 14.00 /); TiR(2,:) = (/ 14.00, 14.00 /); TiR(3,:) = (/ 14.00, 14.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2442,10 +2469,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 14.00, 14.00 /); TiL(2,:) = (/ 14.00, 12.00 /); TiL(3,:) = (/ 10.00, 8.00 /); TiR(1,:) = (/ 14.00, 14.00 /); TiR(2,:) = (/ 14.00, 14.00 /); TiR(3,:) = (/ 12.00, 4.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2456,10 +2483,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 14.00, 14.00 /); TiL(2,:) = (/ 14.00, 10.00 /); TiL(3,:) = (/ 10.00, 2.00 /); TiR(1,:) = (/ 14.00, 14.00 /); TiR(2,:) = (/ 14.00, 10.00 /); TiR(3,:) = (/ 10.00, 2.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2470,10 +2497,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 14.00, 12.00 /); TiL(2,:) = (/ 10.00, 10.00 /); TiL(3,:) = (/ 8.00, 2.00 /); TiR(1,:) = (/ 14.00, 12.00 /); TiR(2,:) = (/ 12.00, 8.00 /); TiR(3,:) = (/ 8.00, 2.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2484,10 +2511,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 12.00, 12.00 /); TiL(2,:) = (/ 12.00, 10.00 /); TiL(3,:) = (/ 10.00, 6.00 /); TiR(1,:) = (/ 12.00, 10.00 /); TiR(2,:) = (/ 10.00, 12.00 /); TiR(3,:) = (/ 8.00, 4.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2498,10 +2525,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 14.00, 14.00 /); TiL(2,:) = (/ 10.00, 10.00 /); TiL(3,:) = (/ 8.00, 6.00 /); TiR(1,:) = (/ 10.00, 14.00 /); TiR(2,:) = (/ 16.00, 16.00 /); TiR(3,:) = (/ 12.00, 4.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2512,10 +2539,10 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 8.00, 12.00 /); TiL(2,:) = (/ 12.00, 10.00 /); TiL(3,:) = (/ 8.00, 4.00 /); TiR(1,:) = (/ 10.00, 14.00 /); TiR(2,:) = (/ 14.00, 12.00 /); TiR(3,:) = (/ 10.00, 6.00 /); - 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) + call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) + call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) + call find_neutral_surface_positions_discontinuous(CS, US, 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) 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 @@ -2531,29 +2558,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(*,*) 'Pass' @@ -2562,13 +2589,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 @@ -2600,7 +2627,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 @@ -2626,11 +2653,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 @@ -2726,19 +2753,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_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 93ca34257c..6aa70fa605 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -1424,7 +1424,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 @@ -1495,8 +1495,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, & From 7643bce4e48b4c108a79a756d6ae418b9e19d547 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Apr 2020 16:45:57 -0400 Subject: [PATCH 27/55] Simpler calculate_density in ISOMIP_initialization Use the US form of calculate_density calls in ISOMIP_initialization. All answers are bitwise identical. --- src/user/ISOMIP_initialization.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index ba8dc1162f..c189cf0490 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -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 @@ -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, 1, 1, eqn_of_state, US) ! 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, US=US) 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, 1, nz, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US) 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, 1, nz, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo From 030a6368124e662bb6f35540947fcb440ffdc79d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Apr 2020 21:55:15 -0400 Subject: [PATCH 28/55] Nullify a pointer in neutral diffusion unit tests Nullified a pointer used in neutral diffusion unit tests. Without this correction of a problem introduced two commits ago, these unit tests would sometimes fail, but all solutions are bitwise identical. --- src/tracer/MOM_neutral_diffusion.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 0f025c3d39..64d5e134d7 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -2343,7 +2343,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) real, dimension(ns-1) :: hEff, Flx type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure type(EOS_type), pointer :: EOS !< Structure for linear equation of state - type(unit_scale_type), pointer :: US !< A dimensional unit scaling type + type(unit_scale_type), pointer :: US => NULL() !< A dimensional unit scaling type 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 @@ -2584,6 +2584,8 @@ logical function ndiff_unit_tests_discontinuous(verbose) (/12.,0./), (/34.,2./)), "Salt stratified Linearized Alpha/Beta")) if (.not. ndiff_unit_tests_discontinuous) write(*,*) 'Pass' + deallocate(US) + end function ndiff_unit_tests_discontinuous !> Returns true if a test of fv_diff() fails, and conditionally writes results to stream From ad0c70e2a9ce3e909cd6541bdf9b5f9fe5db9f2a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Apr 2020 21:55:47 -0400 Subject: [PATCH 29/55] Rescaled three diagnosed densities Rescaled 3 diagnosed densities and the pressures used to calculate them. All answers are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 35 +++++++++++++---------------- 1 file changed, 16 insertions(+), 19 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 2aa0dee688..94f6acc9c3 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -232,12 +232,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 [R L2 T-2 ~> Pa] or [Pa] + 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 @@ -355,7 +355,7 @@ 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] + 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 @@ -364,7 +364,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & 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] + 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 @@ -586,31 +586,28 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (associated(tv%eqn_of_state)) then 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), G%HI, tv%eqn_of_state, US) 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), G%HI, tv%eqn_of_state, US) 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), G%HI, tv%eqn_of_state, US) + 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) @@ -1577,11 +1574,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) From 608d210a6d2d5d05d00329566a4ed92d94da8120 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Apr 2020 21:57:56 -0400 Subject: [PATCH 30/55] Rescaled pressures in wave speed calculations Rescaled pressures used in wave speed and structure calculations for expanded dimensional consistency testing and some code simplification. Some internal variables were renamed for greater clarity. All answers are bitwise identical. --- src/diagnostics/MOM_wave_speed.F90 | 36 ++++++++++++++------------ src/diagnostics/MOM_wave_structure.F90 | 11 ++++---- 2 files changed, 25 insertions(+), 22 deletions(-) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 56545dc50d..85dbcdc13b 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) + kf(i)-1, tv%eqn_of_state, US) ! 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) + kf(i)-1, tv%eqn_of_state, US) ! 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..ceb6fd6c4f 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) + kf(i)-1, tv%eqn_of_state, US) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. From a01dae523f86a856fcea5b08abc0113250c0fd76 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Apr 2020 21:58:37 -0400 Subject: [PATCH 31/55] Corrected 3 openMP declarations Corrected 3 openMP declarations. All answers are bitwise identical. --- src/core/MOM_PressureForce_blocked_AFV.F90 | 6 +++--- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 5 ++--- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index d618060951..e949f6d69c 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -323,8 +323,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) @@ -617,7 +617,7 @@ 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,G,GV,e,p_atm,nz,use_EOS,& +!$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, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index dc8bbc2409..3cde9ce91e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -139,9 +139,8 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) 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,US,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 From bb73bb8f39bfee81263476c3dfaa0920448d41f5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Apr 2020 22:12:17 -0400 Subject: [PATCH 32/55] +(*)Rescaled pressures used to build coordinates Rescaled the pressures used to construct the rho, SLight, and Hycom coordinates. This change included passing in unit_scale_type arguments to several routines, and the addition of a call to get_param to potentially set the reference pressure for ALE configurations to something other than 2000 dbar at run time, as was already being done for other coordinates via tv%P_Ref. Because P_REF is read earlier by initialize_MOM, there are no changes to the MOM_parameter_doc files, but this could change answers in some cases with USE_REGRIDDING = True, P_Ref /= 2.0e7, and REGRIDDING_COORDINATE_MODE = RHO or SLIGHT. All answers are bitwise identical with the MOM6-examples test suite, but some public interfaces have new arguments. --- src/ALE/MOM_regridding.F90 | 63 +++++++++++++++++++------------- src/ALE/coord_hycom.F90 | 15 +++----- src/ALE/coord_rho.F90 | 27 ++++++-------- src/ALE/coord_slight.F90 | 37 +++++++++---------- src/framework/MOM_diag_remap.F90 | 2 +- 5 files changed, 73 insertions(+), 71 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index bc290b3f94..1000ba0d32 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 @@ -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,10 +878,10 @@ 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 ) @@ -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 @@ -1380,7 +1386,7 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) ! Local depth (G%bathyT is positive) nominalDepth = G%bathyT(i,j)*GV%Z_to_H - call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i, j, :), & + call build_rho_column(CS%rho_CS, US, nz, nominalDepth, h(i, j, :), & tv%T(i, j, :), tv%S(i, j, :), tv%eqn_of_state, zNew, & h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) @@ -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, & + call build_hycom1_column(CS%hycom_CS, US, tv%eqn_of_state, GV%ke, depth, & + 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) @@ -1585,9 +1593,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 +1605,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 +1631,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, US, 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) @@ -1962,7 +1971,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,14 +1984,13 @@ 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) end select @@ -2225,7 +2233,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 +2245,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 @@ -2283,6 +2293,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_hycom.F90 b/src/ALE/coord_hycom.F90 index 1686ac51c9..bfcff9005c 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -4,6 +4,7 @@ module coord_hycom ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, FATAL +use MOM_unit_scaling, only : unit_scale_type use MOM_EOS, only : EOS_type, calculate_density use regrid_interp, only : interp_CS_type, build_and_interpolate_grid @@ -21,9 +22,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 +37,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 +53,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 @@ -100,16 +96,17 @@ subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, inter end subroutine set_hycom_params !> Build a HyCOM coordinate column -subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & +subroutine build_hycom1_column(CS, US, eqn_of_state, nz, depth, h, T, S, p_col, & z_col, z_col_new, zScale, h_neglect, h_neglect_edge) type(hycom_CS), intent(in) :: CS !< Coordinate control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(EOS_type), pointer :: eqn_of_state !< Equation of state structure integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) real, dimension(nz), intent(in) :: T !< Temperature of column [degC] real, dimension(nz), intent(in) :: S !< Salinity of column [ppt] real, dimension(nz), intent(in) :: 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 +133,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, 1, nz, eqn_of_state, US=US) ! 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..565656ecb0 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -5,6 +5,7 @@ module coord_rho use MOM_error_handler, only : MOM_error, FATAL use MOM_remapping, only : remapping_CS, remapping_core_h +use MOM_unit_scaling, only : unit_scale_type use MOM_EOS, only : EOS_type, calculate_density use regrid_interp, only : interp_CS_type, build_and_interpolate_grid, DEGREE_MAX @@ -19,7 +20,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 +30,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 +39,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 +54,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 @@ -92,9 +88,10 @@ end subroutine set_rho_params !! !! 1. Density profiles are calculated on the source grid. !! 2. Positions of target densities (for interfaces) are found by interpolation. -subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & +subroutine build_rho_column(CS, US, nz, depth, h, T, S, eqn_of_state, z_interface, & h_neglect, h_neglect_edge) type(rho_CS), intent(in) :: CS !< coord_rho control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: nz !< Number of levels on source grid (i.e. length of h, T, S) real, intent(in) :: depth !< Depth of ocean bottom (positive in m) real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] @@ -111,7 +108,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 +126,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, 1, nz, eqn_of_state, US=US) do k = 1,count_nonzero_layers densities(k) = densities(mapping(k)) enddo @@ -188,9 +185,10 @@ end subroutine build_rho_column !! 4. T & S are remapped onto the new grid. !! 5. Return to step 1 until convergence or until the maximum number of !! iterations is reached, whichever comes first. -subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_state, & +subroutine build_rho_column_iteratively(CS, US, remapCS, nz, depth, h, T, S, eqn_of_state, & zInterface, h_neglect, h_neglect_edge, dev_tol) type(rho_CS), intent(in) :: CS !< Regridding control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom [Z ~> m] @@ -211,7 +209,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 +250,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, 1, nz, eqn_of_state, US=US) 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..89c78d6c64 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -4,6 +4,7 @@ module coord_slight ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, FATAL +use MOM_unit_scaling, only : unit_scale_type use MOM_EOS, only : EOS_type, calculate_compress use MOM_EOS, only : calculate_density, calculate_density_derivs use regrid_interp, only : interp_CS_type, regridding_set_ppolys @@ -20,7 +21,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 +55,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 +70,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 +98,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 +178,21 @@ 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, US, 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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 @@ -208,7 +206,7 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & 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) :: 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 @@ -254,8 +252,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, 1, nz, eqn_of_state, US=US) ! Find the locations of the target potential densities, flagging ! locations in apparently unstable regions as not reliable. @@ -371,23 +368,23 @@ 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 + 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, 2, nz-1, & - eqn_of_state, scale=CS%kg_m3_to_R) + eqn_of_state, US) 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) + eqn_of_state, US) if (CS%compressibility_fraction > 0.0) then - call calculate_compress(T_int, S_int, p_R, rho_tmp, drho_dp, 2, nz-1, & + call calculate_compress(T_int, S_int, US%RL2_T2_to_Pa*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 * US%L_T_to_m_s**2 strat_rat(1) = 1.0 do K=2,nz drIS = drhoIS_dT(K) * (T_f(k) - T_f(k-1)) + & diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index cadd74950a..83a7ce207c 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -327,7 +327,7 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state) GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then !### I think that the conversion factor in the 2nd line should be GV%Z_to_H - call build_rho_column(get_rho_CS(remap_cs%regrid_cs), G%ke, & + call build_rho_column(get_rho_CS(remap_cs%regrid_cs), US, G%ke, & US%Z_to_m*G%bathyT(i,j), h(i,j,:), T(i,j,:), S(i,j,:), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then From 4182ad23cace2f9d0d65666db948cd72a556f917 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Apr 2020 03:53:48 -0400 Subject: [PATCH 33/55] +Add optional US arg to calculate_compress Added a new optional unit_scale_type argument to the calculate_compress to trigger dimensional rescaling of their input and output variables. Also use this new argument in calls to calculate_compress from build_slight_column and rescaled internal variables in the same routine. All answers are bitwise identical, but there is a new optional argument to a public interface. --- src/ALE/coord_slight.F90 | 30 +++++++++--------- src/equation_of_state/MOM_EOS.F90 | 52 +++++++++++++++++++++++-------- 2 files changed, 54 insertions(+), 28 deletions(-) diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 89c78d6c64..000315bae8 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -205,7 +205,7 @@ subroutine build_slight_column(CS, US, eqn_of_state, H_to_pres, 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) :: 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] @@ -216,19 +216,20 @@ subroutine build_slight_column(CS, US, eqn_of_state, H_to_pres, 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 @@ -378,13 +379,12 @@ subroutine build_slight_column(CS, US, eqn_of_state, H_to_pres, H_subroundoff, & call calculate_density_derivs(T_int, S_int, p_R, drhoR_dT, drhoR_dS, 2, nz-1, & eqn_of_state, US) if (CS%compressibility_fraction > 0.0) then - call calculate_compress(T_int, S_int, US%RL2_T2_to_Pa*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, US) else do K=2,nz ; drho_dp(K) = 0.0 ; enddo endif - H_to_cPa = CS%compressibility_fraction * H_to_pres * US%L_T_to_m_s**2 + 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/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index c1fd5fd42f..4730d92807 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -394,6 +394,7 @@ subroutine calc_spec_vol_US(T, S, pressure, specvol, start, npts, EOS, US, spv_r 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(pressure)) :: pres ! Pressure converted to [Pa] 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] @@ -995,21 +996,35 @@ subroutine calc_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, EOS, U end subroutine calc_spec_vol_derivs_HI_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, US) 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 + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + + ! 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 + if (present(US)) then + do i=is,ie ; pressure(i) = US%RL2_T2_to_Pa * press(i) ; enddo + else + do i=is,ie ; pressure(i) = press(i) ; enddo + endif + select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_compress_linear(T, S, pressure, rho, drho_dp, start, npts, & @@ -1026,18 +1041,29 @@ subroutine calculate_compress_array(T, S, pressure, rho, drho_dp, start, npts, E call MOM_error(FATAL, "calculate_compress: EOS%form_of_EOS is not valid.") end select + if (present(US)) then + if (US%kg_m3_to_R /= 1.0) then ; do i=is,ie + rho(i) = US%kg_m3_to_R * rho(i) + enddo ; endif + if (US%L_T_to_m_s /= 1.0) then ; do i=is,ie + drho_dp(i) = US%L_T_to_m_s**2 * drho_dp(i) + enddo ; endif + 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 -subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) +!! 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, US) 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) :: rho !< In situ density [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] + 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 + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa @@ -1045,7 +1071,7 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) "calculate_compress called with an unassociated EOS_type EOS.") Ta(1) = T ; Sa(1) = S; pa(1) = pressure - call calculate_compress_array(Ta, Sa, pa, rhoa, drho_dpa, 1, 1, EOS) + call calculate_compress_array(Ta, Sa, pa, rhoa, drho_dpa, 1, 1, EOS, US) rho = rhoa(1) ; drho_dp = drho_dpa(1) end subroutine calculate_compress_scalar @@ -1076,7 +1102,7 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & 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 [T-2 ~> m2 s-2] or [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 From b84b2d35fa34fa74344cf7c6b9132f7f319cd3af Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Apr 2020 03:57:18 -0400 Subject: [PATCH 34/55] Rescaled variables in convert_thickness Rescaled internal variables in convert_thickness, including pressures and densities, for dimensional consistency testing and code simplification. All answers are bitwise identical. --- .../MOM_state_initialization.F90 | 45 +++++++++---------- 1 file changed, 21 insertions(+), 24 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 3cdcb5bcfd..2efceb5991 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -932,27 +932,26 @@ 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 :: 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 @@ -960,31 +959,29 @@ subroutine convert_thickness(h, G, GV, US, tv) 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) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_top(:,j), rho, G%HI, & + tv%eqn_of_state, US) 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, US=US) 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) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_bot(:,j), rho, G%HI, & + tv%eqn_of_state, US) ! 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 From da120120cba4df66f1212f455878d8105185a5ca Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Apr 2020 04:00:15 -0400 Subject: [PATCH 35/55] Minor cleanup related to pressure rescaling Minor refactoring of variables related to pressure rescaling and some cleanup of comments. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 8 ++++---- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index e47e84b792..23b40e3171 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -305,7 +305,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(), & @@ -412,11 +413,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 = US%RL2_T2_to_Pa / 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/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7ba477466e..8b5da8565b 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -658,7 +658,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 +805,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) From 87054b46472399169ac7fcba89cf095e5494c93d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Apr 2020 05:36:57 -0400 Subject: [PATCH 36/55] Added an omitted dOxygen comment --- src/equation_of_state/MOM_EOS.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 4730d92807..9788c84338 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -73,6 +73,7 @@ module MOM_EOS calculate_density_derivs_HI_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_US, calc_spec_vol_derivs_HI_1d end interface calculate_specific_vol_derivs @@ -954,7 +955,8 @@ subroutine calc_spec_vol_derivs_US(T, S, pressure, dSV_dT, dSV_dS, start, npts, end subroutine calc_spec_vol_derivs_US -!> Calls the appropriate subroutine to calculate specific volume derivatives for an array. +!> Calls the appropriate subroutine to calculate specific volume derivatives for array inputs +!! using array extents determined from a hor_index_type.. subroutine calc_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, EOS, US, halo) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] From 77b6b74714b5df97c3e04ba4d1b00bc672d357d2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Apr 2020 05:43:39 -0400 Subject: [PATCH 37/55] (*)Set loop bounds in calculate_density calls Explicitly set loop bounds in some calculate_density calls with halos that are only set around velocity points to avoid errors with non-symmetric memory. All answers are bitwise identical in test cases, and this should fix a problem that was detected by the automated testing. --- src/core/MOM_PressureForce_Montgomery.F90 | 46 ++++++++++--------- src/core/MOM_PressureForce_analytic_FV.F90 | 26 ++++++----- src/core/MOM_PressureForce_blocked_AFV.F90 | 26 ++++++----- .../vertical/MOM_set_viscosity.F90 | 7 +-- 4 files changed, 57 insertions(+), 48 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index b7291b71b2..0d8cf27dad 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -124,11 +124,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb 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 :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, start, npts 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 + start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 use_p_atm = .false. if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif @@ -227,8 +228,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(:), G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), start, npts, & + tv%eqn_of_state, US=US) 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) @@ -244,8 +245,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, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_in_situ, start, npts, & + tv%eqn_of_state, US=US) do i=Isq,Ieq+1 ; alpha_star(i,j,k) = 1.0 / rho_in_situ(i) ; enddo enddo ; enddo endif ! use_EOS @@ -408,12 +409,13 @@ 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 :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, start, npts 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 + start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 use_p_atm = .false. if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif @@ -482,8 +484,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(:), G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), start, npts, & + tv%eqn_of_state, US=US) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -503,8 +505,8 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! will come down with a fatal error if there is any compressibility. !$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), G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), start, npts, & + tv%eqn_of_state, US=US) do i=Isq,Ieq+1 ; rho_star(i,j,k) = G_Rho0*rho_star(i,j,k) ; enddo enddo ; enddo endif ! use_EOS @@ -630,9 +632,10 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) ! 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 :: Isq, Ieq, Jsq, Jeq, nz, i, j, k + integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k, start, npts Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke + start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 Rho0xG = Rho0 * GV%g_Earth G_Rho0 = GV%g_Earth / GV%Rho0 @@ -659,8 +662,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) press(i) = -Rho0xG*e(i,j,1) enddo - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, start, npts, & + tv%eqn_of_state, US=US) do i=Isq,Ieq+1 pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo @@ -670,8 +673,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) T_int(i) = 0.5*(tv%T(i,j,k-1)+tv%T(i,j,k)) S_int(i) = 0.5*(tv%S(i,j,k-1)+tv%S(i,j,k)) enddo - call calculate_density_derivs(T_int, S_int, press, dR_dT, dR_dS, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density_derivs(T_int, S_int, press, dR_dT, dR_dS, start, npts, & + tv%eqn_of_state, US=US) 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)) * & @@ -730,9 +733,10 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) real :: dp_neglect ! A thickness that is so small it is usually lost ! 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 :: Isq, Ieq, Jsq, Jeq, nz, i, j, k + integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k, start, npts Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke + start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 use_EOS = associated(tv%eqn_of_state) @@ -755,8 +759,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, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,nz), tv%S(:,j,nz), p(:,j,nz+1), rho_in_situ, start, npts, & + tv%eqn_of_state, US=US) 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)) @@ -766,9 +770,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, G%HI, tv%eqn_of_state, US, halo=1) - call calculate_density_derivs(T_int, S_int, p(:,j,k+1), dR_dT, dR_dS, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(T_int, S_int, p(:,j,k+1), rho_in_situ, start, npts, tv%eqn_of_state, US=US) + call calculate_density_derivs(T_int, S_int, p(:,j,k+1), dR_dT, dR_dS, start, npts, & + tv%eqn_of_state, US=US) 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)) + & diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 4f85980f00..f0a4485399 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -176,12 +176,13 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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 :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, start, npts 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 + start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_AFV_nonBouss: Module must be initialized before it is used.") @@ -227,8 +228,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(:), G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), start, npts, & + tv%eqn_of_state, US=US) 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) @@ -333,8 +334,8 @@ 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, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), rho_in_situ, start, npts, & + tv%eqn_of_state, US=US) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -503,12 +504,13 @@ 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 :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, start, npts 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 + start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_AFV_Bouss: Module must be initialized before it is used.") @@ -576,8 +578,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(:), G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), start, npts, & + tv%eqn_of_state, US=US) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -599,11 +601,11 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at !$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, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), rho_in_situ, start, npts, & + tv%eqn_of_state, US=US) else - call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, start, npts, & + tv%eqn_of_state, US=US) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index e949f6d69c..5ac7831479 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -173,13 +173,14 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, 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 :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, start, npts 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 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 + start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_AFV_nonBouss: Module must be initialized before it is used.") @@ -223,8 +224,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(:), G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), start, npts, & + tv%eqn_of_state, US=US) 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) @@ -301,8 +302,8 @@ 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, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), rho_in_situ, start, npts, & + tv%eqn_of_state, US=US) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -488,7 +489,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 :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, start, npts integer :: is_bk, ie_bk, js_bk, je_bk, Isq_bk, Ieq_bk, Jsq_bk, Jeq_bk integer :: ioff_bk, joff_bk integer :: i, j, k, n, ib, jb @@ -496,6 +497,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 + start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_AFV_Bouss: Module must be initialized before it is used.") @@ -563,8 +565,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(:), G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), start, npts, & + tv%eqn_of_state, US=US) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -586,11 +588,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, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), rho_in_situ, start, npts, & + tv%eqn_of_state, US=US) else - call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, start, npts, & + tv%eqn_of_state, US=US) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index f7ae639fa0..fd5e0e7ab8 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -273,12 +273,13 @@ 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 :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, m, n, K2, nkmb, nkml + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, m, n, K2, nkmb, nkml, start, npts integer :: itt, maxitt=20 type(ocean_OBC_type), pointer :: OBC => NULL() 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 + start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff Rho0x400_G = 400.0*(GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H @@ -315,8 +316,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo !$OMP parallel do default(shared) 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), G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rml(:,j,k), start, npts, & + tv%eqn_of_state, US=US) enddo ; enddo endif From a00c3277f5aa0ddcc67fdcc61f9ad588d7ee4dc7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Apr 2020 06:27:39 -0400 Subject: [PATCH 38/55] (*)Reordered setting calculate_density loop bounds Moved the line setting the calculate_density loop bounds for viscosity to come after another line that changes the velocity point bounds, fixing a bug with non-symmetric memory that was introduced in the previous commit and that is being detected by the automated testing. All answers are once again bitwise identical in the MOM6-examples test suite. --- src/parameterizations/vertical/MOM_set_viscosity.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index fd5e0e7ab8..4f08d37fbc 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -279,7 +279,6 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) 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 - start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff Rho0x400_G = 400.0*(GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H @@ -293,6 +292,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (present(symmetrize)) then ; if (symmetrize) then Jsq = js-1 ; Isq = is-1 endif ; endif + start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 if (CS%debug) then call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) From ab9d8e95ffc695f2d5c9feed388ec708c4563bf7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 17 Apr 2020 11:05:11 -0400 Subject: [PATCH 39/55] +Added dom interface to calculate_density Removed the interfaces using G%HI to calculate_density and related routines and added a new variant with a new optional argument 'dom' specifying a two- element integer array with the start and end values of the domain to compute on for 1-d arrays starting at 1. If this array is not present in this new variant, calculations are done over the entire output array extent. All calls to the interfaces from before the rescale_pressure pull request will still work. Also added the new function EOS_domain that sets this two-element domain array from a horiz_index_type. This new interface is used throughout the code where the old, removed form was in use. All answers are bitwise identical. --- src/ALE/coord_hycom.F90 | 2 +- src/ALE/coord_rho.F90 | 2 +- src/ALE/coord_slight.F90 | 10 +- src/core/MOM.F90 | 6 +- src/core/MOM_forcing_type.F90 | 6 +- src/diagnostics/MOM_diagnostics.F90 | 19 +- src/equation_of_state/MOM_EOS.F90 | 399 +++++++++--------- src/ice_shelf/MOM_ice_shelf.F90 | 10 +- .../MOM_state_initialization.F90 | 16 +- .../lateral/MOM_mixed_layer_restrat.F90 | 16 +- .../lateral/MOM_thickness_diffuse.F90 | 10 +- .../vertical/MOM_CVMix_ddiff.F90 | 3 +- .../vertical/MOM_bulk_mixed_layer.F90 | 15 +- .../vertical/MOM_diabatic_aux.F90 | 23 +- .../vertical/MOM_diabatic_driver.F90 | 6 +- .../vertical/MOM_diapyc_energy_req.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 2 - .../vertical/MOM_entrain_diffusive.F90 | 15 +- .../vertical/MOM_full_convection.F90 | 15 +- .../vertical/MOM_internal_tide_input.F90 | 6 +- .../vertical/MOM_kappa_shear.F90 | 6 +- .../vertical/MOM_regularize_layers.F90 | 8 +- .../vertical/MOM_set_diffusivity.F90 | 21 +- .../vertical/MOM_set_viscosity.F90 | 18 +- src/tracer/MOM_neutral_diffusion.F90 | 16 +- src/tracer/MOM_tracer_hor_diff.F90 | 6 +- src/user/RGC_initialization.F90 | 5 +- src/user/user_change_diffusivity.F90 | 8 +- 28 files changed, 337 insertions(+), 334 deletions(-) diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index bfcff9005c..bc25377dbe 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -133,7 +133,7 @@ subroutine build_hycom1_column(CS, US, 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, US=US) + call calculate_density(T, S, p_col, rho_col, eqn_of_state, US=US) ! 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 565656ecb0..7c6a00e714 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -126,7 +126,7 @@ subroutine build_rho_column(CS, US, nz, depth, h, T, S, eqn_of_state, z_interfac ! Compute densities on source column pres(:) = CS%ref_pressure - call calculate_density(T, S, pres, densities, 1, nz, eqn_of_state, US=US) + call calculate_density(T, S, pres, densities, eqn_of_state, US=US) do k = 1,count_nonzero_layers densities(k) = densities(mapping(k)) enddo diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 000315bae8..de21e7027e 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -253,7 +253,7 @@ subroutine build_slight_column(CS, US, eqn_of_state, H_to_pres, 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, US=US) + call calculate_density(T_col, S_col, p_col, rho_col, eqn_of_state, US=US) ! Find the locations of the target potential densities, flagging ! locations in apparently unstable regions as not reliable. @@ -374,10 +374,10 @@ subroutine build_slight_column(CS, US, eqn_of_state, H_to_pres, H_subroundoff, & 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_pres - call calculate_density_derivs(T_int, S_int, p_IS, drhoIS_dT, drhoIS_dS, 2, nz-1, & - eqn_of_state, US) - call calculate_density_derivs(T_int, S_int, p_R, drhoR_dT, drhoR_dS, 2, nz-1, & - eqn_of_state, US) + call calculate_density_derivs(T_int, S_int, p_IS, drhoIS_dT, drhoIS_dS, & + eqn_of_state, US, dom=(/2,nz/)) + call calculate_density_derivs(T_int, S_int, p_R, drhoR_dT, drhoR_dS, & + eqn_of_state, US, dom=(/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, US) else diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index efd4a80a52..4ca4682ef4 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 @@ -2904,8 +2904,8 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) ! 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(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), Rho_conv, G%HI, & - tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), Rho_conv, & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) 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 diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 12f165372b..c54b26a6ab 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 @@ -953,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, G%HI, & - tv%eqn_of_state, US) + call calculate_density_derivs(Temp(:,j,1), Salt(:,j,1), pressure, dRhodT, dRhodS, & + tv%eqn_of_state, US, dom=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 diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 94f6acc9c3..8d4c5dfa9b 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 @@ -359,8 +359,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(i) = pressure_1d(i) + 0.5*(GV%H_to_RZ*GV%g_Earth)*h(i,j,k) enddo ! Store in-situ density [R ~> kg m-3] in work_3d - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, rho_in_situ, G%HI, & - tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, rho_in_situ, & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) 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 @@ -465,8 +465,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = tv%P_Ref !$OMP parallel do default(shared) do k=1,nz ; do j=js-1,je+1 - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), tv%eqn_of_state, & + US, dom=EOS_domain(G%HI, halo=1)) 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 @@ -588,7 +588,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = 0. !$OMP parallel do default(shared) do k=1,nz ; do j=js,je - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) enddo ; enddo if (CS%id_rhopot0 > 0) call post_data(CS%id_rhopot0, Rcv, CS%diag) endif @@ -596,7 +597,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = 2.0e7*US%kg_m3_to_R*US%m_s_to_L_T**2 ! 2000 dbars !$OMP parallel do default(shared) do k=1,nz ; do j=js,je - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) enddo ; enddo if (CS%id_rhopot2 > 0) call post_data(CS%id_rhopot2, Rcv, CS%diag) endif @@ -606,7 +608,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = 0. ! Start at p=0 Pa at surface do k=1,nz pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure in middle of layer k - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure at bottom of layer k enddo enddo diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 9788c84338..b57677d8fa 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -40,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 @@ -59,23 +59,24 @@ module MOM_EOS !> Calculates density of sea water from T, S and P interface calculate_density - module procedure calculate_density_scalar, calculate_density_array, calculate_density_HI_1d + 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 calc_spec_vol_scalar, calculate_spec_vol_array, calc_spec_vol_HI_1d, calc_spec_vol_US + 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, & - calculate_density_derivs_HI_1d + 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_US, calc_spec_vol_derivs_HI_1d + 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, @@ -255,44 +256,64 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re end subroutine calculate_density_array -!> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs -!! using array extents determined from a hor_index_type. +!> 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_HI_1d(T, S, pressure, rho, HI, EOS, US, halo) - type(hor_index_type), intent(in) :: HI !< The horizontal index structure - real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] - real, dimension(HI%isd:HI%ied), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] - real, dimension(HI%isd:HI%ied), intent(inout) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. +subroutine calculate_density_1d(T, S, pressure, rho, EOS, US, 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 + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + 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, dimension(HI%isd:HI%ied) :: pres ! Pressure converted to [Pa] - integer :: i, is, ie, start, npts, halo_sz + 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_density_HI_1d called with an unassociated EOS_type EOS.") + "calculate_density_1d called with an unassociated EOS_type EOS.") - halo_sz = 0 ; if (present(halo)) halo_sz = halo + 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 - start = HI%isc - (HI%isd-1) - halo_sz - npts = HI%iec - HI%isc + 1 + 2*halo_sz - is = HI%isc - halo_sz ; ie = HI%iec + halo_sz + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + rho_unscale = 1.0 ; if (present(US)) rho_unscale = US%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 - if (US%RL2_T2_to_Pa == 1.0) then - call calculate_density_array(T, S, pressure, rho, start, npts, EOS) - else ! There is rescaling of variables, including pressure. - do i=is,ie ; pres(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo - call calculate_density_array(T, S, pres, rho, start, npts, EOS) + if (present(US) .or. present(scale)) then + rho_scale = 1.0 ; if (present(US)) rho_scale = US%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 endif - if (US%kg_m3_to_R /= 1.0) then ; do i=is,ie - rho(i) = US%kg_m3_to_R * rho(i) - enddo ; endif +end subroutine calculate_density_1d -end subroutine calculate_density_HI_1d !> Calls the appropriate subroutine to calculate the specific volume of sea water !! for 1-D array inputs. @@ -380,97 +401,64 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, US, scale end subroutine calc_spec_vol_scalar -!> Calls the appropriate subroutine to calculate the specific volume of sea water -!! for 1-D array inputs with dimensional rescaling. -subroutine calc_spec_vol_US(T, S, pressure, specvol, start, npts, EOS, US, 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] or [R L2 T-2 ~> Pa] - real, dimension(:), intent(inout) :: specvol !< in situ specific volume [kg m-3] or [R-1 ~> m3 kg-1] - 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - 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] - - ! Local variables - real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] - 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] - integer :: i, is, ie - - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_array called with an unassociated EOS_type EOS.") - - is = start ; ie = is + npts - 1 - - if ((US%RL2_T2_to_Pa == 1.0) .and. (US%R_to_kg_m3 == 1.0)) then - call calculate_spec_vol_array(T, S, pressure, specvol, start, 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo - spv_reference = US%kg_m3_to_R*spv_ref - call calculate_spec_vol_array(T, S, pres, specvol, start, 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo - call calculate_spec_vol_array(T, S, pres, specvol, start, npts, EOS) - endif - - spv_scale = US%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_US - - !> Calls the appropriate subroutine to calculate the specific volume of sea water for 1-D array -!! inputs using array extents determined from a hor_index_type. -subroutine calc_spec_vol_HI_1d(T, S, pressure, specvol, HI, EOS, US, halo, spv_ref) - type(hor_index_type), intent(in) :: HI !< The horizontal index structure - real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] - real, dimension(HI%isd:HI%ied), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] - real, dimension(HI%isd:HI%ied), intent(inout) :: specvol !< In situ specific volume [R-1 ~> m3 kg-1] - type(EOS_type), pointer :: EOS !< Equation of state structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. - real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1] +!! inputs, potentially limiting the domain of indices that are worked on. +subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, US, 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 + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + 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(HI%isd:HI%ied) :: pres ! Pressure converted to [Pa] + 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, start, npts, halo_sz + integer :: i, is, ie, npts if (.not.associated(EOS)) call MOM_error(FATAL, & - "calc_spec_vol_HI_1d called with an unassociated EOS_type EOS.") + "calc_spec_vol_1d called with an unassociated EOS_type EOS.") - halo_sz = 0 ; if (present(halo)) halo_sz = halo + 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 - start = HI%isc - (HI%isd-1) - halo_sz - npts = HI%iec - HI%isc + 1 + 2*halo_sz - is = HI%isc - halo_sz ; ie = HI%iec + halo_sz + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + spv_unscale = 1.0 ; if (present(US)) spv_unscale = US%kg_m3_to_R - if ((US%RL2_T2_to_Pa == 1.0) .and. (US%R_to_kg_m3 == 1.0)) then - call calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, spv_ref) + 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo - spv_reference = US%kg_m3_to_R*spv_ref - call calculate_spec_vol_array(T, S, pres, specvol, start, npts, EOS, spv_reference) + 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo - call calculate_spec_vol_array(T, S, pres, specvol, start, npts, EOS) + do i=is,ie ; pres(i) = p_scale * pressure(i) ; enddo + call calculate_spec_vol_array(T, S, pres, specvol, is, npts, EOS) endif - if (US%R_to_kg_m3 /= 1.0) then ; do i=is,ie - specvol(i) = US%R_to_kg_m3 * specvol(i) - enddo ; endif + if (present(US) .or. present(scale)) then + spv_scale = 1.0 ; if (present(US)) spv_scale = US%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 + endif + +end subroutine calc_spec_vol_1d -end subroutine calc_spec_vol_HI_1d !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs. subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) @@ -626,45 +614,55 @@ end subroutine calculate_density_derivs_array !> Calls the appropriate subroutine to calculate density derivatives for 1-D array inputs. -subroutine calculate_density_derivs_HI_1d(T, S, pressure, drho_dT, drho_dS, HI, EOS, US, halo) - type(hor_index_type), intent(in) :: HI !< The horizontal index structure - real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] - real, dimension(HI%isd:HI%ied), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] - real, dimension(HI%isd:HI%ied), intent(inout) :: drho_dT !< The partial derivative of density with potential - !! temperature [R degC-1 ~> kg m-3 degC-1] - real, dimension(HI%isd:HI%ied), 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. +subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, US, 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 + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + 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(HI%isd:HI%ied) :: pres ! Pressure converted to [Pa] - integer :: i, is, ie, start, npts, halo_sz + 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.") - halo_sz = 0 ; if (present(halo)) halo_sz = halo + 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 - start = HI%isc - (HI%isd-1) - halo_sz - npts = HI%iec - HI%isc + 1 + 2*halo_sz - is = HI%isc - halo_sz ; ie = HI%iec + halo_sz + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa - if (US%RL2_T2_to_Pa == 1.0) then - call calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS) + 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo - call calculate_density_derivs_array(T, S, pres, drho_dT, drho_dS, start, npts, EOS) + 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 - if (US%kg_m3_to_R /= 1.0) then ; do i=is,ie - drho_dT(i) = US%kg_m3_to_R * drho_dT(i) - drho_dS(i) = US%kg_m3_to_R * drho_dS(i) - enddo ; endif + if (present(US) .or. present(scale)) then + rho_scale = 1.0 ; if (present(US)) rho_scale = US%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 + endif -end subroutine calculate_density_derivs_HI_1d +end subroutine calculate_density_derivs_1d !> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar @@ -912,90 +910,56 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start end subroutine calculate_spec_vol_derivs_array - -!> Calls the appropriate subroutine to calculate specific volume derivatives for an array with unit scaling. -subroutine calc_spec_vol_derivs_US(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS, US, 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] - 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific - !! volume in combination with scaling given by US [various] +!> 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, US, 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 + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + 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(T)) :: press ! Pressure converted to [Pa] + 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] - integer :: i, is, ie + 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_array called with an unassociated EOS_type EOS.") - - is = start ; ie = is + npts - 1 + "calculate_spec_vol_derivs_1d called with an unassociated EOS_type EOS.") - if (US%RL2_T2_to_Pa == 1.0) then - call calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS) + if (present(dom)) then + is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else - do i=is,ie ; press(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo - call calculate_spec_vol_derivs_array(T, S, press, dSV_dT, dSV_dS, start, npts, EOS) + is = 1 ; ie = size(dSV_dT) ; npts = 1 + ie - is endif + p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa - spv_scale = US%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 calc_spec_vol_derivs_US - -!> Calls the appropriate subroutine to calculate specific volume derivatives for array inputs -!! using array extents determined from a hor_index_type.. -subroutine calc_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, EOS, US, halo) - type(hor_index_type), intent(in) :: HI !< The horizontal index structure - real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] - real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] - real, dimension(HI%isd:HI%ied), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] - real, dimension(HI%isd:HI%ied), intent(inout) :: dSV_dT !< The partial derivative of specific volume with potential - !! temperature [R-1 degC-1 ~> m3 kg-1 degC-1] - real, dimension(HI%isd:HI%ied), 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. - - ! Local variables - real, dimension(HI%isd:HI%ied) :: press ! Pressure converted to [Pa] - integer :: i, is, ie, start, npts, halo_sz - - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_derivs_HI_1d called with an unassociated EOS_type EOS.") - - halo_sz = 0 ; if (present(halo)) halo_sz = halo - - start = HI%isc - (HI%isd-1) - halo_sz - npts = HI%iec - HI%isc + 1 + 2*halo_sz - is = HI%isc - halo_sz ; ie = HI%iec + halo_sz - - if (US%RL2_T2_to_Pa == 1.0) then - call calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS) + 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo - call calculate_spec_vol_derivs_array(T, S, press, dSV_dT, dSV_dS, start, npts, EOS) + 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 - if (US%R_to_kg_m3 /= 1.0) then ; do i=is,ie - dSV_dT(i) = US%R_to_kg_m3 * dSV_dT(i) - dSV_dS(i) = US%R_to_kg_m3 * dSV_dS(i) - enddo ; endif + if (present(US) .or. present(scale)) then + spv_scale = 1.0 ; if (present(US)) spv_scale = US%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 + endif -end subroutine calc_spec_vol_derivs_HI_1d +end subroutine calc_spec_vol_derivs_1d !> Calls the appropriate subroutine to calculate the density and compressibility for 1-D array @@ -1079,12 +1043,31 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS, US) end subroutine calculate_compress_scalar +!> 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, US) @@ -3039,7 +3022,7 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) intent(in) :: mask_z !< 3d mask regulating which points to convert. 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 diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 858af4e1ea..8f1587ab8b 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 @@ -375,10 +375,10 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) 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(:), G%HI, & - CS%eqn_of_state, US) - call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, dR0_dT, dR0_dS, G%HI, & - CS%eqn_of_state, US) + call calculate_density(state%sst(:,j), state%sss(:,j), p_int, Rhoml(:), & + CS%eqn_of_state, US, dom=EOS_domain(G%HI)) + call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, dR0_dT, dR0_dS, & + CS%eqn_of_state, US, dom=EOS_domain(G%HI)) do i=is,ie if ((state%ocean_mass(i,j) > US%RZ_to_kg_m2*CS%col_mass_melt_threshold) .and. & diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 2efceb5991..2ac8ac47bf 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 @@ -959,8 +959,8 @@ subroutine convert_thickness(h, G, GV, US, tv) 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, G%HI, & - tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_top(:,j), rho, & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) do i=is,ie p_bot(i,j) = p_top(i,j) + HR_to_pres * (h(i,j,k) * rho(i)) enddo @@ -970,8 +970,8 @@ subroutine convert_thickness(h, G, GV, US, tv) 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, US=US) if (itt < max_itt) then ; do j=js,je - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_bot(:,j), rho, G%HI, & - tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_bot(:,j), rho, & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) ! Use Newton's method to correct the bottom value. ! The hydrostatic equation is sufficiently linear that no bounds-checking is needed. do i=is,ie @@ -1869,7 +1869,8 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, C 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), G%HI, tv%eqn_of_state, US) + call calculate_density(tmp(:,j,1), tmp2(:,j,1), pres, tmp_2d(:,j), tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) enddo call set_up_sponge_ML_density(tmp_2d, G, CSp) @@ -2188,7 +2189,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param press(:) = tv%P_Ref do k=1,kd ; do j=js,je - call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), G%HI, eos, US) + call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), eos, US, & + dom=EOS_domain(G%HI)) enddo ; enddo call pass_var(temp_z,G%Domain) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 744a801391..fa1504b431 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 @@ -207,8 +207,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var pRef_MLD(:) = 0. 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, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, tv%eqn_of_state, & + US, dom=EOS_domain(G%HI, halo=1)) deltaRhoAtK(:) = 0. MLD_fast(:,j) = 0. do k = 2, nz @@ -216,8 +216,8 @@ 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, G%HI, & - tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, tv%eqn_of_state, & + US, dom=EOS_domain(G%HI, halo=1)) do i = is-1,ie+1 deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface enddo @@ -322,7 +322,8 @@ 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(:), G%HI, tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml(:), tv%eqn_of_state, & + US, dom=EOS_domain(G%HI, halo=1)) line_is_empty = .true. do i=is-1,ie+1 if (htot_fast(i,j) < MLD_fast(i,j)) then @@ -646,7 +647,8 @@ 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(:), G%HI, tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, Rho0(:), tv%eqn_of_state, & + US, dom=EOS_domain(G%HI, halo=1)) 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 4d42f05629..62f1dad445 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 @@ -1029,8 +1029,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, G%HI, & - tv%eqn_of_state, US) + call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) endif do i=is,ie if (calc_derivatives) then @@ -1291,8 +1291,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, G%HI, & - tv%eqn_of_state, US) + call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) endif do i=is,ie vhD(i,J,1) = -vhtot(i,J) diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 1bcb6a1266..f169147d03 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -236,8 +236,7 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) pRef = pRef + GV%H_to_Pa * h(i,j,k-1) 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" diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index cc3a6e3f69..2a6dd66c20 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 @@ -466,12 +466,15 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C do k=1,CS%nkml ; do i=is,ie 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, G%HI, tv%eqn_of_state, US) - call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, G%HI, & - tv%eqn_of_state, US) + call calculate_density_derivs(T(:,1), S(:,1), p_ref, dR0_dT, dR0_dS, tv%eqn_of_state, & + US, dom=EOS_domain(G%HI)) + call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, tv%eqn_of_state, & + US, dom=EOS_domain(G%HI)) do k=1,nz - call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), G%HI, tv%eqn_of_state, US) - call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), G%HI, tv%eqn_of_state, US) + call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), tv%eqn_of_state, & + US, dom=EOS_domain(G%HI)) + call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, & + US, dom=EOS_domain(G%HI)) 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 3cde9ce91e..ae7adc05eb 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 @@ -446,7 +446,8 @@ 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), G%HI, tv%eqn_of_state, US) + call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) enddo ! First, try to find an interior layer where inserting all the salt @@ -766,7 +767,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, pRef_MLD(:) = 0.0 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, G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) do i=is,ie deltaRhoAtK(i) = 0. MLD(i,j) = 0. @@ -807,7 +809,8 @@ 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, G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) do i = is, ie deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface ddRho = deltaRhoAtK(i) - deltaRhoAtKm1(i) @@ -830,8 +833,10 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! 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, G%HI, tv%eqn_of_state, US) - call calculate_density(T_deeper, S_deeper, pRef_N2, rho_deeper, G%HI, tv%eqn_of_state, US) + call calculate_density(T_subML, S_subML, pRef_N2, rho_subML, tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) + call calculate_density(T_deeper, S_deeper, pRef_N2, rho_deeper, tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) 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 @@ -1006,7 +1011,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t 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), G%HI, tv%eqn_of_state, US=US) + dSV_dT(:,j,k), dSV_dS(:,j,k), tv%eqn_of_state, US=US, dom=EOS_domain(G%HI)) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo enddo pen_TKE_2d(:,:) = 0.0 @@ -1347,8 +1352,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, G%HI, & - tv%eqn_of_state, US) + call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, dRhodT, dRhodS, & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) ! 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 bdfb6b7a9e..607d02722f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -34,7 +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_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 @@ -2682,8 +2682,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo !$OMP parallel do default(shared) do j=js,je - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), G%HI, & - tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) 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 cde4b9e484..edad667592 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -298,7 +298,7 @@ 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, US=US) + call calculate_specific_vol_derivs(T0, S0, p_lay, dSV_dT, dSV_dS, tv%eqn_of_state, US=US) do k=1,nz dMass = GV%H_to_RZ * h_tr(k) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 8b5da8565b..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 diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 100e79aba2..7e8d306ff0 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 @@ -700,7 +700,8 @@ 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(:,j,k), tv%S(:,j,k), pres, Rcv, G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) 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,7 +785,8 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & else ! not bulkmixedlayer do k=K2,nz-1; - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) 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 @@ -849,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, G%HI, & - tv%eqn_of_state, US) + call calculate_density_derivs(T_eos, S_eos, pressure, dRho_dT, dRho_dS, & + tv%eqn_of_state, US, dom=EOS_domain(G%HI)) do i=is,ie if ((k>kmb) .and. (k @@ -213,7 +213,8 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo do j=js,je - call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), G%HI, tv%eqn_of_state, US) + call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) enddo call set_up_sponge_ML_density(tmp, G, CSp) diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index f33d772352..92b17e13fb 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 @@ -107,11 +107,13 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i 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), G%HI, tv%eqn_of_state, US) + call calculate_density(T_f(:,j,k), S_f(:,j,k), p_ref, Rcv(:,k), tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) enddo else do k=1,nz - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), tv%eqn_of_state, US, & + dom=EOS_domain(G%HI)) enddo endif From 415a6bce2e95fd55cd84e21987a52f53a34a677c Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 17 Apr 2020 15:48:22 +0000 Subject: [PATCH 40/55] Adds unit conversions to EOS type - As part of the process of disconnected EOS from the unit_scaling_type this adds the necessary unit conversions to the EOS_type. - Initialization is currently donne by passing US to MOM_init() but ultimately it seems passing p_scaling, etc., to MOM_init() would remove all dependency on US. - No APIs other than EOS_init() have been changed yet. --- src/core/MOM.F90 | 2 +- src/equation_of_state/MOM_EOS.F90 | 130 +++++++++++++++++------------- 2 files changed, 73 insertions(+), 59 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index efd4a80a52..f07fd6a1c4 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2242,7 +2242,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 diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 9788c84338..dc74e1dcf7 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -112,6 +112,13 @@ module MOM_EOS 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 !< A constant that translates distances in meters to the units of depth. + real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density. + real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed. + real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa. + ! logical :: test_EOS = .true. ! If true, test the equation of state end type EOS_type @@ -161,7 +168,7 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, US, scale if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -180,7 +187,7 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, US, scale end select if (present(US) .or. present(scale)) then - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R if (present(scale)) rho_scale = rho_scale * scale rho = rho_scale * rho endif @@ -210,7 +217,7 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_array called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -247,7 +254,7 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re end select endif - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + rho_scale = 1.0 ; if (present(US)) 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 ; rho(j) = rho_scale * rho(j) ; enddo @@ -281,15 +288,15 @@ subroutine calculate_density_HI_1d(T, S, pressure, rho, HI, EOS, US, halo) npts = HI%iec - HI%isc + 1 + 2*halo_sz is = HI%isc - halo_sz ; ie = HI%iec + halo_sz - if (US%RL2_T2_to_Pa == 1.0) then + if (EOS%RL2_T2_to_Pa == 1.0) then call calculate_density_array(T, S, pressure, rho, start, npts, EOS) else ! There is rescaling of variables, including pressure. - do i=is,ie ; pres(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo call calculate_density_array(T, S, pres, rho, start, npts, EOS) endif - if (US%kg_m3_to_R /= 1.0) then ; do i=is,ie - rho(i) = US%kg_m3_to_R * rho(i) + if (EOS%kg_m3_to_R /= 1.0) then ; do i=is,ie + rho(i) = EOS%kg_m3_to_R * rho(i) enddo ; endif end subroutine calculate_density_HI_1d @@ -361,18 +368,18 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, US, scale if (.not.associated(EOS)) call MOM_error(FATAL, & "calc_spec_vol_scalar called with an unassociated EOS_type EOS.") - pres(1) = pressure ; if (present(US)) pres(1) = US%RL2_T2_to_Pa*pressure + pres(1) = pressure ; if (present(US)) pres(1) = EOS%RL2_T2_to_Pa*pressure Ta(1) = T ; Sa(1) = S if (present(spv_ref)) then - spv_reference = spv_ref ; if (present(US)) spv_reference = US%kg_m3_to_R*spv_ref + spv_reference = spv_ref ; if (present(US)) 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 = 1.0 ; if (present(US)) spv_scale = US%R_to_kg_m3 + spv_scale = 1.0 ; if (present(US)) 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 @@ -454,20 +461,20 @@ subroutine calc_spec_vol_HI_1d(T, S, pressure, specvol, HI, EOS, US, halo, spv_r npts = HI%iec - HI%isc + 1 + 2*halo_sz is = HI%isc - halo_sz ; ie = HI%iec + halo_sz - if ((US%RL2_T2_to_Pa == 1.0) .and. (US%R_to_kg_m3 == 1.0)) then + if ((EOS%RL2_T2_to_Pa == 1.0) .and. (EOS%R_to_kg_m3 == 1.0)) then call calculate_spec_vol_array(T, S, pressure, specvol, start, 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo - spv_reference = US%kg_m3_to_R*spv_ref + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo + spv_reference = EOS%kg_m3_to_R*spv_ref call calculate_spec_vol_array(T, S, pres, specvol, start, 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) = US%RL2_T2_to_Pa * pressure(i) ; enddo + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo call calculate_spec_vol_array(T, S, pres, specvol, start, npts, EOS) endif - if (US%R_to_kg_m3 /= 1.0) then ; do i=is,ie - specvol(i) = US%R_to_kg_m3 * specvol(i) + if (EOS%R_to_kg_m3 /= 1.0) then ; do i=is,ie + specvol(i) = EOS%R_to_kg_m3 * specvol(i) enddo ; endif end subroutine calc_spec_vol_HI_1d @@ -578,7 +585,7 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -615,7 +622,7 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star end select endif - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + rho_scale = 1.0 ; if (present(US)) 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_dT(j) = rho_scale * drho_dT(j) @@ -652,16 +659,16 @@ subroutine calculate_density_derivs_HI_1d(T, S, pressure, drho_dT, drho_dS, HI, npts = HI%iec - HI%isc + 1 + 2*halo_sz is = HI%isc - halo_sz ; ie = HI%iec + halo_sz - if (US%RL2_T2_to_Pa == 1.0) then + if (EOS%RL2_T2_to_Pa == 1.0) then call calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS) else - do i=is,ie ; pres(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo + do i=is,ie ; pres(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo call calculate_density_derivs_array(T, S, pres, drho_dT, drho_dS, start, npts, EOS) endif - if (US%kg_m3_to_R /= 1.0) then ; do i=is,ie - drho_dT(i) = US%kg_m3_to_R * drho_dT(i) - drho_dS(i) = US%kg_m3_to_R * drho_dS(i) + if (EOS%kg_m3_to_R /= 1.0) then ; do i=is,ie + drho_dT(i) = EOS%kg_m3_to_R * drho_dT(i) + drho_dS(i) = EOS%kg_m3_to_R * drho_dS(i) enddo ; endif end subroutine calculate_density_derivs_HI_1d @@ -690,7 +697,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -704,7 +711,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS call MOM_error(FATAL, "calculate_density_derivs_scalar: EOS%form_of_EOS is not valid.") end select - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + rho_scale = 1.0 ; if (present(US)) 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 @@ -746,7 +753,7 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -779,7 +786,7 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh end select endif - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + rho_scale = 1.0 ; if (present(US)) 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) @@ -827,7 +834,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -843,7 +850,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") end select - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + rho_scale = 1.0 ; if (present(US)) 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 @@ -983,16 +990,16 @@ subroutine calc_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, EOS, U npts = HI%iec - HI%isc + 1 + 2*halo_sz is = HI%isc - halo_sz ; ie = HI%iec + halo_sz - if (US%RL2_T2_to_Pa == 1.0) then + if (EOS%RL2_T2_to_Pa == 1.0) then call calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS) else - do i=is,ie ; press(i) = US%RL2_T2_to_Pa * pressure(i) ; enddo + do i=is,ie ; press(i) = EOS%RL2_T2_to_Pa * pressure(i) ; enddo call calculate_spec_vol_derivs_array(T, S, press, dSV_dT, dSV_dS, start, npts, EOS) endif - if (US%R_to_kg_m3 /= 1.0) then ; do i=is,ie - dSV_dT(i) = US%R_to_kg_m3 * dSV_dT(i) - dSV_dS(i) = US%R_to_kg_m3 * dSV_dS(i) + if (EOS%R_to_kg_m3 /= 1.0) then ; do i=is,ie + dSV_dT(i) = EOS%R_to_kg_m3 * dSV_dT(i) + dSV_dS(i) = EOS%R_to_kg_m3 * dSV_dS(i) enddo ; endif end subroutine calc_spec_vol_derivs_HI_1d @@ -1141,8 +1148,8 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & else ; select case (EOS%form_of_EOS) case (EOS_LINEAR) if (present(US)) then - call int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, US%kg_m3_to_R*EOS%Rho_T0_S0, & - US%kg_m3_to_R*EOS%dRho_dT, US%kg_m3_to_R*EOS%dRho_dS, dza, & + 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) else @@ -1155,7 +1162,7 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & if (present(US)) then 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=US%R_to_kg_m3, pres_scale=US%RL2_T2_to_Pa) + SV_scale=EOS%R_to_kg_m3, pres_scale=EOS%RL2_T2_to_Pa) else 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) @@ -1227,7 +1234,7 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dp intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp, US) else ; select case (EOS%form_of_EOS) case (EOS_LINEAR) - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R + rho_scale = 1.0 ; if (present(US)) 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, & @@ -1238,8 +1245,8 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dp dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) endif case (EOS_WRIGHT) - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R - pres_scale = 1.0 ; if (present(US)) pres_scale = US%RL2_T2_to_Pa + rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R + pres_scale = 1.0 ; if (present(US)) 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, & @@ -1267,9 +1274,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. @@ -1363,6 +1372,11 @@ 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 end subroutine EOS_init @@ -1521,9 +1535,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 - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R - GxRho = G_e * rho_0 ; if (present(US)) GxRho = US%RL2_T2_to_Pa * G_e * rho_0 - rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * US%R_to_kg_m3 + rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R + GxRho = G_e * rho_0 ; if (present(US)) GxRho = EOS%RL2_T2_to_Pa * G_e * rho_0 + rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * EOS%R_to_kg_m3 I_Rho = 1.0 / rho_0 do_massWeight = .false. @@ -1748,9 +1762,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 - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R - GxRho = G_e * rho_0 ; if (present(US)) GxRho = US%RL2_T2_to_Pa * G_e * rho_0 - rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * US%R_to_kg_m3 + rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R + GxRho = G_e * rho_0 ; if (present(US)) GxRho = EOS%RL2_T2_to_Pa * G_e * rho_0 + rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * EOS%R_to_kg_m3 I_Rho = 1.0 / rho_0 massWeightToggle = 0. if (present(useMassWghtInterp)) then @@ -2020,7 +2034,7 @@ 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.0e-5*US%m_to_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) @@ -2197,9 +2211,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 - rho_scale = 1.0 ; if (present(US)) rho_scale = US%kg_m3_to_R - GxRho = G_e * rho_0 ; if (present(US)) GxRho = US%RL2_T2_to_Pa * G_e * rho_0 - rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * US%R_to_kg_m3 + rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R + GxRho = G_e * rho_0 ; if (present(US)) GxRho = EOS%RL2_T2_to_Pa * G_e * rho_0 + rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * EOS%R_to_kg_m3 I_Rho = 1.0 / rho_0 ! ============================= @@ -2639,9 +2653,9 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, 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 - SV_scale = 1.0 ; if (present(US)) SV_scale = US%R_to_kg_m3 - RL2_T2_to_Pa = 1.0 ; if (present(US)) RL2_T2_to_Pa = US%RL2_T2_to_Pa - alpha_ref_mks = alpha_ref ; if (present(US)) alpha_ref_mks = alpha_ref * US%kg_m3_to_R + SV_scale = 1.0 ; if (present(US)) SV_scale = EOS%R_to_kg_m3 + RL2_T2_to_Pa = 1.0 ; if (present(US)) RL2_T2_to_Pa = EOS%RL2_T2_to_Pa + alpha_ref_mks = alpha_ref ; if (present(US)) alpha_ref_mks = alpha_ref * EOS%kg_m3_to_R do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then @@ -2863,9 +2877,9 @@ 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 = 1.0 ; if (present(US)) SV_scale = US%R_to_kg_m3 - RL2_T2_to_Pa = 1.0 ; if (present(US)) RL2_T2_to_Pa = US%RL2_T2_to_Pa - alpha_ref_mks = alpha_ref ; if (present(US)) alpha_ref_mks = alpha_ref * US%kg_m3_to_R + SV_scale = 1.0 ; if (present(US)) SV_scale = EOS%R_to_kg_m3 + RL2_T2_to_Pa = 1.0 ; if (present(US)) RL2_T2_to_Pa = EOS%RL2_T2_to_Pa + alpha_ref_mks = alpha_ref ; if (present(US)) 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) From acf23a413a5b8c13f98ff387c9a3f0654414e30f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 17 Apr 2020 13:15:36 -0400 Subject: [PATCH 41/55] Use the 'dom=' interface to calculate_density Use the new variant of calculate_density with the 'dom' argument or no array extent argument in calls in 15 files. All answers are bitwise identical. --- src/ALE/MOM_regridding.F90 | 6 +-- src/ALE/coord_adapt.F90 | 10 ++-- src/core/MOM_PressureForce_Montgomery.F90 | 54 ++++++++++--------- src/core/MOM_PressureForce_analytic_FV.F90 | 30 ++++++----- src/core/MOM_PressureForce_blocked_AFV.F90 | 30 ++++++----- src/core/MOM_isopycnal_slopes.F90 | 21 +++++--- src/diagnostics/MOM_wave_speed.F90 | 8 +-- src/diagnostics/MOM_wave_structure.F90 | 4 +- .../MOM_coord_initialization.F90 | 4 +- .../MOM_state_initialization.F90 | 8 +-- .../lateral/MOM_thickness_diffuse.F90 | 24 ++++++--- .../vertical/MOM_geothermal.F90 | 8 +-- .../vertical/MOM_set_viscosity.F90 | 7 +-- src/user/DOME_initialization.F90 | 6 +-- src/user/benchmark_initialization.F90 | 6 +-- 15 files changed, 123 insertions(+), 103 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 1000ba0d32..f6791a3b73 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1889,8 +1889,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 @@ -1909,8 +1908,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. diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 98bbeb7b10..3a083af2db 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -156,7 +156,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) 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) + alpha, beta, tv%eqn_of_state, dom=(/2,nz/)) del2sigma(2:nz) = del2sigma(2:nz) + & (alpha(2:nz) * (tInt(i,j-1,2:nz) - tInt(i,j,2:nz)) + & @@ -168,7 +168,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) 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) + alpha, beta, tv%eqn_of_state, dom=(/2,nz/)) del2sigma(2:nz) = del2sigma(2:nz) + & (alpha(2:nz) * (tInt(i,j+1,2:nz) - tInt(i,j,2:nz)) + & @@ -180,7 +180,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) 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) + alpha, beta, tv%eqn_of_state, dom=(/2,nz/)) del2sigma(2:nz) = del2sigma(2:nz) + & (alpha(2:nz) * (tInt(i-1,j,2:nz) - tInt(i,j,2:nz)) + & @@ -192,7 +192,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) 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) + alpha, beta, tv%eqn_of_state, dom=(/2,nz/)) del2sigma(2:nz) = del2sigma(2:nz) + & (alpha(2:nz) * (tInt(i+1,j,2:nz) - tInt(i,j,2:nz)) + & @@ -206,7 +206,7 @@ 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) + alpha, beta, tv%eqn_of_state, dom=(/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))) / & diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 0d8cf27dad..618199dde1 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -124,12 +124,13 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb 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 :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, start, npts + 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 - start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 + 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 @@ -228,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(:), start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, US=US, dom=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) @@ -245,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, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_in_situ, & + tv%eqn_of_state, US=US, dom=EOSdom) do i=Isq,Ieq+1 ; alpha_star(i,j,k) = 1.0 / rho_in_situ(i) ; enddo enddo ; enddo endif ! use_EOS @@ -409,13 +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 :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, start, npts + 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 - start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 + 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 @@ -484,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(:), start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, US=US, dom=EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -505,8 +507,8 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! will come down with a fatal error if there is any compressibility. !$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), start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), & + tv%eqn_of_state, US=US, dom=EOSdom) do i=Isq,Ieq+1 ; rho_star(i,j,k) = G_Rho0*rho_star(i,j,k) ; enddo enddo ; enddo endif ! use_EOS @@ -632,10 +634,11 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) ! 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 :: Isq, Ieq, Jsq, Jeq, nz, i, j, k, start, npts + 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 - start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) Rho0xG = Rho0 * GV%g_Earth G_Rho0 = GV%g_Earth / GV%Rho0 @@ -662,8 +665,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) press(i) = -Rho0xG*e(i,j,1) enddo - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & + tv%eqn_of_state, US=US, dom=EOSdom) do i=Isq,Ieq+1 pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo @@ -673,8 +676,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) T_int(i) = 0.5*(tv%T(i,j,k-1)+tv%T(i,j,k)) S_int(i) = 0.5*(tv%S(i,j,k-1)+tv%S(i,j,k)) enddo - call calculate_density_derivs(T_int, S_int, press, dR_dT, dR_dS, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density_derivs(T_int, S_int, press, dR_dT, dR_dS, & + tv%eqn_of_state, US=US, dom=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)) * & @@ -733,10 +736,11 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) real :: dp_neglect ! A thickness that is so small it is usually lost ! 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 :: Isq, Ieq, Jsq, Jeq, nz, i, j, k, start, npts + 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 - start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 + EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) use_EOS = associated(tv%eqn_of_state) @@ -759,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, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv%T(:,j,nz), tv%S(:,j,nz), p(:,j,nz+1), rho_in_situ, & + tv%eqn_of_state, US=US, dom=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)) @@ -770,9 +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, start, npts, tv%eqn_of_state, US=US) - call calculate_density_derivs(T_int, S_int, p(:,j,k+1), dR_dT, dR_dS, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(T_int, S_int, p(:,j,k+1), rho_in_situ, tv%eqn_of_state, US=US, dom=EOSdom) + call calculate_density_derivs(T_int, S_int, p(:,j,k+1), dR_dT, dR_dS, & + tv%eqn_of_state, US=US, dom=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)) + & diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index f0a4485399..b32d81fdbc 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -176,13 +176,14 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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, start, npts + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb + integer, dimension(2) :: EOSdom 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 - start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 + 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.") @@ -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(:), start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, US=US, dom=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) @@ -334,8 +335,8 @@ 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, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), rho_in_situ, & + tv%eqn_of_state, US=US, dom=EOSdom) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -504,13 +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 :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, start, npts + 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 - start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 + 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.") @@ -578,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(:), start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, US=US, dom=EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -601,11 +603,11 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at !$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, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), rho_in_situ, & + tv%eqn_of_state, US=US, dom=EOSdom) else - call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, & + tv%eqn_of_state, US=US, dom=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) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 5ac7831479..8e2f3c1405 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -173,14 +173,15 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, 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, start, npts + 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 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 - start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 + 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.") @@ -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(:), start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, US=US, dom=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) @@ -302,8 +303,8 @@ 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, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), rho_in_situ, & + tv%eqn_of_state, US=US, dom=EOSdom) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -489,7 +490,8 @@ 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 :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, start, npts + 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 integer :: i, j, k, n, ib, jb @@ -497,7 +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 - start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 + 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.") @@ -565,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(:), start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, Rho_cv_BL(:), & + tv%eqn_of_state, US=US, dom=EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -588,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, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), rho_in_situ, & + tv%eqn_of_state, US=US, dom=EOSdom) else - call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, start, npts, & - tv%eqn_of_state, US=US) + call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, & + tv%eqn_of_state, US=US, dom=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) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 78fdc51077..42d8abe308 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -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 @@ -155,9 +156,11 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & enddo ; enddo enddo - !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,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, & @@ -175,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, US=US) + call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, drho_dS_u, & + tv%eqn_of_state, US=US, dom=EOSdom_u) endif do I=is-1,ie @@ -241,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, & @@ -261,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, US=US) + call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, tv%eqn_of_state, & + US=US, dom=EOSdom_v) endif do i=is,ie if (use_EOS) then diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 85dbcdc13b..e1835261aa 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -242,8 +242,8 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & 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, US) + call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, & + tv%eqn_of_state, US, dom=(/2,kf(i)/)) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. @@ -737,8 +737,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) 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, US) + call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, & + tv%eqn_of_state, US, dom=(/2,kf(i)/)) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index ceb6fd6c4f..bc5a06e0ea 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -277,8 +277,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo 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, US) + call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, & + tv%eqn_of_state, US, dom=(/2,kf(i)/)) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index b0155ae603..42a02a70ff 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -291,7 +291,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s ! 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, US=US) + call calculate_density(T0, S0, Pref, Rlay, eqn_of_state, US=US, dom=(/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)//'()') @@ -371,7 +371,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta 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, US=US) + call calculate_density(T0, S0, Pref, Rlay, eqn_of_state, US=US, dom=(/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) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 2ac8ac47bf..76e87aeed2 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1610,8 +1610,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, US=US) do k=1,nz S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS(k)) enddo @@ -1622,8 +1622,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, US=US) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 62f1dad445..49d1665b16 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -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 @@ -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,EOS_dom_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, US=US) + call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, drho_dS_u, & + tv%eqn_of_state, US=US, dom=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, & @@ -1030,7 +1036,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV S_v(i) = 0.25*((S(i,j,k) + S(i,j+1,k)) + (S(i,j,k-1) + S(i,j+1,k-1))) enddo call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, & - tv%eqn_of_state, US, dom=EOS_domain(G%HI)) + tv%eqn_of_state, US, dom=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 @@ -1262,7 +1269,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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, US=US) + tv%eqn_of_state, US=US, dom=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 @@ -1292,7 +1300,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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, & - tv%eqn_of_state, US, dom=EOS_domain(G%HI)) + tv%eqn_of_state, US, dom=EOSdom_v) endif do i=is,ie vhD(i,J,1) = -vhtot(i,J) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 9b91c6453a..289afd19d2 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -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, US=US) + call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_Ref(:), Rcv_BL(:), & + tv%eqn_of_state, US=US, dom=(/isj-(G%isd-1),iej-(G%isd-1)/)) else Rcv_BL(:) = -1.0 endif @@ -248,8 +248,8 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) Rcv, tv%eqn_of_state, US=US) 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, US=US) + call calculate_density_derivs(T2(:), S2(:), p_Ref(:), dRcv_dT_, dRcv_dS_, & + tv%eqn_of_state, US=US, dom=(/1,2/) ) dRcv_dT = 0.5*(dRcv_dT_(1) + dRcv_dT_(2)) endif diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index c628cfd1d3..fadc4874cd 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -273,7 +273,8 @@ 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 :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, m, n, K2, nkmb, nkml, start, npts + 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() @@ -292,7 +293,6 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (present(symmetrize)) then ; if (symmetrize) then Jsq = js-1 ; Isq = is-1 endif ; endif - start = Isq - (G%isd-1) ; npts = G%iec - Isq + 2 if (CS%debug) then call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) @@ -313,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 + 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 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, & - US=US, dom=(/start,start+npts-1/)) + US=US, dom=EOSdom) enddo ; enddo endif diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 315e56051c..de4726dd1d 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -360,12 +360,12 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! 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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, tv%eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, tv%eqn_of_state, US=US, dom=(/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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, tv%eqn_of_state, US=US) + call calculate_density(T0, S0, pres, rho_guess, tv%eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, tv%eqn_of_state, US=US) do k=1,nz ; T0(k) = T0(k) + (GV%Rlay(k)-rho_guess(k)) / drho_dT(k) ; enddo enddo diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 766474b364..ff76654b28 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -153,7 +153,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state enddo T0(k1) = 29.0 call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, US=US) + call calculate_density_derivs(T0(k1), S0(k1), pres(k1), drho_dT(k1), drho_dS(k1), eqn_of_state, US=US) ! A first guess of the layers' temperatures. do k=1,nz @@ -267,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, US=US) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo From 18d520e3c0da50955c9f0276c708c67bdb97952e Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 17 Apr 2020 17:16:49 +0000 Subject: [PATCH 42/55] Remove optional US from most MOM_EOS functions - Removes US as an argument wherever it was optional since the unit conversion factors are not stored in the EOS type. --- src/ALE/MOM_regridding.F90 | 6 +- src/ALE/coord_hycom.F90 | 6 +- src/ALE/coord_rho.F90 | 11 +- src/ALE/coord_slight.F90 | 12 +- src/core/MOM.F90 | 2 +- src/core/MOM_PressureForce_Montgomery.F90 | 20 +- src/core/MOM_PressureForce_analytic_FV.F90 | 22 +-- src/core/MOM_PressureForce_blocked_AFV.F90 | 18 +- src/core/MOM_forcing_type.F90 | 2 +- src/core/MOM_interface_heights.F90 | 4 +- src/core/MOM_isopycnal_slopes.F90 | 4 +- src/diagnostics/MOM_diagnostics.F90 | 12 +- src/diagnostics/MOM_wave_speed.F90 | 4 +- src/diagnostics/MOM_wave_structure.F90 | 2 +- src/equation_of_state/MOM_EOS.F90 | 178 +++++++----------- src/framework/MOM_diag_remap.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 4 +- .../MOM_coord_initialization.F90 | 6 +- .../MOM_state_initialization.F90 | 24 +-- .../lateral/MOM_mixed_layer_restrat.F90 | 8 +- .../lateral/MOM_thickness_diffuse.F90 | 8 +- .../vertical/MOM_bulk_mixed_layer.F90 | 8 +- .../vertical/MOM_diabatic_aux.F90 | 16 +- .../vertical/MOM_diabatic_driver.F90 | 2 +- .../vertical/MOM_diapyc_energy_req.F90 | 6 +- .../vertical/MOM_entrain_diffusive.F90 | 8 +- .../vertical/MOM_full_convection.F90 | 6 +- .../vertical/MOM_geothermal.F90 | 6 +- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_kappa_shear.F90 | 2 +- .../vertical/MOM_regularize_layers.F90 | 4 +- .../vertical/MOM_set_diffusivity.F90 | 10 +- .../vertical/MOM_set_viscosity.F90 | 12 +- src/tracer/MOM_neutral_diffusion.F90 | 20 +- src/tracer/MOM_tracer_Z_init.F90 | 8 +- src/tracer/MOM_tracer_hor_diff.F90 | 2 +- src/user/DOME_initialization.F90 | 8 +- src/user/ISOMIP_initialization.F90 | 12 +- src/user/RGC_initialization.F90 | 2 +- src/user/benchmark_initialization.F90 | 16 +- src/user/user_change_diffusivity.F90 | 4 +- 41 files changed, 231 insertions(+), 278 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 1000ba0d32..5ef65342e5 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1386,7 +1386,7 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS ) ! Local depth (G%bathyT is positive) nominalDepth = G%bathyT(i,j)*GV%Z_to_H - call build_rho_column(CS%rho_CS, US, nz, nominalDepth, h(i, j, :), & + call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i, j, :), & tv%T(i, j, :), tv%S(i, j, :), tv%eqn_of_state, zNew, & h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) @@ -1501,7 +1501,7 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS ) ( 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, US, tv%eqn_of_state, GV%ke, depth, & + 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, & z_col, z_col_new, zScale=GV%Z_to_H, & h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) @@ -1635,7 +1635,7 @@ subroutine build_grid_SLight(G, GV, US, h, tv, dzInterface, CS) ( 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, US, tv%eqn_of_state, GV%H_to_RZ*GV%g_Earth, & + 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) diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index bfcff9005c..064860301d 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -4,7 +4,6 @@ module coord_hycom ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, FATAL -use MOM_unit_scaling, only : unit_scale_type use MOM_EOS, only : EOS_type, calculate_density use regrid_interp, only : interp_CS_type, build_and_interpolate_grid @@ -96,10 +95,9 @@ subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, inter end subroutine set_hycom_params !> Build a HyCOM coordinate column -subroutine build_hycom1_column(CS, US, eqn_of_state, nz, depth, h, T, S, p_col, & +subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & z_col, z_col_new, zScale, h_neglect, h_neglect_edge) type(hycom_CS), intent(in) :: CS !< Coordinate control structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(EOS_type), pointer :: eqn_of_state !< Equation of state structure integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) @@ -133,7 +131,7 @@ subroutine build_hycom1_column(CS, US, 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, US=US) + call calculate_density(T, S, p_col, rho_col, 1, nz, 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 565656ecb0..0da2a33554 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -5,7 +5,6 @@ module coord_rho use MOM_error_handler, only : MOM_error, FATAL use MOM_remapping, only : remapping_CS, remapping_core_h -use MOM_unit_scaling, only : unit_scale_type use MOM_EOS, only : EOS_type, calculate_density use regrid_interp, only : interp_CS_type, build_and_interpolate_grid, DEGREE_MAX @@ -88,10 +87,9 @@ end subroutine set_rho_params !! !! 1. Density profiles are calculated on the source grid. !! 2. Positions of target densities (for interfaces) are found by interpolation. -subroutine build_rho_column(CS, US, nz, depth, h, T, S, eqn_of_state, z_interface, & +subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & h_neglect, h_neglect_edge) type(rho_CS), intent(in) :: CS !< coord_rho control structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: nz !< Number of levels on source grid (i.e. length of h, T, S) real, intent(in) :: depth !< Depth of ocean bottom (positive in m) real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] @@ -126,7 +124,7 @@ subroutine build_rho_column(CS, US, nz, depth, h, T, S, eqn_of_state, z_interfac ! Compute densities on source column pres(:) = CS%ref_pressure - call calculate_density(T, S, pres, densities, 1, nz, eqn_of_state, US=US) + call calculate_density(T, S, pres, densities, 1, nz, eqn_of_state) do k = 1,count_nonzero_layers densities(k) = densities(mapping(k)) enddo @@ -185,10 +183,9 @@ end subroutine build_rho_column !! 4. T & S are remapped onto the new grid. !! 5. Return to step 1 until convergence or until the maximum number of !! iterations is reached, whichever comes first. -subroutine build_rho_column_iteratively(CS, US, remapCS, nz, depth, h, T, S, eqn_of_state, & +subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_state, & zInterface, h_neglect, h_neglect_edge, dev_tol) type(rho_CS), intent(in) :: CS !< Regridding control structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom [Z ~> m] @@ -250,7 +247,7 @@ subroutine build_rho_column_iteratively(CS, US, remapCS, nz, depth, h, T, S, eqn enddo ! Compute densities within current water column - call calculate_density( T_tmp, S_tmp, pres, densities, 1, nz, eqn_of_state, US=US) + call calculate_density( T_tmp, S_tmp, pres, densities, 1, nz, 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 000315bae8..409b78c37c 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -4,7 +4,6 @@ module coord_slight ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, FATAL -use MOM_unit_scaling, only : unit_scale_type use MOM_EOS, only : EOS_type, calculate_compress use MOM_EOS, only : calculate_density, calculate_density_derivs use regrid_interp, only : interp_CS_type, regridding_set_ppolys @@ -178,11 +177,10 @@ 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, US, eqn_of_state, H_to_pres, 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(EOS_type), pointer :: eqn_of_state !< Equation of state structure 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] @@ -253,7 +251,7 @@ subroutine build_slight_column(CS, US, eqn_of_state, H_to_pres, 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, US=US) + call calculate_density(T_col, S_col, p_col, rho_col, 1, nz, eqn_of_state) ! Find the locations of the target potential densities, flagging ! locations in apparently unstable regions as not reliable. @@ -375,11 +373,11 @@ subroutine build_slight_column(CS, US, eqn_of_state, H_to_pres, H_subroundoff, & T_int(nz+1) = T_f(nz) ; S_int(nz+1) = S_f(nz) 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, 2, nz-1, & - eqn_of_state, US) + eqn_of_state) call calculate_density_derivs(T_int, S_int, p_R, drhoR_dT, drhoR_dS, 2, nz-1, & - eqn_of_state, US) + eqn_of_state) 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, US) + 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 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f07fd6a1c4..f25b8792f9 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2905,7 +2905,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) do j=js,je if (calc_rho) then call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), Rho_conv, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) 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 diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 0d8cf27dad..c8e94ca7d8 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -187,7 +187,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), & - 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=1, US=US) + 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 @@ -229,7 +229,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb 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(:), start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) 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) @@ -246,7 +246,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$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, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) do i=Isq,Ieq+1 ; alpha_star(i,j,k) = 1.0 / rho_in_situ(i) ; enddo enddo ; enddo endif ! use_EOS @@ -485,7 +485,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, 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(:), start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -506,7 +506,7 @@ 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), start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) do i=Isq,Ieq+1 ; rho_star(i,j,k) = G_Rho0*rho_star(i,j,k) ; enddo enddo ; enddo endif ! use_EOS @@ -663,7 +663,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, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) do i=Isq,Ieq+1 pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo @@ -674,7 +674,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, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) 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)) * & @@ -760,7 +760,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) !$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, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) 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)) @@ -770,9 +770,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, start, npts, tv%eqn_of_state, US=US) + call calculate_density(T_int, S_int, p(:,j,k+1), rho_in_situ, start, npts, tv%eqn_of_state) call calculate_density_derivs(T_int, S_int, p(:,j,k+1), dR_dT, dR_dS, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) 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)) + & diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index f0a4485399..bb5af350cb 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -229,7 +229,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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(:), start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) 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) @@ -266,21 +266,21 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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, US=US) + 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.") ! call int_spec_vol_dp_generic_ppm ( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & ! tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), p(:,:,K), p(:,:,K+1), & ! alpha_ref, G%HI, tv%eqn_of_state, dza(:,:,k), intp_dza(:,:,k), & - ! intx_dza(:,:,k), inty_dza(:,:,k), US=US) + ! intx_dza(:,:,k), inty_dza(:,:,k)) endif else call int_specific_vol_dp(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), p(:,:,K), & 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, US=US) + useMassWghtInterp=CS%useMassWghtInterp) endif else alpha_anom = 1.0 / GV%Rlay(k) - alpha_ref @@ -335,7 +335,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p !$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, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -579,7 +579,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at 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(:), start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -602,10 +602,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, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) else call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) @@ -670,17 +670,17 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at 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, US=US) + 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, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, dpa, & - intz_dpa, intx_dpa, inty_dpa, US=US) + 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, 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, US=US) + 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 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 5ac7831479..9c04ad9684 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -225,7 +225,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, 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(:), start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) 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,7 +249,7 @@ 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, US=US) + useMassWghtInterp=CS%useMassWghtInterp) else alpha_anom = 1.0 / GV%Rlay(k) - alpha_ref do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -303,7 +303,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, !$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, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -566,7 +566,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, 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(:), start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -589,10 +589,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, 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, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) else call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) endif do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) @@ -670,18 +670,18 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, 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, US=US) + 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, 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, US=US) + 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, 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, US=US) + G%bathyT, dz_neglect, CS%useMassWghtInterp) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%Z_to_H diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 12f165372b..d5a1fe3c79 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -954,7 +954,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! Density derivatives call calculate_density_derivs(Temp(:,j,1), Salt(:,j,1), pressure, dRhodT, dRhodS, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) ! 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 diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index bfb9ad2703..ea529d42c5 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -106,7 +106,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !$OMP do do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,K), p(:,:,K+1), & - 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo, US=US) + 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo) enddo !$OMP do do j=jsv,jev @@ -208,7 +208,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !$OMP do do k = 1, nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), 0.0, & - G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo, US=US) + G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=halo) enddo !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 78fdc51077..6cb7e049a6 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -176,7 +176,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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, US=US) + tv%eqn_of_state) endif do I=is-1,ie @@ -262,7 +262,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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, US=US) + tv%eqn_of_state) endif do i=is,ie if (use_EOS) then diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 94f6acc9c3..d653ddec6c 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -360,7 +360,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & 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, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) 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 @@ -466,7 +466,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !$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), G%HI, & - tv%eqn_of_state, US, halo=1) + tv%eqn_of_state, halo=1) 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 @@ -588,7 +588,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = 0. !$OMP parallel do default(shared) do k=1,nz ; do j=js,je - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), G%HI, tv%eqn_of_state) enddo ; enddo if (CS%id_rhopot0 > 0) call post_data(CS%id_rhopot0, Rcv, CS%diag) endif @@ -596,7 +596,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = 2.0e7*US%kg_m3_to_R*US%m_s_to_L_T**2 ! 2000 dbars !$OMP parallel do default(shared) do k=1,nz ; do j=js,je - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), G%HI, tv%eqn_of_state) enddo ; enddo if (CS%id_rhopot2 > 0) call post_data(CS%id_rhopot2, Rcv, CS%diag) endif @@ -606,7 +606,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & pressure_1d(:) = 0. ! Start at p=0 Pa at surface do k=1,nz pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure in middle of layer k - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), G%HI, tv%eqn_of_state) pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure at bottom of layer k enddo enddo @@ -839,7 +839,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) z_bot(i,j) = z_top(i,j) - GV%H_to_Z*h(i,j,k) enddo ; enddo call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), z_top, z_bot, 0.0, GV%Rho0, GV%g_Earth, & - G%HI, G%HI, tv%eqn_of_state, dpress, US=US) + G%HI, G%HI, tv%eqn_of_state, dpress) do j=js,je ; do i=is,ie mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth enddo ; enddo diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 85dbcdc13b..ce36835c1a 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -243,7 +243,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & 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, US) + kf(i)-1, tv%eqn_of_state) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. @@ -738,7 +738,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) 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, US) + kf(i)-1, tv%eqn_of_state) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index ceb6fd6c4f..69c5bcb44f 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -278,7 +278,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo 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, US) + kf(i)-1, tv%eqn_of_state) ! 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 dc74e1dcf7..11763e066a 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -114,10 +114,11 @@ module MOM_EOS ! Unit conversion factors (normally used for dimensional testing but could also allow for ! change of units of arguments to functions) - real :: m_to_Z !< A constant that translates distances in meters to the units of depth. - real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density. - real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed. - real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa. + real :: m_to_Z !< A constant that translates distances in meters to the units of depth. + real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density. + real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed. + real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa. + real :: L_T_to_m_s !< 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 @@ -151,14 +152,13 @@ module MOM_EOS !! 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, US, scale) +subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] type(EOS_type), pointer :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density in !! combination with scaling given by US [various] @@ -168,7 +168,7 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, US, scale if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa + p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -186,17 +186,15 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, US, scale call MOM_error(FATAL, "calculate_density_scalar: EOS is not valid.") end select - if (present(US) .or. present(scale)) then - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R - if (present(scale)) rho_scale = rho_scale * scale - rho = rho_scale * rho - 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 !> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. -subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref, US, scale) +subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] @@ -205,7 +203,6 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re integer, intent(in) :: npts !< Number of point to compute type(EOS_type), pointer :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] @@ -217,7 +214,7 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_array called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa + p_scale = EOS%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -254,7 +251,7 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re end select endif - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R + 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 ; rho(j) = rho_scale * rho(j) ; enddo @@ -265,14 +262,13 @@ end subroutine calculate_density_array !> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs !! using array extents determined from a hor_index_type. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. -subroutine calculate_density_HI_1d(T, S, pressure, rho, HI, EOS, US, halo) +subroutine calculate_density_HI_1d(T, S, pressure, rho, HI, EOS, halo) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] real, dimension(HI%isd:HI%ied), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied), intent(inout) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] type(EOS_type), pointer :: EOS !< Equation of state structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. ! Local variables @@ -350,14 +346,13 @@ 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, US, scale) +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] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] @@ -368,18 +363,18 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, US, scale if (.not.associated(EOS)) call MOM_error(FATAL, & "calc_spec_vol_scalar called with an unassociated EOS_type EOS.") - pres(1) = pressure ; if (present(US)) pres(1) = EOS%RL2_T2_to_Pa*pressure + pres(1) = EOS%RL2_T2_to_Pa*pressure Ta(1) = T ; Sa(1) = S if (present(spv_ref)) then - spv_reference = spv_ref ; if (present(US)) spv_reference = EOS%kg_m3_to_R*spv_ref + 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 = 1.0 ; if (present(US)) spv_scale = EOS%R_to_kg_m3 + 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 @@ -436,14 +431,13 @@ end subroutine calc_spec_vol_US !> Calls the appropriate subroutine to calculate the specific volume of sea water for 1-D array !! inputs using array extents determined from a hor_index_type. -subroutine calc_spec_vol_HI_1d(T, S, pressure, specvol, HI, EOS, US, halo, spv_ref) +subroutine calc_spec_vol_HI_1d(T, S, pressure, specvol, HI, EOS, halo, spv_ref) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] real, dimension(HI%isd:HI%ied), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(HI%isd:HI%ied), intent(inout) :: specvol !< In situ specific volume [R-1 ~> m3 kg-1] type(EOS_type), pointer :: EOS !< Equation of state structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1] @@ -561,7 +555,7 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca end subroutine calculate_TFreeze_array !> Calls the appropriate subroutine to calculate density derivatives for 1-D array inputs. -subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS, US, scale) +subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] @@ -572,7 +566,6 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] @@ -585,7 +578,7 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa + p_scale = EOS%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -622,7 +615,7 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star end select endif - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R + 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_dT(j) = rho_scale * drho_dT(j) @@ -633,7 +626,7 @@ end subroutine calculate_density_derivs_array !> Calls the appropriate subroutine to calculate density derivatives for 1-D array inputs. -subroutine calculate_density_derivs_HI_1d(T, S, pressure, drho_dT, drho_dS, HI, EOS, US, halo) +subroutine calculate_density_derivs_HI_1d(T, S, pressure, drho_dT, drho_dS, HI, EOS, halo) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] @@ -643,7 +636,6 @@ subroutine calculate_density_derivs_HI_1d(T, S, pressure, drho_dT, drho_dS, HI, real, dimension(HI%isd:HI%ied), 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. ! Local variables @@ -676,7 +668,7 @@ end subroutine calculate_density_derivs_HI_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, US, scale) +subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] @@ -685,10 +677,8 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS 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 - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] - ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] @@ -697,7 +687,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa + p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -711,7 +701,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS call MOM_error(FATAL, "calculate_density_derivs_scalar: EOS%form_of_EOS is not valid.") end select - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R + 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 @@ -722,7 +712,7 @@ end subroutine calculate_density_derivs_scalar !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs. subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & - drho_dS_dP, drho_dT_dP, start, npts, EOS, US, scale) + drho_dS_dP, drho_dT_dP, start, npts, EOS, scale) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] @@ -739,10 +729,8 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh 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 - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type 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] @@ -753,7 +741,7 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa + p_scale = EOS%RL2_T2_to_Pa if (p_scale == 1.0) then select case (EOS%form_of_EOS) @@ -786,7 +774,7 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh end select endif - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R + 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) @@ -808,7 +796,7 @@ end subroutine calculate_density_second_derivs_array !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & - drho_dS_dP, drho_dT_dP, EOS, US, scale) + drho_dS_dP, drho_dT_dP, EOS, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] @@ -823,7 +811,6 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] type(EOS_type), pointer :: EOS !< Equation of state structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -834,7 +821,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(US)) p_scale = EOS%RL2_T2_to_Pa + p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -850,7 +837,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr call MOM_error(FATAL, "calculate_density_derivs: EOS%form_of_EOS is not valid.") end select - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R + 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 @@ -964,7 +951,7 @@ end subroutine calc_spec_vol_derivs_US !> Calls the appropriate subroutine to calculate specific volume derivatives for array inputs !! using array extents determined from a hor_index_type.. -subroutine calc_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, EOS, US, halo) +subroutine calc_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, EOS, halo) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(HI%isd:HI%ied), intent(in) :: S !< Salinity [ppt] @@ -974,7 +961,6 @@ subroutine calc_spec_vol_derivs_HI_1d(T, S, pressure, dSV_dT, dSV_dS, HI, EOS, U real, dimension(HI%isd:HI%ied), 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The halo size to work on; missing is equivalent to 0. ! Local variables @@ -1007,7 +993,7 @@ end subroutine calc_spec_vol_derivs_HI_1d !> Calls the appropriate subroutine to calculate the density and compressibility for 1-D array !! inputs. If US is present, the units of the inputs and outputs are rescaled. -subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS, US) +subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(:), intent(in) :: S !< Salinity [PSU] real, dimension(:), intent(in) :: press !< Pressure [Pa] or [R L2 T-2 ~> Pa] @@ -1018,7 +1004,6 @@ subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS, 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 - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real, dimension(size(press)) :: pressure ! Pressure converted to [Pa] @@ -1028,11 +1013,7 @@ subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS, "calculate_compress called with an unassociated EOS_type EOS.") is = start ; ie = is + npts - 1 - if (present(US)) then - do i=is,ie ; pressure(i) = US%RL2_T2_to_Pa * press(i) ; enddo - else - do i=is,ie ; pressure(i) = press(i) ; enddo - endif + do i=is,ie ; pressure(i) = EOS%RL2_T2_to_Pa * press(i) ; enddo select case (EOS%form_of_EOS) case (EOS_LINEAR) @@ -1050,21 +1031,19 @@ subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS, call MOM_error(FATAL, "calculate_compress: EOS%form_of_EOS is not valid.") end select - if (present(US)) then - if (US%kg_m3_to_R /= 1.0) then ; do i=is,ie - rho(i) = US%kg_m3_to_R * rho(i) - enddo ; endif - if (US%L_T_to_m_s /= 1.0) then ; do i=is,ie - drho_dp(i) = US%L_T_to_m_s**2 * drho_dp(i) - enddo ; endif - endif + 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. If US is present, the units of !! the inputs and outputs are rescaled. -subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS, US) +subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] @@ -1072,7 +1051,6 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS, US) 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 - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa @@ -1080,7 +1058,7 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS, US) "calculate_compress called with an unassociated EOS_type EOS.") Ta(1) = T ; Sa(1) = S; pa(1) = pressure - call calculate_compress_array(Ta, Sa, pa, rhoa, drho_dpa, 1, 1, EOS, US) + call calculate_compress_array(Ta, Sa, pa, rhoa, drho_dpa, 1, 1, EOS) rho = rhoa(1) ; drho_dp = drho_dpa(1) end subroutine calculate_compress_scalar @@ -1094,7 +1072,7 @@ end subroutine calculate_compress_scalar !! series for log(1-eps/1+eps) that assumes that |eps| < . 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, US) + bathyP, dP_tiny, useMassWghtInterp) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature referenced to the surface [degC] @@ -1131,8 +1109,6 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & !! 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. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type - ! 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 @@ -1144,33 +1120,21 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & if (EOS%EOS_quadrature) then 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, & - bathyP, dP_tiny, useMassWghtInterp, US) + bathyP, dP_tiny, useMassWghtInterp) else ; select case (EOS%form_of_EOS) case (EOS_LINEAR) - if (present(US)) then - 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) - else - 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) - endif + 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) - if (present(US)) then - 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) - else - 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) - endif + 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, & - bathyP, dP_tiny, useMassWghtInterp, US) + bathyP, dP_tiny, useMassWghtInterp) end select ; endif end subroutine int_specific_vol_dp @@ -1179,7 +1143,7 @@ end subroutine int_specific_vol_dp !! 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, US) + 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), & @@ -1219,8 +1183,6 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dp 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. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type - ! 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] @@ -1231,10 +1193,10 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dp 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, US) + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) else ; select case (EOS%form_of_EOS) case (EOS_LINEAR) - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R + 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, & @@ -1245,8 +1207,8 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dp dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) endif case (EOS_WRIGHT) - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R - pres_scale = 1.0 ; if (present(US)) pres_scale = EOS%RL2_T2_to_Pa + 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, & @@ -1258,7 +1220,7 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, dp 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, US) + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) end select ; endif end subroutine int_density_dz @@ -1377,6 +1339,7 @@ subroutine EOS_init(param_file, EOS, US) 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 @@ -1459,7 +1422,7 @@ end subroutine EOS_use_linear !! finite-volume form pressure accelerations in a Boussinesq model. subroutine 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, US) + bathyT, dz_neglect, useMassWghtInterp) 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), & @@ -1499,8 +1462,6 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, 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. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type - ! 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] @@ -1535,9 +1496,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 - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R - GxRho = G_e * rho_0 ; if (present(US)) GxRho = EOS%RL2_T2_to_Pa * G_e * rho_0 - rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * EOS%R_to_kg_m3 + 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. @@ -1668,7 +1629,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, US) + 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), & @@ -1708,7 +1669,6 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & !! 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. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine calculates (by numerical quadrature) integrals of ! pressure anomalies across layers, which are required for calculating the @@ -1762,9 +1722,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 - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R - GxRho = G_e * rho_0 ; if (present(US)) GxRho = EOS%RL2_T2_to_Pa * G_e * rho_0 - rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * EOS%R_to_kg_m3 + 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 @@ -2102,7 +2062,7 @@ 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, US=US) + call calculate_density_array(T5, S5, p5, rho5, 1, 5, EOS) rho5(:) = rho5(:) !- rho_ref ! Work with anomalies relative to rho_ref ! Use Bode's rule to estimate the average density diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 83a7ce207c..cadd74950a 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -327,7 +327,7 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state) GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then !### I think that the conversion factor in the 2nd line should be GV%Z_to_H - call build_rho_column(get_rho_CS(remap_cs%regrid_cs), US, G%ke, & + call build_rho_column(get_rho_CS(remap_cs%regrid_cs), G%ke, & US%Z_to_m*G%bathyT(i,j), h(i,j,:), T(i,j,:), S(i,j,:), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 858af4e1ea..ad133cc4ab 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -376,9 +376,9 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) ! Calculate insitu densities and expansion coefficients call calculate_density(state%sst(:,j), state%sss(:,j), p_int, Rhoml(:), G%HI, & - CS%eqn_of_state, US) + CS%eqn_of_state) call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, dR0_dT, dR0_dS, G%HI, & - CS%eqn_of_state, US) + CS%eqn_of_state) do i=is,ie if ((state%ocean_mass(i,j) > US%RZ_to_kg_m2*CS%col_mass_melt_threshold) .and. & diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index b0155ae603..a70e761fa8 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -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, US=US) + 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 @@ -291,7 +291,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s ! 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, US=US) + call calculate_density(T0, S0, Pref, Rlay, 1, nz, eqn_of_state) do k=2,nz; g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) ; enddo call callTree_leave(trim(mdl)//'()') @@ -371,7 +371,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta 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, US=US) + call calculate_density(T0, S0, Pref, Rlay, k_light, nz-k_light+1, eqn_of_state) ! 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) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 2efceb5991..4ff22d202b 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -960,7 +960,7 @@ subroutine convert_thickness(h, G, GV, US, tv) 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, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) do i=is,ie p_bot(i,j) = p_top(i,j) + HR_to_pres * (h(i,j,k) * rho(i)) enddo @@ -968,10 +968,10 @@ subroutine convert_thickness(h, G, GV, US, tv) 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, US=US) + 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, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) ! Use Newton's method to correct the bottom value. ! The hydrostatic equation is sufficiently linear that no bounds-checking is needed. do i=is,ie @@ -1600,8 +1600,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, eqn_of_state, US=US) + 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, 1, 1, eqn_of_state) if (fit_salin) then ! A first guess of the layers' temperatures. @@ -1610,8 +1610,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state) do k=1,nz S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS(k)) enddo @@ -1622,8 +1622,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -1869,7 +1869,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, C 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), G%HI, tv%eqn_of_state, US) + call calculate_density(tmp(:,j,1), tmp2(:,j,1), pres, tmp_2d(:,j), G%HI, tv%eqn_of_state) enddo call set_up_sponge_ML_density(tmp_2d, G, CSp) @@ -2188,7 +2188,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param press(:) = tv%P_Ref do k=1,kd ; do j=js,je - call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), G%HI, eos, US) + call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), G%HI, eos) enddo ; enddo call pass_var(temp_z,G%Domain) @@ -2449,7 +2449,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) 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, US=US) + rho(k), tv%eqn_of_state) P_tot = P_tot + GV%g_Earth * rho(k) * GV%H_to_Z*h(k) enddo diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 744a801391..37f9cf2684 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -208,7 +208,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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, G%HI, & - tv%eqn_of_state, US, halo=1) + tv%eqn_of_state, halo=1) deltaRhoAtK(:) = 0. MLD_fast(:,j) = 0. do k = 2, nz @@ -217,7 +217,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! 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, G%HI, & - tv%eqn_of_state, US, halo=1) + tv%eqn_of_state, halo=1) do i = is-1,ie+1 deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface enddo @@ -322,7 +322,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(:), G%HI, tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml(:), G%HI, tv%eqn_of_state, halo=1) line_is_empty = .true. do i=is-1,ie+1 if (htot_fast(i,j) < MLD_fast(i,j)) then @@ -646,7 +646,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(:), G%HI, tv%eqn_of_state, US, halo=1) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, Rho0(:), G%HI, tv%eqn_of_state, halo=1) 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 4d42f05629..39884968f3 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -779,7 +779,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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, US=US) + drho_dS_u, (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state) endif do I=is-1,ie @@ -1030,7 +1030,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) endif do i=is,ie if (calc_derivatives) then @@ -1262,7 +1262,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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, US=US) + (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state) endif do I=is-1,ie uhD(I,j,1) = -uhtot(I,j) @@ -1292,7 +1292,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) endif do i=is,ie vhD(i,J,1) = -vhtot(i,J) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index cc3a6e3f69..ff915222bf 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -466,12 +466,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C do k=1,CS%nkml ; do i=is,ie 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, G%HI, tv%eqn_of_state, US) + call calculate_density_derivs(T(:,1), S(:,1), p_ref, dR0_dT, dR0_dS, G%HI, tv%eqn_of_state) call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) do k=1,nz - call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), G%HI, tv%eqn_of_state, US) - call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), G%HI, tv%eqn_of_state, US) + call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), G%HI, tv%eqn_of_state) + call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), G%HI, tv%eqn_of_state) 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 3cde9ce91e..8eb702d45d 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -446,7 +446,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), G%HI, tv%eqn_of_state, US) + call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), G%HI, tv%eqn_of_state) enddo ! First, try to find an interior layer where inserting all the salt @@ -457,7 +457,7 @@ subroutine insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS, dt, id_brine_lay) if ((G%mask2dT(i,j) > 0.0) .and. dzbr(i) < brine_dz .and. salt(i) > 0.) then s_new = S(i,k) + salt(i) / (GV%H_to_RZ * h_2d(i,k)) t0 = T(i,k) - call calculate_density(t0, s_new, tv%P_Ref, R_new, tv%eqn_of_state, US=US) + call calculate_density(t0, s_new, tv%P_Ref, R_new, tv%eqn_of_state) if (R_new < 0.5*(Rcv(i,k)+Rcv(i,k+1)) .and. s_new0.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 @@ -1006,7 +1006,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t 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), G%HI, tv%eqn_of_state, US=US) + dSV_dT(:,j,k), dSV_dS(:,j,k), G%HI, tv%eqn_of_state) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo enddo pen_TKE_2d(:,:) = 0.0 @@ -1348,7 +1348,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Density derivatives call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, dRhodT, dRhodS, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) ! 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 bdfb6b7a9e..5301fb5603 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2683,7 +2683,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e !$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), G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) 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 cde4b9e484..21eb272d70 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -298,7 +298,7 @@ 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, US=US) + call calculate_specific_vol_derivs(T0, S0, p_lay, dSV_dT, dSV_dS, 1, nz, tv%eqn_of_state) do k=1,nz dMass = GV%H_to_RZ * h_tr(k) @@ -939,7 +939,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & N2(1) = 0.0 ; N2(nz+1) = 0.0 do K=2,nz call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), & - pres(K), rho_here, tv%eqn_of_state, US=US) + pres(K), rho_here, tv%eqn_of_state) N2(K) = ((US%L_to_Z**2*GV%g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) @@ -950,7 +950,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & N2(1) = 0.0 ; N2(nz+1) = 0.0 do K=2,nz call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), & - pres(K), rho_here, tv%eqn_of_state, US=US) + pres(K), rho_here, tv%eqn_of_state) N2(K) = ((US%L_to_Z**2*GV%g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 100e79aba2..a44dc5c744 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -700,7 +700,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(:,j,k), tv%S(:,j,k), pres, Rcv, G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, G%HI, tv%eqn_of_state) 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,7 +784,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & else ! not bulkmixedlayer do k=K2,nz-1; - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, G%HI, tv%eqn_of_state) 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 @@ -850,7 +850,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & endif enddo call calculate_density_derivs(T_eos, S_eos, pressure, dRho_dT, dRho_dS, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) do i=is,ie if ((k>kmb) .and. (k 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, US=US) + tv%eqn_of_state) 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, US=US) + 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, US=US) + tv%eqn_of_state) 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 3ba5520117..d366cb93d8 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -210,7 +210,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) 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(:), G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) 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) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 5e11ecee60..73a170eae2 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -911,7 +911,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & 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, US=US, scale=-g_R0) + tv%eqn_of_state, scale=-g_R0) else do K=1,nzc+1 ; dbuoy_dT(K) = -g_R0 ; dbuoy_dS(K) = 0.0 ; enddo endif diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 43ba5211f7..e037697353 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -312,7 +312,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) 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, G%HI, tv%eqn_of_state, US) +! call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, G%HI, tv%eqn_of_state) ! 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 @@ -444,7 +444,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), G%HI, tv%eqn_of_state, US) + call calculate_density(T_2d(:,k), S_2d(:,k), p_ref_cv, Rcv(:,k), G%HI, tv%eqn_of_state) 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 a65be62b3a..b333f04a62 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -715,10 +715,10 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & do i=is,ie ; p_0(i) = 0.0 ; p_ref(i) = tv%P_Ref ; enddo do k=1,nz call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_0, rho_0(:,k), G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) enddo call calculate_density(tv%T(:,j,kmb), tv%S(:,j,kmb), p_ref, Rcv_kmb, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) kb_min = kmb+1 do i=is,ie @@ -907,7 +907,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & 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), G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) 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) @@ -1066,7 +1066,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) 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, G%HI, & - tv%eqn_of_state, US) + tv%eqn_of_state) do i=is,ie alpha_dT = -1.0*dRho_dT(i) * (T_f(i,j,k-1) - T_f(i,j,k)) @@ -1819,7 +1819,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo do k=1,kmb - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), G%HI, tv%eqn_of_state) enddo do i=is,ie if (kb(i) <= nz-1) then diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 4cd6a64684..6a2ce60f96 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -317,7 +317,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) !$OMP parallel do default(shared) 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), start, npts, & - tv%eqn_of_state, US=US) + tv%eqn_of_state) enddo ; enddo endif @@ -574,7 +574,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) 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, US=US) + is-G%IsdB+1, ie-is+1, tv%eqn_of_state) endif do i=is,ie ; if (do_i(i)) then @@ -1278,7 +1278,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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, US=US) + Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1399,7 +1399,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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, US=US) + Isq-G%IsdB+1, Ieq-Isq+1, tv%eqn_of_state) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1515,7 +1515,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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, US=US) + is-G%IsdB+1, ie-is+1, tv%eqn_of_state) endif do i=is,ie ; if (do_i(i)) then @@ -1636,7 +1636,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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, US=US) + is-G%IsdB+1, ie-is+1, tv%eqn_of_state) endif do i=is,ie ; if (do_i(i)) then diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 6a109b7cba..e193ac9023 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -8,7 +8,7 @@ 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 : EOS_type, EOS_manual_init, calculate_density_derivs use MOM_EOS, only : calculate_density, calculate_density_second_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 @@ -391,18 +391,18 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) 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, US) + CS%dRdT(:,j,k), CS%dRdS(:,j,k), G%isc-1, G%iec-G%isc+3, CS%EOS) 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, US) + 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) ref_pres(:) = CS%Pint(:,j,k+1) ! 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, US) + CS%dRdT_i(:,j,k,2), CS%dRdS_i(:,j,k,2), G%isc-1, G%iec-G%isc+3, CS%EOS) enddo endif enddo @@ -1767,19 +1767,19 @@ subroutine calc_delta_rho_and_derivs(CS, US, 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, US=US ) - call calculate_density( T2, S2, pmid, rho2, CS%EOS, US=US ) + 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 pmid = 0.5 * (p1 + p2) if (CS%ref_pres>=0) pmid = CS%ref_pres - call calculate_density_derivs(T1, S1, pmid, drdt1, drds1, CS%EOS, US) - call calculate_density_derivs(T2, S2, pmid, drdt2, drds2, CS%EOS, US) + 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) elseif (TRIM(CS%delta_rho_form) == 'local_pressure') then - call calculate_density_derivs(T1, S1, p1, drdt1, drds1, CS%EOS, US) - call calculate_density_derivs(T2, S2, p2, drdt2, drds2, CS%EOS, US) + 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) else call MOM_error(FATAL, "delta_rho_form is not recognized") diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 76ca2dac4a..c2748544c8 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -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, US=US) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, & - eos, US=US) + eos) 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, US=US) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, & - eos, US=US) + eos) 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 6064589019..30a71951ba 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -701,7 +701,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & !$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), G%HI, & - tv%eqn_of_state, US, halo=2) + tv%eqn_of_state, halo=2) enddo ; enddo do j=js-2,je+2 ; do i=is-2,ie+2 diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 315e56051c..8330078555 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, tv%eqn_of_state, US=US) + 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, 1, 1, tv%eqn_of_state) 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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, tv%eqn_of_state, US=US) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, tv%eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, 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 c189cf0490..9f677f4e98 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -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, US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, eqn_of_state) ! 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), pres(1), rho_guess(1), eqn_of_state, US=US) + 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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, 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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, 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/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index 6dbee6cea7..61ccbf51ff 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -213,7 +213,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo do j=js,je - call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), G%HI, tv%eqn_of_state, US) + call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), G%HI, tv%eqn_of_state) enddo call set_up_sponge_ML_density(tmp, G, CSp) diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 766474b364..492e51374c 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -152,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, US=US) + 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, k1, 1, eqn_of_state) ! A first guess of the layers' temperatures. do k=1,nz @@ -162,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -257,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, US=US) + 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, k1, 1, eqn_of_state) ! A first guess of the layers' temperatures. ! do k=1,nz @@ -267,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, 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/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index f33d772352..834a624b7e 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -107,11 +107,11 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i 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), G%HI, tv%eqn_of_state, US) + call calculate_density(T_f(:,j,k), S_f(:,j,k), p_ref, Rcv(:,k), G%HI, tv%eqn_of_state) enddo else do k=1,nz - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), G%HI, tv%eqn_of_state, US) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), G%HI, tv%eqn_of_state) enddo endif From 4f42d7278ca6321bccb6b3cbe37d85ff6626256f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 17 Apr 2020 13:36:09 -0400 Subject: [PATCH 43/55] Fixed the spelling in an openMP directive --- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 49d1665b16..1b57cf9ec0 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -757,7 +757,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$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,EOS_dom_u, & +!$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, & From 0caf9ccabee4f0c9a351ddc6868c263eedf99c45 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 17 Apr 2020 18:56:35 +0000 Subject: [PATCH 44/55] Missed a conflict resolution --- src/equation_of_state/MOM_EOS.F90 | 41 ++++++++++++++----------------- 1 file changed, 18 insertions(+), 23 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index e74ace5de8..0623f955cf 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -607,7 +607,7 @@ 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, US, dom, scale) +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] @@ -616,7 +616,6 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, US 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 - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type 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 @@ -636,7 +635,7 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, US is = 1 ; ie = size(drho_dT) ; npts = 1 + ie - is endif - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + 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) @@ -645,7 +644,7 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, US call calculate_density_derivs_array(T, S, pres, drho_dT, drho_dS, is, npts, EOS) endif - rho_scale = US%kg_m3_to_R + 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) @@ -897,7 +896,7 @@ 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, US, dom, scale) +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] @@ -906,7 +905,6 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, US, dom, 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 - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type 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 @@ -926,7 +924,7 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, US, dom, else is = 1 ; ie = size(dSV_dT) ; npts = 1 + ie - is endif - p_scale = 1.0 ; if (present(US)) p_scale = US%RL2_T2_to_Pa + 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) @@ -935,7 +933,7 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, US, dom, call calculate_spec_vol_derivs_array(T, S, press, dSV_dT, dSV_dS, is, npts, EOS) endif - spv_scale = US%R_to_kg_m3 + 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) @@ -2051,7 +2049,7 @@ end function frac_dp_at_pos !! 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, US) + 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 @@ -2091,7 +2089,6 @@ subroutine int_density_dz_generic_ppm(T, T_t, T_b, S, S_t, S_b, & 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] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine calculates (by numerical quadrature) integrals of ! pressure anomalies across layers, which are required for calculating the @@ -2144,9 +2141,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 - rho_scale = 1.0 ; if (present(US)) rho_scale = EOS%kg_m3_to_R - GxRho = G_e * rho_0 ; if (present(US)) GxRho = EOS%RL2_T2_to_Pa * G_e * rho_0 - rho_ref_mks = rho_ref ; if (present(US)) rho_ref_mks = rho_ref * EOS%R_to_kg_m3 + 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 ! ============================= @@ -2509,7 +2506,7 @@ end subroutine evaluate_shape_quadratic !! 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, & - bathyP, dP_neglect, useMassWghtInterp, US) + 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] @@ -2547,7 +2544,6 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, dza, & !! 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. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine calculates analytical and nearly-analytical integrals in ! pressure across layers of geopotential anomalies, which are required for @@ -2586,9 +2582,9 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, 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 - SV_scale = 1.0 ; if (present(US)) SV_scale = EOS%R_to_kg_m3 - RL2_T2_to_Pa = 1.0 ; if (present(US)) RL2_T2_to_Pa = EOS%RL2_T2_to_Pa - alpha_ref_mks = alpha_ref ; if (present(US)) alpha_ref_mks = alpha_ref * EOS%kg_m3_to_R + 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 @@ -2724,7 +2720,7 @@ end subroutine int_spec_vol_dp_generic !! no free assumptions, apart from the use of Bode's rule quadrature to do the integrals. subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, & dP_neglect, bathyP, HI, EOS, dza, & - intp_dza, intx_dza, inty_dza, useMassWghtInterp, US) + 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] @@ -2765,7 +2761,6 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, !! 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. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine calculates analytical and nearly-analytical integrals in ! pressure across layers of geopotential anomalies, which are required for @@ -2810,9 +2805,9 @@ 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 = 1.0 ; if (present(US)) SV_scale = EOS%R_to_kg_m3 - RL2_T2_to_Pa = 1.0 ; if (present(US)) RL2_T2_to_Pa = EOS%RL2_T2_to_Pa - alpha_ref_mks = alpha_ref ; if (present(US)) alpha_ref_mks = alpha_ref * EOS%kg_m3_to_R + 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) From 371ed85ca4abc1a6c865573cd11bf361393538cd Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 17 Apr 2020 19:29:12 +0000 Subject: [PATCH 45/55] Initialize scaling params without EOS_init() --- src/equation_of_state/MOM_EOS.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 0623f955cf..034912b9ff 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -115,11 +115,11 @@ module MOM_EOS ! Unit conversion factors (normally used for dimensional testing but could also allow for ! change of units of arguments to functions) - real :: m_to_Z !< A constant that translates distances in meters to the units of depth. - real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density. - real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed. - real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa. - real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1. + 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 From 9b53927c1fec2d76b4c62096f3c0cafcbeea072d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 17 Apr 2020 19:52:15 -0400 Subject: [PATCH 46/55] Rescaled internal MOM_CVMix variables Applied dimensional rescaling to many of the internal calculations in the 4 MOM_CVMix files, although calls to external CVMix routines still use the original MKS units. These changes include rescaling of the input and output variables associated with the calculate_density routines. All answers are bitwise identical. --- .../vertical/MOM_CVMix_KPP.F90 | 110 +++--------------- .../vertical/MOM_CVMix_conv.F90 | 19 +-- .../vertical/MOM_CVMix_ddiff.F90 | 34 +++--- .../vertical/MOM_CVMix_shear.F90 | 54 +++++---- 4 files changed, 75 insertions(+), 142 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 4eaf895d9b..cda63cc70e 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 = GV%mks_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, US) ! 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..08ef5e8283 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, US=US) + call calculate_density(tv%t(i,j,k-1), tv%s(i,j,k-1), pRef, rhokm1, tv%eqn_of_state, US=US) - 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 f169147d03..733f7ac64f 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,31 +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, tv%eqn_of_state) + call calculate_density_derivs(temp_int, salt_int, pres_int, drho_dT, drho_dS, tv%eqn_of_state, US) ! 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..8ab4bc5977 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, US) ! 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 From 760dc39609a47f7974066b67d1f590f4c7b5d784 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 17 Apr 2020 19:53:11 -0400 Subject: [PATCH 47/55] +Rescaled variables in coord_adapt Rescaled internal density and pressure variables in coord_adapt, as well as some input parameters. These changes include rescaling of the input and output variables associated with the calculate_density routines. One variable that was being reused with different units has been split into two, and there are new arguments to build_grid_adaptive, build_adapt_column, and init_coord_adapt. All answers in the MOM6-examples test suite are bitwise identical. --- src/ALE/MOM_regridding.F90 | 13 ++++---- src/ALE/coord_adapt.F90 | 67 ++++++++++++++++++++------------------ 2 files changed, 42 insertions(+), 38 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index f6791a3b73..8be7824193 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -599,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 @@ -885,7 +885,7 @@ 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_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 @@ -1527,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 @@ -1575,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 @@ -1990,7 +1991,7 @@ subroutine initCoord(CS, GV, US, coord_mode) call init_coord_slight(CS%slight_CS, CS%nk, CS%ref_pressure, CS%target_density, & 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 @@ -2272,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) diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 3a083af2db..383bf6a055 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, tv%eqn_of_state, dom=(/2,nz/)) + 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, US, dom=(/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, tv%eqn_of_state, dom=(/2,nz/)) + 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, US, dom=(/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, tv%eqn_of_state, dom=(/2,nz/)) + 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, US, dom=(/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, tv%eqn_of_state, dom=(/2,nz/)) + 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, US, dom=(/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, tv%eqn_of_state, dom=(/1,nz/)) !### This should be (/1,nz+1/) - see 25 lines below. + 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, US, dom=(/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 From cdeda16d3cdb0921c21cafab1de90f1c15ccf6e3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 19 Apr 2020 06:11:41 -0400 Subject: [PATCH 48/55] Switched versions of calculate_density in 22 calls Changed to the new interfaces for calculate_density and related calls in 22 places. All answers are bitwise identical. --- src/ALE/MOM_regridding.F90 | 6 ++--- src/ALE/coord_rho.F90 | 2 +- .../MOM_state_initialization.F90 | 2 +- src/tracer/MOM_tracer_Z_init.F90 | 12 +++++----- src/user/ISOMIP_initialization.F90 | 22 +++++++++---------- src/user/benchmark_initialization.F90 | 6 ++--- 6 files changed, 25 insertions(+), 25 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 8be7824193..1586e414c1 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1890,7 +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, tv%eqn_of_state ) + call calculate_density( tv%T(i,j,:), tv%S(i,j,:), p_col, densities, tv%eqn_of_state, US=G%US) ! Repeat restratification until complete do @@ -1909,9 +1909,9 @@ 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, US=G%US) 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 ) + densities(k+1), tv%eqn_of_state, US=G%US ) stratified = .false. endif enddo ! k diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 7c6a00e714..d51e94afb9 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -250,7 +250,7 @@ subroutine build_rho_column_iteratively(CS, US, remapCS, nz, depth, h, T, S, eqn enddo ! Compute densities within current water column - call calculate_density( T_tmp, S_tmp, pres, densities, 1, nz, eqn_of_state, US=US) + call calculate_density( T_tmp, S_tmp, pres, densities, eqn_of_state, US=US) do k = 1,count_nonzero_layers densities(k) = densities(mapping(k)) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 76e87aeed2..8e4be1137d 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1601,7 +1601,7 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P enddo call calculate_density(T0(1), S0(1), pres(1), rho_guess(1), eqn_of_state, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, 1, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, US=US, dom=(/1,1/)) if (fit_salin) then ! A first guess of the layers' temperatures. diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 76ca2dac4a..b171bc3dce 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -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, US=US) - call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, & - eos, US=US) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), eos, US=US, dom=(/1,nx/)) + call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), & + eos, US=US, dom=(/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, US=US) - call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, & - eos, US=US) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), eos, US=US, dom=(/1,nx/)) + call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), & + eos, US=US, dom=(/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/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index c189cf0490..2e2980a782 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, US) ! 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, US) ! write(mesg,*) 'Bottom density is:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur @@ -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, US) ! 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, US) ! write(mesg,*) 'Density in the bottom layer::', rho_bot ! call MOM_mesg(mesg,5) @@ -362,7 +362,7 @@ 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, US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, US, dom=(/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), pres(1), rho_guess(1), eqn_of_state, US=US) @@ -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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, US) 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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, US) 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, US) !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, US) !write (mesg,*) 'Bottom density in sponge:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index ff76654b28..ef3920f1bf 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -162,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, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state, US=US) + call calculate_density(T0, S0, pres, rho_guess, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, US=US) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -258,7 +258,7 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & T0(k1) = 29.0 call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state, US=US) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state, US=US) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, US=US, dom=(/k1,k1/)) ! A first guess of the layers' temperatures. ! do k=1,nz From 9c5239eafd8000ddb4eb865c37ecfd983064bd99 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 19 Apr 2020 07:40:50 -0400 Subject: [PATCH 49/55] Corrected MOM_EOS dimensional rescaling problem Corrected problems with dimensional consistency testing in MOM_EOS.F90 that had been introduced with a recent merge. All answers are bitwise identical and are once again passing dimesional consistency testing. --- src/equation_of_state/MOM_EOS.F90 | 118 +++++++++--------------------- 1 file changed, 33 insertions(+), 85 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 034912b9ff..c7e8a37fd3 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -207,17 +207,11 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] - 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, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] integer :: j if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_array called with an unassociated EOS_type EOS.") - 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_linear(T, S, pressure, rho, start, npts, & @@ -233,30 +227,10 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re case default call MOM_error(FATAL, "calculate_density_array: 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_linear(T, S, pres, rho, start, npts, & - EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_ref) - case (EOS_UNESCO) - call calculate_density_unesco(T, S, pres, rho, start, npts, rho_ref) - case (EOS_WRIGHT) - call calculate_density_wright(T, S, pres, rho, start, npts, rho_ref) - case (EOS_TEOS10) - call calculate_density_teos10(T, S, pres, rho, start, npts, rho_ref) - case (EOS_NEMO) - call calculate_density_nemo(T, S, pres, rho, start, npts, rho_ref) - case default - call MOM_error(FATAL, "calculate_density_array: EOS%form_of_EOS is not valid.") - end select - 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 ; rho(j) = rho_scale * rho(j) ; enddo - 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 @@ -547,61 +521,35 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables - 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] 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 - - if (p_scale == 1.0) then - select case (EOS%form_of_EOS) - case (EOS_LINEAR) - call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & - EOS%dRho_dT, EOS%dRho_dS, start, npts) - case (EOS_UNESCO) - call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) - case (EOS_WRIGHT) - call calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS, start, npts) - case (EOS_TEOS10) - call calculate_density_derivs_teos10(T, S, pressure, drho_dT, drho_dS, start, npts) - 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.") - 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_derivs_linear(T, S, pres, drho_dT, drho_dS, EOS%Rho_T0_S0, & - EOS%dRho_dT, EOS%dRho_dS, start, npts) - case (EOS_UNESCO) - call calculate_density_derivs_unesco(T, S, pres, drho_dT, drho_dS, start, npts) - case (EOS_WRIGHT) - call calculate_density_derivs_wright(T, S, pres, drho_dT, drho_dS, start, npts) - case (EOS_TEOS10) - call calculate_density_derivs_teos10(T, S, pres, drho_dT, drho_dS, start, npts) - case (EOS_NEMO) - call calculate_density_derivs_nemo(T, S, pres, drho_dT, drho_dS, start, npts) - case default - call MOM_error(FATAL, "calculate_density_derivs_array: EOS%form_of_EOS is not valid.") - end select - endif + select case (EOS%form_of_EOS) + case (EOS_LINEAR) + call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & + EOS%dRho_dT, EOS%dRho_dS, start, npts) + case (EOS_UNESCO) + call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_WRIGHT) + call calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS, start, npts) + case (EOS_TEOS10) + call calculate_density_derivs_teos10(T, S, pressure, drho_dT, drho_dS, start, npts) + 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.") + end select - 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_dT(j) = rho_scale * drho_dT(j) - drho_dS(j) = rho_scale * drho_dS(j) - enddo ; endif + if (present(scale)) then ; if (scale /= 1.0) then ; do j=start,start+npts-1 + drho_dT(j) = scale * drho_dT(j) + drho_dS(j) = scale * drho_dS(j) + enddo ; endif ; endif end subroutine calculate_density_derivs_array @@ -665,8 +613,8 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS 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 - real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density - !! in combination with scaling given by US [various] + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + !! in combination with scaling given by US [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] @@ -799,8 +747,8 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] 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] + real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density + !! in combination with scaling given by US [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] @@ -984,7 +932,7 @@ subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS) end select if (EOS%kg_m3_to_R /= 1.0) then ; do i=is,ie - rho(i) = EOS%kg_m3_to_R * rho(i) + 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) @@ -1004,6 +952,7 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) !! 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, & @@ -1947,7 +1896,7 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t GxRho = G_e * rho_ref ! Anomalous pressure difference across whole cell - dp = frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, 1.0, EOS, US) + dp = frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, 1.0, EOS) P_b = P_t + dp ! Anomalous pressure at bottom of cell @@ -1973,7 +1922,7 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t do while ( abs(Pa) > Pa_tol ) z_out = z_t + ( z_b - z_t ) * F_guess - Pa = frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, F_guess, EOS, US) - ( P_tgt - 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 (Pa Returns change in anomalous pressure change from top to non-dimensional !! position pos between z_t and z_b -real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EOS, US) +real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EOS) real, intent(in) :: T_t !< Potential temperatue at the cell top [degC] real, intent(in) :: T_b !< Potential temperatue at the cell bottom [degC] real, intent(in) :: S_t !< Salinity at the cell top [ppt] @@ -2010,7 +1959,6 @@ 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) :: 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real :: fract_dp_at_pos !< The change in pressure from the layer top to !! fractional position pos [R L2 T-2 ~> Pa] ! Local variables @@ -2033,7 +1981,7 @@ 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 Bode's rule to estimate the average density From 718c3ab1f57d9bb4431434cf45b3c58b1771b8ac Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 19 Apr 2020 18:26:14 -0400 Subject: [PATCH 50/55] Removed US argument to find_depth_of_pressure_in_cell Eliminated the US argument to find_depth_of_pressure_in_cell, which was no longer being used. Also stored EOS_domain values in MOM_state_initialization for reduced overhead. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS.F90 | 5 ++--- .../MOM_state_initialization.F90 | 22 +++++++++++-------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index c7e8a37fd3..49820d7ff8 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1159,7 +1159,7 @@ end function query_compressible 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type optional :: US ! Local variables #include "version_variable.h" @@ -1869,7 +1869,7 @@ end subroutine int_density_dz_generic_plm !> Find the depth at which the reconstructed pressure matches P_tgt subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_tgt, & - rho_ref, G_e, EOS, US, P_b, z_out, z_tol) + rho_ref, G_e, EOS, P_b, z_out, z_tol) real, intent(in) :: T_t !< Potential temperatue at the cell top [degC] real, intent(in) :: T_b !< Potential temperatue at the cell bottom [degC] real, intent(in) :: S_t !< Salinity at the cell top [ppt] @@ -1881,7 +1881,6 @@ 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) :: 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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] diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 7b58ca6933..aa22f3cea0 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -939,6 +939,7 @@ subroutine convert_thickness(h, G, GV, US, tv) ! [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 @@ -956,11 +957,12 @@ subroutine convert_thickness(h, G, GV, US, tv) 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, & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + tv%eqn_of_state, EOSdom) do i=is,ie p_bot(i,j) = p_top(i,j) + HR_to_pres * (h(i,j,k) * rho(i)) enddo @@ -971,7 +973,7 @@ subroutine convert_thickness(h, G, GV, US, tv) 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, & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + tv%eqn_of_state, EOSdom) ! Use Newton's method to correct the bottom value. ! The hydrostatic equation is sufficiently linear that no bounds-checking is needed. do i=is,ie @@ -1215,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, GV%Rho0, G_earth, tv%eqn_of_state, US, & + 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 @@ -1601,7 +1603,7 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P enddo 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, dom=(/1,1/)) + 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. @@ -1735,6 +1737,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, C real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. 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 @@ -1864,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), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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) @@ -1977,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 @@ -2188,9 +2192,9 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param 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), eos, & - dom=EOS_domain(G%HI)) + 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) @@ -2458,7 +2462,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) P_t = 0. do k = 1, nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), P_t, 0.5*P_tot, & - GV%Rho0, GV%g_Earth, tv%eqn_of_state, US, P_b, 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 From e3c434e575f869ae703ae54eefe4f668eae90c7c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 19 Apr 2020 18:51:25 -0400 Subject: [PATCH 51/55] Store return values from EOS_domain Store the return values from EOS_domain for computational efficiency. Also cleaned up unneeded 'dom=' declarations in compute_density calls. All answers are bitwise identical. --- src/ALE/coord_adapt.F90 | 10 ++++---- src/ALE/coord_slight.F90 | 4 +-- src/core/MOM.F90 | 6 +++-- src/core/MOM_PressureForce_Montgomery.F90 | 18 ++++++------- src/core/MOM_PressureForce_analytic_FV.F90 | 14 +++++------ src/core/MOM_PressureForce_blocked_AFV.F90 | 10 ++++---- src/core/MOM_forcing_type.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 4 +-- src/diagnostics/MOM_diagnostics.F90 | 14 +++++++---- src/diagnostics/MOM_wave_speed.F90 | 4 +-- src/diagnostics/MOM_wave_structure.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 6 +++-- .../MOM_coord_initialization.F90 | 4 +-- .../lateral/MOM_mixed_layer_restrat.F90 | 23 +++++++++-------- .../lateral/MOM_thickness_diffuse.F90 | 8 +++--- .../vertical/MOM_bulk_mixed_layer.F90 | 14 +++++------ .../vertical/MOM_diabatic_aux.F90 | 25 ++++++++++--------- .../vertical/MOM_diabatic_driver.F90 | 4 ++- .../vertical/MOM_entrain_diffusive.F90 | 15 +++++------ .../vertical/MOM_full_convection.F90 | 10 ++++---- .../vertical/MOM_geothermal.F90 | 4 +-- .../vertical/MOM_internal_tide_input.F90 | 6 +++-- .../vertical/MOM_kappa_shear.F90 | 2 +- .../vertical/MOM_regularize_layers.F90 | 10 ++++---- .../vertical/MOM_set_diffusivity.F90 | 21 ++++++++++------ .../vertical/MOM_set_viscosity.F90 | 12 ++++----- src/tracer/MOM_neutral_diffusion.F90 | 8 +++--- src/tracer/MOM_tracer_Z_init.F90 | 8 +++--- src/tracer/MOM_tracer_hor_diff.F90 | 4 ++- src/user/DOME_initialization.F90 | 2 +- src/user/ISOMIP_initialization.F90 | 2 +- src/user/RGC_initialization.F90 | 6 ++--- src/user/benchmark_initialization.F90 | 2 +- src/user/user_change_diffusivity.F90 | 8 +++--- 34 files changed, 157 insertions(+), 135 deletions(-) diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 58e2aaa131..42ae0ee245 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -159,7 +159,7 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex 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_RZ * GV%g_Earth), & - alpha, beta, tv%eqn_of_state, (/2,nz/)) + 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)) + & @@ -171,7 +171,7 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex 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_RZ * GV%g_Earth), & - alpha, beta, tv%eqn_of_state, (/2,nz/)) + 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)) + & @@ -183,7 +183,7 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex 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_RZ * GV%g_Earth), & - alpha, beta, tv%eqn_of_state, (/2,nz/)) + 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)) + & @@ -195,7 +195,7 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex 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_RZ * GV%g_Earth), & - alpha, beta, tv%eqn_of_state, (/2,nz/)) + 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)) + & @@ -209,7 +209,7 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex ! 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_RZ * GV%g_Earth), & - alpha, beta, tv%eqn_of_state, (/1,nz/)) !### This should be (/1,nz+1/) - see 25 lines below. + 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 dh_d2s(K) = del2sigma(K) * (0.5 * (h(i,j,k-1) + h(i,j,k))) / & diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 1f6bff8103..5cfa09213f 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -373,9 +373,9 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_pres, H_subroundoff, & T_int(nz+1) = T_f(nz) ; S_int(nz+1) = S_f(nz) 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, dom=(/2,nz/)) + eqn_of_state, (/2,nz/) ) call calculate_density_derivs(T_int, S_int, p_R, drhoR_dT, drhoR_dS, & - eqn_of_state, dom=(/2,nz/)) + 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) else diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1d7ed5b1d6..5c7f79fe32 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2895,9 +2895,11 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) ! a corrected effective SSH [R ~> kg m-3]. 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 @@ -2905,7 +2907,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) do j=js,je if (calc_rho) then call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), Rho_conv, & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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 diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index a338bc2899..99268460df 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -230,7 +230,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb 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(:), & - tv%eqn_of_state, dom=EOSdom) + 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) @@ -247,7 +247,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$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, & - tv%eqn_of_state, dom=EOSdom) + 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 @@ -487,7 +487,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, 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(:), & - tv%eqn_of_state, dom=EOSdom) + tv%eqn_of_state, EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -508,7 +508,7 @@ 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), & - tv%eqn_of_state, dom=EOSdom) + 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 @@ -666,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, & - tv%eqn_of_state, dom=EOSdom) + 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 @@ -677,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, & - tv%eqn_of_state, dom=EOSdom) + 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)) * & @@ -764,7 +764,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) !$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, & - tv%eqn_of_state, dom=EOSdom) + 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)) @@ -774,9 +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, tv%eqn_of_state, dom=EOSdom) + 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, & - tv%eqn_of_state, dom=EOSdom) + 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)) + & diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 0f9dff1373..614bf3bc8a 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -177,7 +177,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p ! 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 + 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 @@ -230,7 +230,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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(:), & - tv%eqn_of_state, dom=EOSdom) + 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) @@ -336,7 +336,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p !$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, & - tv%eqn_of_state, dom=EOSdom) + tv%eqn_of_state, EOSdom) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -505,7 +505,7 @@ 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 computational domain for the equation of state + 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 @@ -581,7 +581,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at 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(:), & - tv%eqn_of_state, dom=EOSdom) + tv%eqn_of_state, EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -604,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, & - tv%eqn_of_state, dom=EOSdom) + tv%eqn_of_state, EOSdom) else call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, & - tv%eqn_of_state, dom=EOSdom) + 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) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index d647ffda46..ab0c665f7a 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -226,7 +226,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, 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(:), & - tv%eqn_of_state, dom=EOSdom) + 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) @@ -304,7 +304,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, !$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, & - tv%eqn_of_state, dom=EOSdom) + tv%eqn_of_state, EOSdom) do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) @@ -568,7 +568,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, 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(:), & - tv%eqn_of_state, dom=EOSdom) + tv%eqn_of_state, EOSdom) do k=nkmb+1,nz ; do i=Isq,Ieq+1 if (GV%Rlay(k) < Rho_cv_BL(i)) then @@ -591,10 +591,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, 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, & - tv%eqn_of_state, dom=EOSdom) + tv%eqn_of_state, EOSdom) else call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, rho_in_situ, & - tv%eqn_of_state, dom=EOSdom) + 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) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 071a912325..73efeec927 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -954,7 +954,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! Density derivatives call calculate_density_derivs(Temp(:,j,1), Salt(:,j,1), pressure, dRhodT, dRhodS, & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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 diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index bb0bb52bfc..4f1a2d261e 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -179,7 +179,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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, & - tv%eqn_of_state, dom=EOSdom_u) + tv%eqn_of_state, EOSdom_u) endif do I=is-1,ie @@ -267,7 +267,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & S_v(i) = 0.25*((S(i,j,k) + S(i,j+1,k)) + (S(i,j,k-1) + S(i,j+1,k-1))) enddo call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, tv%eqn_of_state, & - dom=EOSdom_v) + EOSdom_v) endif do i=is,ie if (use_EOS) then diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 8d2ea162f1..38529fb958 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -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]. @@ -344,6 +345,7 @@ 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 [R L2 T-2 ~> Pa] do i=is,ie @@ -360,7 +362,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & 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, & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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 @@ -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) pressure_1d(:) = tv%P_Ref !$OMP parallel do default(shared) do k=1,nz ; do j=js-1,je+1 call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), tv%eqn_of_state, & - dom=EOS_domain(G%HI, halo=1)) + 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,12 +587,13 @@ 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(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), & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + tv%eqn_of_state, EOSdom) enddo ; enddo if (CS%id_rhopot0 > 0) call post_data(CS%id_rhopot0, Rcv, CS%diag) endif @@ -598,7 +602,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !$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), & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + tv%eqn_of_state, EOSdom) enddo ; enddo if (CS%id_rhopot2 > 0) call post_data(CS%id_rhopot2, Rcv, CS%diag) endif @@ -609,7 +613,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & do k=1,nz pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (GV%H_to_RZ*GV%g_Earth) ! Pressure in middle of layer k call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, Rcv(:,j,k), & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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 diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index ea918d218e..c955c4eb95 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -243,7 +243,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & 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, & - tv%eqn_of_state, dom=(/2,kf(i)/)) + tv%eqn_of_state, (/2,kf(i)/) ) ! Sum the reduced gravities to find out how small a density difference ! is negligibly small. @@ -738,7 +738,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) 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, & - tv%eqn_of_state, dom=(/2,kf(i)/)) + 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/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index db6d74035a..632a68e0ce 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -278,7 +278,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo 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, & - tv%eqn_of_state, dom=(/2,kf(i)/)) + 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/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 5da6719b85..59adfae2a8 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -287,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: "// & @@ -369,6 +370,7 @@ 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. @@ -376,9 +378,9 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) ! Calculate insitu densities and expansion coefficients call calculate_density(state%sst(:,j), state%sss(:,j), p_int, Rhoml(:), & - CS%eqn_of_state, dom=EOS_domain(G%HI)) + 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, dom=EOS_domain(G%HI)) + 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. & diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index d244146959..7c310ba600 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -291,7 +291,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s ! 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, eqn_of_state, dom=(/1,nz/)) + 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)//'()') @@ -371,7 +371,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_Ref ; enddo - call calculate_density(T0, S0, Pref, Rlay, eqn_of_state, dom=(/k_light,nz/) ) + 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) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index a5930f487e..c1b608b16b 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -173,7 +173,6 @@ 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 @@ -184,6 +183,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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) @@ -205,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, tv%eqn_of_state, & - dom=EOS_domain(G%HI, halo=1)) + 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 @@ -216,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, tv%eqn_of_state, & - dom=EOS_domain(G%HI, halo=1)) + 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 @@ -300,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, & @@ -322,8 +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(:), tv%eqn_of_state, & - dom=EOS_domain(G%HI, halo=1)) + 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 @@ -613,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 @@ -634,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) & @@ -647,8 +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(:), tv%eqn_of_state, & - dom=EOS_domain(G%HI, halo=1)) + 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 95731b78f0..d988f2bbd5 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -784,7 +784,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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, & - tv%eqn_of_state, dom=EOSdom_u) + tv%eqn_of_state, EOSdom_u) endif do I=is-1,ie @@ -1036,7 +1036,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV S_v(i) = 0.25*((S(i,j,k) + S(i,j+1,k)) + (S(i,j,k-1) + S(i,j+1,k-1))) enddo call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, & - tv%eqn_of_state, dom=EOSdom_v) + tv%eqn_of_state, EOSdom_v) endif do i=is,ie if (calc_derivatives) then @@ -1269,7 +1269,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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, & - tv%eqn_of_state, dom=EOSdom_u ) + tv%eqn_of_state, EOSdom_u ) endif do I=is-1,ie uhD(I,j,1) = -uhtot(I,j) @@ -1300,7 +1300,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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, & - tv%eqn_of_state, dom=EOSdom_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_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 10c32350a7..1082bb74e4 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -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, & @@ -466,15 +468,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C do k=1,CS%nkml ; do i=is,ie 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, tv%eqn_of_state, & - dom=EOS_domain(G%HI)) - call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) - call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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 61d0d7883a..c1db0849cc 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -413,6 +413,7 @@ subroutine insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS, dt, id_brine_lay) 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)) ! 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] @@ -427,6 +428,7 @@ subroutine insert_brine(h, tv, G, GV, US, fluxes, nkmb, CS, dt, id_brine_lay) ! subroutine needs to be revisited.- RWH p_ref_cv(:) = tv%P_Ref + EOSdom(:) = EOS_domain(G%HI) brine_dz = 1.0*GV%m_to_H inject_layer(:,:) = nz @@ -446,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), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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 @@ -753,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 @@ -765,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, tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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. @@ -809,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, tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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) @@ -833,10 +834,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! 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, tv%eqn_of_state, & - dom=EOS_domain(G%HI)) - call calculate_density(T_deeper, S_deeper, pRef_N2, rho_deeper, tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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 @@ -941,6 +940,7 @@ 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 character(len=45) :: mesg @@ -956,6 +956,7 @@ 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 @@ -1011,7 +1012,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t 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), tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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,7 +1354,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Density derivatives call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, dRhodT, dRhodS, & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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 88cd39db45..1ee10cebec 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2012,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) @@ -2680,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), & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 6040026881..d416732ae6 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -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,6 +248,7 @@ 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, & @@ -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(:,j,k), tv%S(:,j,k), pres, Rcv, tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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 @@ -785,8 +786,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & else ! not bulkmixedlayer do k=K2,nz-1; - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pres, Rcv, tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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 @@ -852,7 +852,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & endif enddo call calculate_density_derivs(T_eos, S_eos, pressure, dRho_dT, dRho_dS, & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + tv%eqn_of_state, EOSdom) do i=is,ie if ((k>kmb) .and. (k 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(:,j,k), tv%S(:,j,k), pres, Rcv, tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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 e19a71ac98..1783955d53 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -352,6 +352,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h 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,20 +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), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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), & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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 9106be075e..66116575d5 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -199,7 +199,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) if (nkmb > 0) then call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_Ref(:), Rcv_BL(:), & - tv%eqn_of_state, dom=(/isj-(G%isd-1),iej-(G%isd-1)/)) + tv%eqn_of_state, (/isj-(G%isd-1),iej-(G%isd-1)/) ) else Rcv_BL(:) = -1.0 endif @@ -249,7 +249,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) 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_, & - tv%eqn_of_state, dom=(/1,2/) ) + 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 0455614790..f5b9e7dbb7 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -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) & @@ -210,7 +212,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) 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(:), & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 153cf50244..107a80b058 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -911,7 +911,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Sal_int(K) = 0.5*(Sal(k-1) + Sal(k)) enddo call calculate_density_derivs(T_int, Sal_int, pressure, dbuoy_dT, dbuoy_dS, & - tv%eqn_of_state, scale=-g_R0, dom=(/2,nzc/)) + 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 diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 072b471bf0..00c8258fb7 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -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, tv%eqn_of_state, & -! dom=EOS_domain(G%HI)) +! 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), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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 a230cd8237..2ee3f38233 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -680,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 @@ -713,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), & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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, & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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 @@ -883,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 @@ -900,6 +901,7 @@ 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%g_Earth*GV%H_to_RZ)*h(i,j,k-1) @@ -907,7 +909,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & 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), & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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) @@ -1051,6 +1053,7 @@ 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 @@ -1059,6 +1062,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) 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%g_Earth*GV%H_to_RZ)*h(i,j,k-1) @@ -1066,7 +1070,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) 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, & - tv%eqn_of_state, dom=EOS_domain(G%HI)) + 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)) @@ -1798,6 +1802,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) 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 @@ -1818,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), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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 diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index d1c3a98b68..be16133ed1 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -318,7 +318,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) !$OMP parallel do default(shared) 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, & - dom=EOSdom) + EOSdom) enddo ; enddo endif @@ -575,7 +575,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) 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, tv%eqn_of_state, & - dom=(/is-G%IsdB+1,ie-G%IsdB+1/)) + (/is-G%IsdB+1,ie-G%IsdB+1/) ) endif do i=is,ie ; if (do_i(i)) then @@ -1279,7 +1279,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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, tv%eqn_of_state, & - dom=(/Isq-G%IsdB+1,Ieq-G%IsdB+1/)) + (/Isq-G%IsdB+1,Ieq-G%IsdB+1/) ) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1400,7 +1400,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if (use_EOS) then call calculate_density_derivs(T_EOS, S_EOS, forces%p_surf(:,j), dR_dT, dR_dS, & - tv%eqn_of_state, dom=(/Isq-G%IsdB+1,Ieq-G%IsdB+1/)) + tv%eqn_of_state, (/Isq-G%IsdB+1,Ieq-G%IsdB+1/) ) endif do I=Isq,Ieq ; if (do_i(I)) then @@ -1516,7 +1516,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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, & - tv%eqn_of_state, dom=(/is-G%IsdB+1,ie-G%IsdB+1/)) + tv%eqn_of_state, (/is-G%IsdB+1,ie-G%IsdB+1/) ) endif do i=is,ie ; if (do_i(i)) then @@ -1637,7 +1637,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if (use_EOS) then call calculate_density_derivs(T_EOS, S_EOS, forces%p_surf(:,j), dR_dT, dR_dS, & - tv%eqn_of_state, dom=(/is-G%IsdB+1,ie-G%IsdB+1/)) + 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/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 747d9fb6ae..468d6bb674 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -285,6 +285,7 @@ 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 @@ -364,6 +365,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) 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 @@ -391,18 +393,18 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) 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), CS%EOS, dom=EOS_domain(G%HI, halo=1)) + 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), CS%EOS, dom=EOS_domain(G%HI, halo=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, dom=EOS_domain(G%HI, halo=1)) + CS%dRdS_i(:,j,k,2), CS%EOS, EOSdom) enddo endif enddo diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 5cc420e016..a84814d40a 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -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), eos, dom=(/1,nx/)) + 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, dom=(/1,nx/)) + 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), eos, dom=(/1,nx/)) + 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, dom=(/1,nx/)) + 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 968eb9e718..6898af23da 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -675,6 +675,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real :: tmp 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), & - tv%eqn_of_state, dom=EOS_domain(G%HI,halo=2)) + tv%eqn_of_state, EOSdom) enddo ; enddo do j=js-2,je+2 ; do i=is-2,ie+2 diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 059f747609..f92d2d7ac6 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -360,7 +360,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! 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) - call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, tv%eqn_of_state, dom=(/1,1/)) + 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 diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 5eda807888..0a3cfb3fbe 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -362,7 +362,7 @@ 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, eqn_of_state, dom=(/1,1/)) + 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), pres(1), rho_guess(1), eqn_of_state) diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index 8a97ae37a1..70b9fcd4dc 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -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), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index f0206dc262..e32c8b9e41 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -258,7 +258,7 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & T0(k1) = 29.0 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, dom=(/k1,k1/)) + 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 diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 570adb4ff1..a63e7a2b89 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -72,6 +72,7 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i 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), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + 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), tv%eqn_of_state, & - dom=EOS_domain(G%HI)) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo endif From 3a817efe9969e6598c0aa8ccd091e35fd2b8f35c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 20 Apr 2020 06:18:20 -0400 Subject: [PATCH 52/55] Fixed a diagnostic halo extent Corrected a diagnostic halo extent in a recently added EOS_domain call and added new variables to two openMP directives. All answers are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 2 +- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 4 ++-- src/parameterizations/vertical/MOM_entrain_diffusive.F90 | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 38529fb958..ca9ad28b62 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -464,7 +464,7 @@ 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) + 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 diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index c1db0849cc..92288db846 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -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, & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index d416732ae6..4e30756f7b 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -252,7 +252,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & !$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, & From 37d30b596280ea12674537419284dad277ffbc8f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 20 Apr 2020 07:08:10 -0400 Subject: [PATCH 53/55] Eliminated the use of GV%mks_g_Earth Eliminated the use GV%mks_g_Earth throughout the MOM6 code. This variable is being retained and is still set to avoid breaking any user code that might be using it. All answers are bitwise identical. --- src/core/MOM_verticalGrid.F90 | 8 ++++---- src/initialization/MOM_coord_initialization.F90 | 16 ++++++++-------- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 2 +- src/user/MOM_wave_interface.F90 | 14 ++++++++------ 4 files changed, 21 insertions(+), 19 deletions(-) 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/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 7c310ba600..58f58fe828 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -141,7 +141,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%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) @@ -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) @@ -274,7 +274,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s 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.) @@ -355,7 +355,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta 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 @@ -402,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, & @@ -458,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 @@ -496,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/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 21d7259032..ea187f86f9 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -960,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 / 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 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 From 18b21938bd97f852f64ae109620abef47f06d72e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 20 Apr 2020 11:57:07 -0400 Subject: [PATCH 54/55] Fixed compile time bugs in mom_surface_forcing_mct Corrected compile time errors, related to an incomplete implementation of the pressure rescaling in mom_surface_forcing_mct.F90. With this fix, the changes relative to dev/gfdl are now similar between mom_surface_forcing_mct.F90 and the equivalent files for the other couplers. All answers in the MOM6-examples test cases are bitwise identical. --- config_src/mct_driver/mom_surface_forcing_mct.F90 | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/config_src/mct_driver/mom_surface_forcing_mct.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 index c017ecbba5..12fe940ead 100644 --- a/config_src/mct_driver/mom_surface_forcing_mct.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -527,14 +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) -US%kg_m3_to_R*US%m_s_to_L_T**2*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) -US%kg_m3_to_R*US%m_s_to_L_T**2*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 @@ -688,14 +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) -US%kg_m3_to_R*US%m_s_to_L_T**2*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) -US%kg_m3_to_R*US%m_s_to_L_T**2*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 From f5eb17194d9e5daf1536ae63fbed18e23d17f3f6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 20 Apr 2020 14:45:42 -0400 Subject: [PATCH 55/55] Eliminated some US args in MOM_neutral_diffusion Removed unused US arguments to routines in MOM_neutral_diffusion.F90. All answers are bitwise identical, but some internal interfaces have one fewer argument, and have been returned to their form in the dev/gfdl version. --- src/tracer/MOM_neutral_diffusion.F90 | 134 +++++++++++++-------------- 1 file changed, 65 insertions(+), 69 deletions(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 468d6bb674..ac7324c143 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -19,7 +19,7 @@ module MOM_neutral_diffusion use MOM_remapping, only : extract_member_remapping_CS, build_reconstructions_1d use MOM_remapping, only : average_value_ppoly, remappingSchemesDoc, remappingDefaultScheme use MOM_tracer_registry, only : tracer_registry_type, tracer_type -use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use polynomial_functions, only : evaluation_polynomial, first_derivative_polynomial use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation @@ -86,6 +86,8 @@ module MOM_neutral_diffusion 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 @@ -226,6 +228,9 @@ logical function neutral_diffusion_init(Time, G, US, param_file, diag, EOS, diab 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) @@ -411,7 +416,7 @@ 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 - call mark_unstable_cells( CS, G%ke, CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%P_i(i,j,:,:), US, CS%stable_cell(i,j,:) ) + call mark_unstable_cells( CS, G%ke, CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%P_i(i,j,:,:), CS%stable_cell(i,j,:) ) if (CS%interior_only) then if (.not. CS%stable_cell(i,j,k_bot(i,j))) zeta_bot(i,j) = -1. ! set values in the surface and bottom boundary layer to false. @@ -443,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, US, 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,:,:), & @@ -464,7 +469,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS) 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, US, 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,:,:), & @@ -1160,13 +1165,12 @@ 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, US, nk, & +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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: nk !< Number of levels 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] @@ -1284,12 +1288,12 @@ subroutine find_neutral_surface_positions_discontinuous(CS, US, nk, & ! 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, US, & + 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=",US%R_to_kg_m3*dRho, & + "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 @@ -1313,7 +1317,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, US, nk, & ! Position of the right interface is known and all quantities are fixed PoR(k_surface) = ki_right - 1. KoR(k_surface) = kl_right - PoL(k_surface) = search_other_column(CS, US, k_surface, lastP_left, & + PoL(k_surface) = search_other_column(CS, k_surface, lastP_left, & Tr(kl_right, ki_right), Sr(kl_right, ki_right), Pres_r(kl_right, ki_right), & Tl(kl_left,1), Sl(kl_left,1), Pres_l(kl_left,1), & Tl(kl_left,2), Sl(kl_left,2), Pres_l(kl_left,2), & @@ -1336,7 +1340,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, US, nk, & ! Position of the right interface is known and all quantities are fixed PoL(k_surface) = ki_left - 1. KoL(k_surface) = kl_left - PoR(k_surface) = search_other_column(CS, US, k_surface, lastP_right, & + PoR(k_surface) = search_other_column(CS, k_surface, lastP_right, & Tl(kl_left, ki_left), Sl(kl_left, ki_left), Pres_l(kl_left, ki_left), & Tr(kl_right,1), Sr(kl_right,1), Pres_r(kl_right,1), & Tr(kl_right,2), Sr(kl_right,2), Pres_r(kl_right,2), & @@ -1396,30 +1400,28 @@ subroutine find_neutral_surface_positions_discontinuous(CS, US, nk, & end subroutine find_neutral_surface_positions_discontinuous !> Sweep down through the column and mark as stable if the bottom interface of a cell is denser than the top -subroutine mark_unstable_cells(CS, nk, T, S, P, US, stable_cell) +subroutine mark_unstable_cells(CS, nk, T, S, P, stable_cell) type(neutral_diffusion_CS), intent(inout) :: CS !< Neutral diffusion control structure integer, intent(in) :: nk !< Number of levels in a column real, dimension(nk,2), intent(in) :: T !< Temperature at interfaces [degC] real, dimension(nk,2), intent(in) :: S !< Salinity at interfaces [ppt] real, dimension(nk,2), intent(in) :: P !< Pressure at interfaces [R L2 T-2 ~> Pa] - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, dimension(nk), intent( out) :: stable_cell !< True if this cell is unstably stratified integer :: k, first_stable, prev_stable real :: delta_rho ! A density difference [R ~> kg m-3] do k = 1,nk - call calc_delta_rho_and_derivs( CS, US, 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 ) + 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, US, 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) +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) type(neutral_diffusion_CS), intent(in ) :: CS !< Neutral diffusion control structure - type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type integer, intent(in ) :: ksurf !< Current index of neutral surface real, intent(in ) :: pos_last !< Last position within the current layer, used as the lower !! bound in the root finding algorithm [nondim] @@ -1443,12 +1445,12 @@ real function search_other_column(CS, US, ksurf, pos_last, T_from, S_from, P_fro ! 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, US, T_top, S_top, P_top, T_from, S_from, P_from, dRhoTop) - call calc_delta_rho_and_derivs(CS, US, T_bot, S_bot, P_bot, T_from, S_from, P_from, dRhoBot) + 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, US, 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, US, 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 @@ -1480,7 +1482,7 @@ real function search_other_column(CS, US, ksurf, pos_last, T_from, S_from, P_fro 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, US, pos_last, T_from, S_from, P_from, P_top, P_bot, T_poly, S_poly) + pos = find_neutral_pos_full( CS, pos_last, T_from, S_from, P_from, P_top, P_bot, T_poly, S_poly) endif end function search_other_column @@ -1641,9 +1643,8 @@ 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, US, 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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] @@ -1676,13 +1677,13 @@ function find_neutral_pos_full( CS, US, z0, T_ref, S_ref, P_ref, P_top, P_bot, p Tb = evaluation_polynomial( ppoly_T, nterm, b ) Sb = evaluation_polynomial( ppoly_S, nterm, b ) Pb = P_top*(1.-b) + P_bot*b - call calc_delta_rho_and_derivs(CS, US, Tb, Sb, Pb, T_ref, S_ref, P_ref, drho_b) + call calc_delta_rho_and_derivs(CS, Tb, Sb, Pb, T_ref, S_ref, P_ref, drho_b) ! Calculate drho at the maximum bound Tc = evaluation_polynomial( ppoly_T, nterm, 1. ) Sc = evaluation_polynomial( ppoly_S, nterm, 1. ) Pc = P_Bot - call calc_delta_rho_and_derivs(CS, US, Tc, Sc, Pc, T_ref, S_ref, P_ref, drho_c) + call calc_delta_rho_and_derivs(CS, Tc, Sc, Pc, T_ref, S_ref, P_ref, drho_c) if (drho_b >= 0.) then z = z0 @@ -1702,7 +1703,7 @@ function find_neutral_pos_full( CS, US, z0, T_ref, S_ref, P_ref, P_top, P_bot, p Ta = evaluation_polynomial( ppoly_T, nterm, a ) Sa = evaluation_polynomial( ppoly_S, nterm, a ) Pa = P_top*(1.-a) + P_bot*a - call calc_delta_rho_and_derivs(CS, US, Ta, Sa, Pa, T_ref, S_ref, P_ref, drho_a) + call calc_delta_rho_and_derivs(CS, Ta, Sa, Pa, T_ref, S_ref, P_ref, drho_a) if (ABS(drho_a) < CS%drho_tol) then z = a return @@ -1735,10 +1736,9 @@ function find_neutral_pos_full( CS, US, z0, T_ref, S_ref, P_ref, P_top, P_bot, p 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, US, 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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] @@ -2349,7 +2349,6 @@ logical function ndiff_unit_tests_discontinuous(verbose) real, dimension(ns-1) :: hEff, Flx type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure type(EOS_type), pointer :: EOS !< Structure for linear equation of state - type(unit_scale_type), pointer :: US => NULL() !< A dimensional unit scaling type 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 @@ -2370,7 +2369,6 @@ 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 unit_scaling_init(US=US) 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. @@ -2391,9 +2389,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 22.00, 18.00 /); TiL(2,:) = (/ 18.00, 14.00 /); TiL(3,:) = (/ 14.00, 10.00 /); TiR(1,:) = (/ 22.00, 18.00 /); TiR(2,:) = (/ 18.00, 14.00 /); TiR(3,:) = (/ 14.00, 10.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2405,9 +2403,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 22.00, 18.00 /); TiL(2,:) = (/ 18.00, 14.00 /); TiL(3,:) = (/ 14.00, 10.00 /); TiR(1,:) = (/ 20.00, 16.00 /); TiR(2,:) = (/ 16.00, 12.00 /); TiR(3,:) = (/ 12.00, 8.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2419,9 +2417,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 20.00, 16.00 /); TiL(2,:) = (/ 16.00, 12.00 /); TiL(3,:) = (/ 12.00, 8.00 /); TiR(1,:) = (/ 22.00, 18.00 /); TiR(2,:) = (/ 18.00, 14.00 /); TiR(3,:) = (/ 14.00, 10.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2433,9 +2431,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 22.00, 20.00 /); TiL(2,:) = (/ 18.00, 16.00 /); TiL(3,:) = (/ 14.00, 12.00 /); TiR(1,:) = (/ 32.00, 24.00 /); TiR(2,:) = (/ 22.00, 14.00 /); TiR(3,:) = (/ 12.00, 4.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2447,9 +2445,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 22.00, 18.00 /); TiL(2,:) = (/ 18.00, 14.00 /); TiL(3,:) = (/ 14.00, 10.00 /); TiR(1,:) = (/ 14.00, 14.00 /); TiR(2,:) = (/ 14.00, 14.00 /); TiR(3,:) = (/ 12.00, 8.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2461,9 +2459,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 14.00, 14.00 /); TiL(2,:) = (/ 14.00, 12.00 /); TiL(3,:) = (/ 10.00, 8.00 /); TiR(1,:) = (/ 14.00, 14.00 /); TiR(2,:) = (/ 14.00, 14.00 /); TiR(3,:) = (/ 14.00, 14.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2475,9 +2473,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 14.00, 14.00 /); TiL(2,:) = (/ 14.00, 12.00 /); TiL(3,:) = (/ 10.00, 8.00 /); TiR(1,:) = (/ 14.00, 14.00 /); TiR(2,:) = (/ 14.00, 14.00 /); TiR(3,:) = (/ 12.00, 4.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2489,9 +2487,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 14.00, 14.00 /); TiL(2,:) = (/ 14.00, 10.00 /); TiL(3,:) = (/ 10.00, 2.00 /); TiR(1,:) = (/ 14.00, 14.00 /); TiR(2,:) = (/ 14.00, 10.00 /); TiR(3,:) = (/ 10.00, 2.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2503,9 +2501,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 14.00, 12.00 /); TiL(2,:) = (/ 10.00, 10.00 /); TiL(3,:) = (/ 8.00, 2.00 /); TiR(1,:) = (/ 14.00, 12.00 /); TiR(2,:) = (/ 12.00, 8.00 /); TiR(3,:) = (/ 8.00, 2.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2517,9 +2515,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 12.00, 12.00 /); TiL(2,:) = (/ 12.00, 10.00 /); TiL(3,:) = (/ 10.00, 6.00 /); TiR(1,:) = (/ 12.00, 10.00 /); TiR(2,:) = (/ 10.00, 12.00 /); TiR(3,:) = (/ 8.00, 4.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2531,9 +2529,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 14.00, 14.00 /); TiL(2,:) = (/ 10.00, 10.00 /); TiL(3,:) = (/ 8.00, 6.00 /); TiR(1,:) = (/ 10.00, 14.00 /); TiR(2,:) = (/ 16.00, 16.00 /); TiR(3,:) = (/ 12.00, 4.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2545,9 +2543,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) TiL(1,:) = (/ 8.00, 12.00 /); TiL(2,:) = (/ 12.00, 10.00 /); TiL(3,:) = (/ 8.00, 4.00 /); TiR(1,:) = (/ 10.00, 14.00 /); TiR(2,:) = (/ 14.00, 12.00 /); TiR(3,:) = (/ 10.00, 6.00 /); - call mark_unstable_cells( CS, nk, Til, Sil, Pres_l, US, stable_l ) - call mark_unstable_cells( CS, nk, Tir, Sir, Pres_r, US, stable_r ) - call find_neutral_surface_positions_discontinuous(CS, US, nk, Pres_l, hL, TiL, SiL, ppoly_T_l, ppoly_S_l, stable_l, & + 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) 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 @@ -2590,8 +2588,6 @@ logical function ndiff_unit_tests_discontinuous(verbose) (/12.,0./), (/34.,2./)), "Salt stratified Linearized Alpha/Beta")) if (.not. ndiff_unit_tests_discontinuous) write(stdout,*) 'Pass' - deallocate(US) - end function ndiff_unit_tests_discontinuous !> Returns true if a test of fv_diff() fails, and conditionally writes results to stream