MOM_interface_heights.F90

!> Functions for calculating interface heights, including free surface height.
module mom_interface_heights
 
! This file is part of MOM6. See LICENSE.md for the license.
 
use mom_error_handler, only : mom_error, fatal
use mom_file_parser, only : log_version
use mom_grid, only : ocean_grid_type
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 : int_specific_vol_dp
 
implicit none ; private
 
#include <MOM_memory.h>
 
public find_eta
 
!> Calculates the heights of sruface or all interfaces from layer thicknesses.
interface find_eta
  module procedure find_eta_2d, find_eta_3d
end interface find_eta
 
contains
 
!> Calculates the heights of all interfaces between layers, using the appropriate
!! form for consistency with the calculation of the pressure gradient forces.
!! Additionally, these height may be dilated for consistency with the
!! corresponding time-average quantity from the barotropic calculation.
subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m)
  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_(G)),   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(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights
                                                                 !! [Z ~> m] or 1/eta_to_m m).
  real, dimension(SZI_(G),SZJ_(G)), optional, intent(in)  :: eta_bt !< optional barotropic
             !! variable that gives the "correct" free surface height (Boussinesq) or total water
             !! column mass per unit area (non-Boussinesq).  This is used to dilate the layer.
             !! thicknesses when calculating interfaceheights [H ~> m or kg m-2].
  integer,                          optional, intent(in)  :: halo_size !< width of halo points on
                                                                 !! which to calculate eta.
  real,                             optional, intent(in)  :: eta_to_m  !< The conversion factor from
             !! 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)
  real :: dz_geo(SZI_(G),SZJ_(G),SZK_(G)) ! The change in geopotential height
                                          ! across a layer [m2 s-2].
  real :: dilate(SZI_(G))                 ! non-dimensional dilation factor
  real :: htot(SZI_(G))                   ! total thickness H
  real :: I_gEarth
  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
 
  halo = 0 ; if (present(halo_size)) halo = max(0,halo_size)
 
  isv = g%isc-halo ; iev = g%iec+halo ; jsv = g%jsc-halo ; jev = g%jec+halo
  nz = g%ke
 
  if ((isv<g%isd) .or. (iev>g%ied) .or. (jsv<g%jsd) .or. (jev>g%jed)) &
    call mom_error(fatal,"find_eta called with an overly large halo_size.")
 
  z_to_eta = 1.0 ; if (present(eta_to_m)) z_to_eta = us%Z_to_m / eta_to_m
  h_to_eta = gv%H_to_Z * z_to_eta
  h_to_rho_eta =  gv%H_to_kg_m2 * (us%m_to_Z * z_to_eta)
  i_gearth = z_to_eta /  (us%Z_to_m * gv%mks_g_Earth)
 
!$OMP parallel default(shared) private(dilate,htot)
!$OMP do
  do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -z_to_eta*g%bathyT(i,j) ; enddo ; enddo
 
  if (gv%Boussinesq) then
!$OMP do
    do j=jsv,jev ; do k=nz,1,-1; do i=isv,iev
      eta(i,j,k) = eta(i,j,k+1) + h(i,j,k)*h_to_eta
    enddo ; enddo ; enddo
    if (present(eta_bt)) then
      ! Dilate the water column to agree with the free surface height
      ! that is used for the dynamics.
!$OMP do
      do j=jsv,jev
        do i=isv,iev
          dilate(i) = (eta_bt(i,j)*h_to_eta + z_to_eta*g%bathyT(i,j)) / &
                      (eta(i,j,1) + z_to_eta*g%bathyT(i,j))
        enddo
        do k=1,nz ; do i=isv,iev
          eta(i,j,k) = dilate(i) * (eta(i,j,k) + z_to_eta*g%bathyT(i,j)) - z_to_eta*g%bathyT(i,j)
        enddo ; enddo
      enddo
    endif
  else
    if (associated(tv%eqn_of_state)) then
!$OMP do
      do j=jsv,jev
        ! ### 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)
        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)
      enddo
!$OMP do
      do j=jsv,jev
        do k=nz,1,-1 ; do i=isv,iev
          eta(i,j,k) = eta(i,j,k+1) + i_gearth * dz_geo(i,j,k)
        enddo ; enddo
      enddo
    else
!$OMP do
      do j=jsv,jev ;  do k=nz,1,-1; do i=isv,iev
        eta(i,j,k) = eta(i,j,k+1) + h_to_rho_eta*h(i,j,k)/gv%Rlay(k)
      enddo ; enddo ; enddo
    endif
    if (present(eta_bt)) then
      ! Dilate the water column to agree with the free surface height
      ! from the time-averaged barotropic solution.
!$OMP do
      do j=jsv,jev
        do i=isv,iev ; htot(i) = gv%H_subroundoff ; enddo
        do k=1,nz ; do i=isv,iev ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo
        do i=isv,iev ; dilate(i) = eta_bt(i,j) / htot(i) ; enddo
        do k=1,nz ; do i=isv,iev
          eta(i,j,k) = dilate(i) * (eta(i,j,k) + z_to_eta*g%bathyT(i,j)) - z_to_eta*g%bathyT(i,j)
        enddo ; enddo
      enddo
    endif
  endif
!$OMP end parallel
 
end subroutine find_eta_3d
 
!> Calculates the free surface height, using the appropriate form for consistency
!! with the calculation of the pressure gradient forces.  Additionally, the sea
!! surface height may be adjusted for consistency with the corresponding
!! time-average quantity from the barotropic calculation.
subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m)
  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_(G)),   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(SZI_(G),SZJ_(G)),           intent(out) :: eta !< free surface height relative to
                                                                 !! mean sea level (z=0) often [Z ~> m].
  real, dimension(SZI_(G),SZJ_(G)), optional, intent(in)  :: eta_bt !< optional barotropic
                   !! variable that gives the "correct" free surface height (Boussinesq) or total
                   !! water column mass per unit area (non-Boussinesq) [H ~> m or kg m-2].
  integer,                          optional, intent(in)  :: halo_size !< width of halo points on
                                                                 !! which to calculate eta.
  real,                             optional, intent(in)  :: eta_to_m  !< The conversion factor from
             !! 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].
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
    dz_geo     ! The change in geopotential height across a layer [m2 s-2].
  real :: htot(SZI_(G))  ! The sum of all layers' thicknesses [H ~> m or kg m-2].
  real :: I_gEarth
  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
 
  halo = 0 ; if (present(halo_size)) halo = max(0,halo_size)
  is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo
  nz = g%ke
 
  z_to_eta = 1.0 ; if (present(eta_to_m)) z_to_eta = us%Z_to_m / eta_to_m
  h_to_eta = gv%H_to_Z * z_to_eta
  h_to_rho_eta =  gv%H_to_kg_m2 * (us%m_to_Z * z_to_eta)
  i_gearth = z_to_eta / (us%Z_to_m * gv%mks_g_Earth)
 
!$OMP parallel default(shared) private(htot)
!$OMP do
  do j=js,je ; do i=is,ie ; eta(i,j) = -z_to_eta*g%bathyT(i,j) ; enddo ; enddo
 
  if (gv%Boussinesq) then
    if (present(eta_bt)) then
!$OMP do
      do j=js,je ; do i=is,ie
        eta(i,j) = h_to_eta*eta_bt(i,j)
      enddo ; enddo
    else
!$OMP do
      do j=js,je ; do k=1,nz ; do i=is,ie
        eta(i,j) = eta(i,j) + h(i,j,k)*h_to_eta
      enddo ; enddo ; enddo
    endif
  else
    if (associated(tv%eqn_of_state)) then
!$OMP do
      do j=js,je
        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)
        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)
      enddo
!$OMP do
      do j=js,je ; do k=1,nz ; do i=is,ie
          eta(i,j) = eta(i,j) + i_gearth * dz_geo(i,j,k)
      enddo ; enddo ; enddo
    else
!$OMP do
      do j=js,je ; do k=1,nz ; do i=is,ie
        eta(i,j) = eta(i,j) + h_to_rho_eta*h(i,j,k)/gv%Rlay(k)
      enddo ; enddo ; enddo
    endif
    if (present(eta_bt)) then
      !   Dilate the water column to agree with the time-averaged column
      ! mass from the barotropic solution.
!$OMP do
      do j=js,je
        do i=is,ie ; htot(i) = gv%H_subroundoff ; enddo
        do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo
        do i=is,ie
          eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + z_to_eta*g%bathyT(i,j)) - &
                     z_to_eta*g%bathyT(i,j)
        enddo
      enddo
    endif
  endif
!$OMP end parallel
 
end subroutine find_eta_2d
 
end module mom_interface_heights