diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90
index 7d6ccd84cf..51d3e0c7b7 100644
--- a/config_src/coupled_driver/MOM_surface_forcing.F90
+++ b/config_src/coupled_driver/MOM_surface_forcing.F90
@@ -50,110 +50,106 @@ module MOM_surface_forcing
public ice_ocn_bnd_type_chksum
public forcing_save_restart
-
-! surface_forcing_CS is a structure containing pointers to the forcing fields
-! which may be used to drive MOM. All fluxes are positive downward.
+!> surface_forcing_CS is a structure containing pointers to the forcing fields
+!! which may be used to drive MOM. All fluxes are positive downward.
type, public :: surface_forcing_CS ; private
- integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integer values
- ! from MOM_domains) to indicate the staggering of
- ! the winds that are being provided in calls to
- ! update_ocean_model.
- logical :: use_temperature ! If true, temp and saln used as state variables
+ integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integer values
+ !! from MOM_domains) to indicate the staggering of
+ !! the winds that are being provided in calls to
+ !! update_ocean_model.
+ logical :: use_temperature !< If true, temp and saln used as state variables
real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress (nondim).
- ! smg: remove when have A=B code reconciled
- logical :: bulkmixedlayer ! If true, model based on bulk mixed layer code
-
- real :: Rho0 ! Boussinesq reference density (kg/m^3)
- real :: area_surf = -1.0 ! total ocean surface area (m^2)
- 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
- ! structure does not limit the water that can be
- ! frozen out of the ocean and the ice-ocean heat
- ! fluxes are treated explicitly.
- logical :: use_limited_P_SSH ! If true, return the sea surface height with
- ! the correction for the atmospheric (and sea-ice)
- ! pressure limited by max_p_surf instead of the
- ! full atmospheric pressure. The default is true.
-
- real :: gust_const ! constant unresolved background gustiness for ustar (Pa)
- logical :: read_gust_2d ! If true, use a 2-dimensional gustiness supplied
- ! from an input file.
+ real :: Rho0 !< Boussinesq reference density (kg/m^3)
+ real :: area_surf = -1.0 !< Total ocean surface area (m^2)
+ real :: latent_heat_fusion !< Latent heat of fusion (J/kg)
+ real :: latent_heat_vapor !< Latent heat of vaporization (J/kg)
+
+ real :: max_p_surf !< The maximum surface pressure that can be
+ !! exerted by the atmosphere and floating sea-ice,
+ !! in 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.
+ logical :: use_limited_P_SSH !< If true, return the sea surface height with
+ !! the correction for the atmospheric (and sea-ice)
+ !! pressure limited by max_p_surf instead of the
+ !! full atmospheric pressure. The default is true.
+ logical :: approx_net_mass_src !< If true, use the net mass sources from the ice-ocean boundary
+ !! type without any further adjustments to drive the ocean dynamics.
+ !! The actual net mass source may differ due to corrections.
+
+ real :: gust_const !< Constant unresolved background gustiness for ustar (Pa)
+ logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied from an input file.
+ real, pointer, dimension(:,:) :: &
+ TKE_tidal => NULL() !< Turbulent kinetic energy introduced to the bottom boundary layer
+ !! by drag on the tidal flows, in W m-2.
+ real, pointer, dimension(:,:) :: &
+ gust => NULL() !< A spatially varying unresolved background gustiness that
+ !! contributes to ustar (Pa). gust is used when read_gust_2d is true.
real, pointer, dimension(:,:) :: &
- TKE_tidal => NULL(), & ! turbulent kinetic energy introduced to the
- ! bottom boundary layer by drag on the tidal flows,
- ! in W m-2.
- gust => NULL(), & ! spatially varying unresolved background
- ! gustiness that contributes to ustar (Pa).
- ! gust is used when read_gust_2d is true.
- ustar_tidal => NULL() ! tidal contribution to the bottom friction velocity (m/s)
- real :: cd_tides ! drag coefficient that applies to the tides (nondimensional)
- real :: utide ! constant tidal velocity to use if read_tideamp
- ! is false, in m s-1.
- logical :: read_tideamp ! If true, spatially varying tidal amplitude read from a file.
-
- logical :: rigid_sea_ice ! If true, sea-ice exerts a rigidity that acts
- ! to damp surface deflections (especially surface
- ! gravity waves). The default is false.
- real :: Kv_sea_ice ! viscosity in sea-ice that resists sheared vertical motions (m^2/s)
- real :: density_sea_ice ! typical density of sea-ice (kg/m^3). The value is
- ! only used to convert the ice pressure into
- ! appropriate units for use with Kv_sea_ice.
- real :: rigid_sea_ice_mass ! A mass per unit area of sea-ice beyond which
- ! sea-ice viscosity becomes effective, in kg m-2,
- ! typically of order 1000 kg m-2.
- logical :: allow_flux_adjustments ! If true, use data_override to obtain flux adjustments
-
- real :: Flux_const ! piston velocity for surface restoring (m/s)
- logical :: salt_restore_as_sflux ! If true, SSS restore as salt flux instead of water flux
- logical :: adjust_net_srestore_to_zero ! adjust srestore to zero (for both salt_flux or vprec)
- logical :: adjust_net_srestore_by_scaling ! adjust srestore w/o moving zero contour
- logical :: adjust_net_fresh_water_to_zero ! adjust net surface fresh-water (w/ restoring) to zero
- logical :: use_net_FW_adjustment_sign_bug ! use the wrong sign when adjusting net FW
- logical :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour
- logical :: mask_srestore_under_ice ! If true, use an ice mask defined by frazil
- ! criteria for salinity restoring.
- real :: ice_salt_concentration ! salt concentration for sea ice (kg/kg)
- logical :: mask_srestore_marginal_seas ! if true, then mask SSS restoring in marginal seas
- real :: max_delta_srestore ! maximum delta salinity used for restoring
- real :: max_delta_trestore ! maximum delta sst used for restoring
- real, pointer, dimension(:,:) :: basin_mask => NULL() ! mask for SSS restoring by basin
-
- type(diag_ctrl), pointer :: diag ! structure to regulate diagnostic output timing
- character(len=200) :: inputdir ! directory where NetCDF input files are
- character(len=200) :: salt_restore_file ! filename for salt restoring data
- character(len=30) :: salt_restore_var_name ! name of surface salinity in salt_restore_file
- logical :: mask_srestore ! if true, apply a 2-dimensional mask to the surface
- ! salinity restoring fluxes. The masking file should be
- ! in inputdir/salt_restore_mask.nc and the field should
- ! be named 'mask'
- real, pointer, dimension(:,:) :: srestore_mask => NULL() ! mask for SSS restoring
- character(len=200) :: temp_restore_file ! filename for sst restoring data
- character(len=30) :: temp_restore_var_name ! name of surface temperature in temp_restore_file
- logical :: mask_trestore ! if true, apply a 2-dimensional mask to the surface
- ! temperature restoring fluxes. The masking file should be
- ! in inputdir/temp_restore_mask.nc and the field should
- ! be named 'mask'
- real, pointer, dimension(:,:) :: trestore_mask => NULL() ! mask for SST restoring
- integer :: id_srestore = -1 ! id number for time_interp_external.
- integer :: id_trestore = -1 ! id number for time_interp_external.
-
- ! Diagnostics handles
- type(forcing_diags), public :: handles
+ ustar_tidal => NULL() !< Tidal contribution to the bottom friction velocity (m/s)
+ real :: cd_tides !< Drag coefficient that applies to the tides (nondimensional)
+ real :: utide !< Constant tidal velocity to use if read_tideamp is false, in m s-1.
+ logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file.
+
+ logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts to damp surface
+ !! deflections (especially surface gravity waves). The default is false.
+ real :: Kv_sea_ice !< Viscosity in sea-ice that resists sheared vertical motions (m^2/s)
+ real :: density_sea_ice !< Typical density of sea-ice (kg/m^3). The value is only used to convert
+ !! the ice pressure into appropriate units for use with Kv_sea_ice.
+ real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which sea-ice viscosity
+ !! becomes effective, in kg m-2, typically of order 1000 kg m-2.
+ logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments
+
+ logical :: restore_salt !< If true, the coupled MOM driver adds a term to restore surface
+ !! salinity to a specified value.
+ logical :: restore_temp !< If true, the coupled MOM driver adds a term to restore sea
+ !! surface temperature to a specified value.
+ real :: Flux_const !< Piston velocity for surface restoring (m/s)
+ logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux
+ logical :: adjust_net_srestore_to_zero !< Adjust srestore to zero (for both salt_flux or vprec)
+ logical :: adjust_net_srestore_by_scaling !< Adjust srestore w/o moving zero contour
+ logical :: adjust_net_fresh_water_to_zero !< Adjust net surface fresh-water (with restoring) to zero
+ logical :: use_net_FW_adjustment_sign_bug !< Use the wrong sign when adjusting net FW
+ logical :: adjust_net_fresh_water_by_scaling !< Adjust net surface fresh-water w/o moving zero contour
+ logical :: mask_srestore_under_ice !< If true, use an ice mask defined by frazil criteria
+ !! for salinity restoring.
+ real :: ice_salt_concentration !< Salt concentration for sea ice (kg/kg)
+ logical :: mask_srestore_marginal_seas !< If true, then mask SSS restoring in marginal seas
+ real :: max_delta_srestore !< Maximum delta salinity used for restoring
+ real :: max_delta_trestore !< Maximum delta sst used for restoring
+ real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin
+
+ type(diag_ctrl), pointer :: diag => NULL() !< Structure to regulate diagnostic output timing
+ character(len=200) :: inputdir !< Directory where NetCDF input files are
+ character(len=200) :: salt_restore_file !< Filename for salt restoring data
+ character(len=30) :: salt_restore_var_name !< Name of surface salinity in salt_restore_file
+ logical :: mask_srestore !< If true, apply a 2-dimensional mask to the surface
+ !! salinity restoring fluxes. The masking file should be
+ !! in inputdir/salt_restore_mask.nc and the field should
+ !! be named 'mask'
+ real, pointer, dimension(:,:) :: srestore_mask => NULL() !< mask for SSS restoring
+ character(len=200) :: temp_restore_file !< Filename for sst restoring data
+ character(len=30) :: temp_restore_var_name !< Name of surface temperature in temp_restore_file
+ logical :: mask_trestore !< If true, apply a 2-dimensional mask to the surface
+ !! temperature restoring fluxes. The masking file should be
+ !! in inputdir/temp_restore_mask.nc and the field should
+ !! be named 'mask'
+ real, pointer, dimension(:,:) :: trestore_mask => NULL() !< Mask for SST restoring
+ integer :: id_srestore = -1 !< An id number for time_interp_external.
+ integer :: id_trestore = -1 !< An id number for time_interp_external.
+
+ type(forcing_diags), public :: handles !< Diagnostics handles
!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL()
- type(MOM_restart_CS), pointer :: restart_CSp => NULL()
- type(user_revise_forcing_CS), pointer :: urf_CS => NULL()
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure
+ type(user_revise_forcing_CS), pointer :: urf_CS => NULL() !< A control structure for user forcing revisions
end type surface_forcing_CS
-! ice_ocean_boundary_type is a structure corresponding to forcing, but with
-! the elements, units, and conventions that exactly conform to the use for
-! MOM-based coupled models.
+!> ice_ocean_boundary_type is a structure corresponding to forcing, but with the elements, units,
+!! and conventions that exactly conform to the use for MOM6-based coupled models.
type, public :: ice_ocean_boundary_type
real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa)
real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa)
@@ -169,6 +165,7 @@ module MOM_surface_forcing
real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip (kg/m2/s)
real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff (kg/m2/s)
real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff (kg/m2/s)
+ real, pointer, dimension(:,:) :: stress_mag =>NULL() !< The time-mean magnitude of the stress on the ocean (Pa)
real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs (m/s)
real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2)
real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2)
@@ -181,30 +178,28 @@ module MOM_surface_forcing
!! ice-shelves, expressed as a coefficient
!! for divergence damping, as determined
!! outside of the ocean model in (m3/s)
- integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT
- type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of
- !! named fields used for passive tracer fluxes.
- integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of
- !! wind stresses. This flag may be set by the
- !! flux-exchange code, based on what the sea-ice
- !! model is providing. Otherwise, the value from
- !! the surface_forcing_CS is used.
+ integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT
+ type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of named fields
+ !! used for passive tracer fluxes.
+ integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of wind stresses.
+ !! This flag may be set by the flux-exchange code, based on what
+ !! the sea-ice model is providing. Otherwise, the value from
+ !! the surface_forcing_CS is used.
end type ice_ocean_boundary_type
-integer :: id_clock_forcing
+integer :: id_clock_forcing !< A CPU time clock
contains
!> This subroutine translates the Ice_ocean_boundary_type into a MOM
!! thermodynamic forcing type, including changes of units, sign conventions,
!! and putting the fields into arrays with MOM-standard halos.
-subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
- sfc_state, restore_salt, restore_temp)
+subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, sfc_state)
type(ice_ocean_boundary_type), &
target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive
!! the ocean in a coupled model
- type(forcing), intent(inout) :: fluxes !< A structure containing pointers to
- !! all possible mass, heat or salt flux forcing fields.
+ type(forcing), intent(inout) :: fluxes !< A structure containing pointers to all
+ !! possible mass, heat or salt flux forcing fields.
!! Unused fields have NULL ptrs.
integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB.
type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the
@@ -214,9 +209,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
!! previous call to surface_forcing_init.
type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the
!! surface state of the ocean.
- logical, optional, intent(in) :: restore_salt !< If true, salinity is restored to a target value.
- logical, optional, intent(in) :: restore_temp !< If true, temperature is restored to a target value.
-
real, dimension(SZI_(G),SZJ_(G)) :: &
data_restore, & ! The surface value toward which to restore (g/kg or degC)
@@ -236,10 +228,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer
integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd
- logical :: restore_salinity ! local copy of the argument restore_salt, if it
- ! is present, or false (no restoring) otherwise.
- logical :: restore_sst ! local copy of the argument restore_temp, if it
- ! is present, or false (no restoring) otherwise.
real :: delta_sss ! temporary storage for sss diff from restoring value
real :: delta_sst ! temporary storage for sst diff from restoring value
@@ -266,11 +254,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
fluxes%netFWGlobalAdj = 0.0
fluxes%netFWGlobalScl = 0.0
- restore_salinity = .false.
- if (present(restore_salt)) restore_salinity = restore_salt
- restore_sst = .false.
- if (present(restore_temp)) restore_sst = restore_temp
-
! allocation and initialization if this is the first time that this
! flux type has been used.
if (fluxes%dt_buoy_accum < 0) then
@@ -307,7 +290,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j)
enddo ; enddo
- if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed)
+ if (CS%restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed)
fluxes%dt_buoy_accum = 0.0
endif ! endif for allocation and initialization
@@ -326,7 +309,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
! ocean model, rather than using haloless arrays, in which case the last line
! would be: ( (/isd,is,ie,ied/), (/jsd,js,je,jed/))
-
if (CS%allow_flux_adjustments) then
fluxes%heat_added(:,:)=0.0
fluxes%salt_flux_added(:,:)=0.0
@@ -346,7 +328,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
enddo ; enddo
! Salinity restoring logic
- if (restore_salinity) then
+ if (CS%restore_salt) then
call time_interp_external(CS%id_srestore,Time,data_restore)
! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not)
open_ocn_mask(:,:) = 1.0
@@ -399,7 +381,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
endif
! SST restoring logic
- if (restore_sst) then
+ if (CS%restore_temp) then
call time_interp_external(CS%id_trestore,Time,data_restore)
do j=js,je ; do i=is,ie
delta_sst = data_restore(i,j)- sfc_state%SST(i,j)
@@ -547,6 +529,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
endif
+ ! Set the wind stresses and ustar.
+ if (associated(fluxes%ustar) .and. associated(fluxes%ustar_gustless)) then
+ call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, ustar=fluxes%ustar, &
+ gustless_ustar=fluxes%ustar_gustless)
+ elseif (associated(fluxes%ustar)) then
+ call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, ustar=fluxes%ustar)
+ elseif (associated(fluxes%ustar_gustless)) then
+ call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, gustless_ustar=fluxes%ustar_gustless)
+ endif
+
if (coupler_type_initialized(fluxes%tr_fluxes) .and. &
coupler_type_initialized(IOB%fluxes)) &
call coupler_type_copy_data(IOB%fluxes, fluxes%tr_fluxes)
@@ -566,7 +558,7 @@ end subroutine convert_IOB_to_fluxes
!> This subroutine translates the Ice_ocean_boundary_type into a MOM
!! mechanical forcing type, including changes of units, sign conventions,
!! and putting the fields into arrays with MOM-standard halos.
-subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS)
+subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forcing, reset_avg)
type(ice_ocean_boundary_type), &
target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive
!! the ocean in a coupled model
@@ -577,27 +569,24 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a
!! previous call to surface_forcing_init.
+ real, optional, intent(in) :: dt_forcing !< A time interval over which to apply the
+ !! current value of ustar as a weighted running
+ !! average, in s, or if 0 do not average ustar.
+ !! Missing is equivalent to 0.
+ logical, optional, intent(in) :: reset_avg !< If true, reset the time average.
-
- real, dimension(SZIB_(G),SZJB_(G)) :: &
- taux_at_q, & ! Zonal wind stresses at q points (Pa)
- tauy_at_q ! Meridional wind stresses at q points (Pa)
-
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
- rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1)
- taux_at_h, & ! Zonal wind stresses at h points (Pa)
- tauy_at_h ! Meridional wind stresses at h points (Pa)
+ rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1)
+ net_mass_src, & ! A temporary of net mass sources, in kg m-2 s-1.
+ ustar_tmp ! A temporary array of ustar values, in m s-1.
- real :: gustiness ! unresolved gustiness that contributes to ustar (Pa)
- real :: Irho0 ! inverse of the mean density in (m^3/kg)
- real :: taux2, tauy2 ! squared wind stresses (Pa^2)
- real :: tau_mag ! magnitude of the wind stress (Pa)
real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m)
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)
+ real :: wt1, wt2 ! Relative weights of previous and current values of ustar, ND.
- integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains)
integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer
integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd
@@ -613,8 +602,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS)
isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1
i0 = is - isc_bnd ; j0 = js - jsc_bnd
- Irho0 = 1.0/CS%Rho0
-
! allocation and initialization if this is the first time that this
! mechanical forcing type has been used.
if (.not.forces%initialized) then
@@ -640,6 +627,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS)
if ( (associated(IOB%area_berg) .and. (.not. associated(forces%area_berg))) .or. &
(associated(IOB%mass_berg) .and. (.not. associated(forces%mass_berg))) ) &
call allocate_mech_forcing(G, forces, iceberg=.true.)
+
if (associated(IOB%ice_rigidity)) then
rigidity_at_h(:,:) = 0.0
call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed)
@@ -650,6 +638,23 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS)
if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0
if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0
+ ! Set the weights for forcing fields that use running time averages.
+ if (present(reset_avg)) then ; if (reset_avg) forces%dt_force_accum = 0.0 ; endif
+ wt1 = 0.0 ; wt2 = 1.0
+ if (present(dt_forcing)) then
+ if ((forces%dt_force_accum > 0.0) .and. (dt_forcing > 0.0)) then
+ wt1 = forces%dt_force_accum / (forces%dt_force_accum + dt_forcing)
+ wt2 = 1.0 - wt1
+ endif
+ if (dt_forcing > 0.0) then
+ forces%dt_force_accum = max(forces%dt_force_accum, 0.0) + dt_forcing
+ else
+ forces%dt_force_accum = 0.0 ! Reset the averaging time interval.
+ endif
+ else
+ forces%dt_force_accum = 0.0 ! Reset the averaging time interval.
+ endif
+
! applied surface pressure from atmosphere and cryosphere
if (associated(IOB%p)) then
if (CS%max_p_surf >= 0.0) then
@@ -671,136 +676,62 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS)
endif
forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure.
- wind_stagger = CS%wind_stagger
- if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. &
- (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger
- if (wind_stagger == BGRID_NE) then
- ! This is necessary to fill in the halo points.
- taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0
- endif
- if (wind_stagger == AGRID) then
- ! This is necessary to fill in the halo points.
- taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0
- endif
-
- ! obtain fluxes from IOB; note the staggering of indices
- do j=js,je ; do i=is,ie
- if (associated(IOB%area_berg)) &
- forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j)
-
- if (associated(IOB%mass_berg)) &
- forces%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j)
-
- if (associated(IOB%ice_rigidity)) &
- rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j)
-
- if (wind_stagger == BGRID_NE) then
- if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier
- if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier
- elseif (wind_stagger == AGRID) then
- if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier
- if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier
- else ! C-grid wind stresses.
- if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier
- if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier
- endif
-
- enddo ; enddo
-
- ! surface momentum stress related fields as function of staggering
- if (wind_stagger == BGRID_NE) then
- if (G%symmetric) &
- call fill_symmetric_edges(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE)
- call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE, halo=1)
-
- do j=js,je ; do I=Isq,Ieq
- forces%taux(I,j) = 0.0
- if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) &
- forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + &
- G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / &
- (G%mask2dBu(I,J) + G%mask2dBu(I,J-1))
- enddo ; enddo
-
- do J=Jsq,Jeq ; do i=is,ie
- forces%tauy(i,J) = 0.0
- if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) &
- forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + &
- G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / &
- (G%mask2dBu(I,J) + G%mask2dBu(I-1,J))
- enddo ; enddo
-
- ! ustar is required for the bulk mixed layer formulation. The background value
- ! of 0.02 Pa is a relatively small value intended to give reasonable behavior
- ! in regions of very weak winds.
-
+ ! Set the wind stresses and ustar.
+ if (wt1 <= 0.0) then
+ call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, &
+ ustar=forces%ustar, tau_halo=1)
+ else
+ call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, &
+ ustar=ustar_tmp, tau_halo=1)
do j=js,je ; do i=is,ie
- tau_mag = 0.0 ; gustiness = CS%gust_const
- if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + &
- (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then
- tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + &
- G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + &
- (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + &
- G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / &
- ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) )
- if (CS%read_gust_2d) gustiness = CS%gust(i,j)
- endif
- forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag)
- enddo ; enddo
-
- elseif (wind_stagger == AGRID) then
- call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, &
- stagger=AGRID, halo=1)
-
- do j=js,je ; do I=Isq,Ieq
- forces%taux(I,j) = 0.0
- if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) &
- forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + &
- G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / &
- (G%mask2dT(i,j) + G%mask2dT(i+1,j))
+ forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j)
enddo ; enddo
+ endif
- do J=Jsq,Jeq ; do i=is,ie
- forces%tauy(i,J) = 0.0
- if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) &
- forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + &
- G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / &
- (G%mask2dT(i,j) + G%mask2dT(i,j+1))
- enddo ; enddo
+ ! Find the net mass source in the input forcing without other adjustments.
+ if (CS%approx_net_mass_src .and. associated(forces%net_mass_src)) then
+ net_mass_src(:,:) = 0.0
+ i0 = is - isc_bnd ; j0 = js - jsc_bnd
+ do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
+ if (associated(IOB%lprec)) &
+ net_mass_src(i,j) = net_mass_src(i,j) + IOB%lprec(i-i0,j-j0)
+ if (associated(IOB%fprec)) &
+ net_mass_src(i,j) = net_mass_src(i,j) + IOB%fprec(i-i0,j-j0)
+ if (associated(IOB%runoff)) &
+ net_mass_src(i,j) = net_mass_src(i,j) + IOB%runoff(i-i0,j-j0)
+ if (associated(IOB%calving)) &
+ net_mass_src(i,j) = net_mass_src(i,j) + IOB%calving(i-i0,j-j0)
+ if (associated(IOB%q_flux)) &
+ net_mass_src(i,j) = net_mass_src(i,j) - IOB%q_flux(i-i0,j-j0)
+ endif ; enddo ; enddo
+ if (wt1 <= 0.0) then
+ do j=js,je ; do i=is,ie
+ forces%net_mass_src(i,j) = wt2*net_mass_src(i,j)
+ enddo ; enddo
+ else
+ do j=js,je ; do i=is,ie
+ forces%net_mass_src(i,j) = wt1*forces%net_mass_src(i,j) + wt2*net_mass_src(i,j)
+ enddo ; enddo
+ endif
+ forces%net_mass_src_set = .true.
+ else
+ forces%net_mass_src_set = .false.
+ endif
- do j=js,je ; do i=is,ie
- gustiness = CS%gust_const
- if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j)
- forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * &
- sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2))
- enddo ; enddo
+ ! Obtain optional ice-berg related fluxes from the IOB type:
+ if (associated(IOB%area_berg)) then ; do j=js,je ; do i=is,ie
+ forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j)
+ enddo ; enddo ; endif
- else ! C-grid wind stresses.
- if (G%symmetric) &
- call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain)
- call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1)
+ if (associated(IOB%mass_berg)) then ; do j=js,je ; do i=is,ie
+ forces%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j)
+ enddo ; enddo ; endif
+ ! Obtain sea ice related dynamic fields
+ if (associated(IOB%ice_rigidity)) then
do j=js,je ; do i=is,ie
- taux2 = 0.0
- if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) &
- taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + &
- G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j))
-
- tauy2 = 0.0
- if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) &
- tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + &
- G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J))
-
- if (CS%read_gust_2d) then
- forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2))
- else
- forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2))
- endif
+ rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j)
enddo ; enddo
-
- endif ! endif for wind related fields
-
- ! sea ice related dynamic fields
- if (associated(IOB%ice_rigidity)) then
call pass_var(rigidity_at_h, G%Domain, halo=1)
do I=is-1,ie ; do j=js,je
forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + &
@@ -847,6 +778,226 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS)
call cpu_clock_end(id_clock_forcing)
end subroutine convert_IOB_to_forces
+
+!> This subroutine extracts the wind stresses and related fields like ustar from an
+!! Ice_ocean_boundary_type into optional argument arrays, including changes of units, sign
+!! conventions, and putting the fields into arrays with MOM-standard sized halos.
+subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, ustar, &
+ gustless_ustar, tau_halo)
+ type(ice_ocean_boundary_type), &
+ target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive
+ !! the ocean in a coupled model
+ integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB.
+ type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the
+ !! salinity to the right time, when it is being restored.
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
+ type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a
+ !! previous call to surface_forcing_init.
+ real, dimension(SZIB_(G),SZJ_(G)), &
+ optional, intent(inout) :: taux !< The zonal wind stresses on a C-grid, in Pa.
+ real, dimension(SZI_(G),SZJB_(G)), &
+ optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid, in Pa.
+ real, dimension(SZI_(G),SZJ_(G)), &
+ optional, intent(inout) :: ustar !< The surface friction velocity, in m s-1.
+ real, dimension(SZI_(G),SZJ_(G)), &
+ optional, intent(out) :: gustless_ustar !< The surface friction velocity without
+ !! any contributions from gustiness, in m s-1.
+ integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default.
+
+ ! Local variables
+ real, dimension(SZI_(G),SZJ_(G)) :: taux_in_A ! Zonal wind stresses (in Pa) at h points
+ real, dimension(SZI_(G),SZJ_(G)) :: tauy_in_A ! Meridional wind stresses (in Pa) at h points
+ real, dimension(SZIB_(G),SZJ_(G)) :: taux_in_C ! Zonal wind stresses (in Pa) at u points
+ real, dimension(SZI_(G),SZJB_(G)) :: tauy_in_C ! Meridional wind stresses (in Pa) at v points
+ real, dimension(SZIB_(G),SZJB_(G)) :: taux_in_B ! Zonal wind stresses (in Pa) at q points
+ real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses (in Pa) at q points
+
+ real :: gustiness ! unresolved gustiness that contributes to ustar (Pa)
+ real :: Irho0 ! inverse of the mean density in (m^3/kg)
+ real :: taux2, tauy2 ! squared wind stresses (Pa^2)
+ real :: tau_mag ! magnitude of the wind stress (Pa)
+
+ logical :: do_ustar, do_gustless
+ integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains)
+ integer :: i, j, is, ie, js, je, ish, ieh, jsh, jeh, Isqh, Ieqh, Jsqh, Jeqh, i0, j0, halo
+
+ halo = 0 ; if (present(tau_halo)) halo = tau_halo
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
+ ish = G%isc-halo ; ieh = G%iec+halo ; jsh = G%jsc-halo ; jeh = G%jec+halo
+ Isqh = G%IscB-halo ; Ieqh = G%IecB+halo ; Jsqh = G%JscB-halo ; Jeqh = G%JecB+halo
+ i0 = is - index_bounds(1) ; j0 = js - index_bounds(3)
+
+ Irho0 = 1.0/CS%Rho0
+
+ do_ustar = present(ustar) ; do_gustless = present(gustless_ustar)
+
+ wind_stagger = CS%wind_stagger
+ if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. &
+ (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger
+
+ if (associated(IOB%u_flux).neqv.associated(IOB%v_flux)) call MOM_error(FATAL,"extract_IOB_stresses: "//&
+ "associated(IOB%u_flux) /= associated(IOB%v_flux !!!")
+ if (present(taux).neqv.present(tauy)) call MOM_error(FATAL,"extract_IOB_stresses: "//&
+ "present(taux) /= present(tauy) !!!")
+
+ ! Set surface momentum stress related fields as a function of staggering.
+ if (present(taux) .or. present(tauy) .or. &
+ ((do_ustar.or.do_gustless) .and. .not.associated(IOB%stress_mag)) ) then
+
+ if (wind_stagger == BGRID_NE) then
+ taux_in_B(:,:) = 0.0 ; tauy_in_B(:,:) = 0.0
+ if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then
+ do J=js,je ; do I=is,ie
+ taux_in_B(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier
+ tauy_in_B(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier
+ enddo ; enddo
+ endif
+
+ if (G%symmetric) call fill_symmetric_edges(taux_in_B, tauy_in_B, G%Domain, stagger=BGRID_NE)
+ call pass_vector(taux_in_B, tauy_in_B, G%Domain, stagger=BGRID_NE, halo=max(1,halo))
+
+ if (present(taux).and.present(tauy)) then
+ do j=jsh,jeh ; do I=Isqh,Ieqh
+ taux(I,j) = 0.0
+ if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) &
+ taux(I,j) = (G%mask2dBu(I,J)*taux_in_B(I,J) + G%mask2dBu(I,J-1)*taux_in_B(I,J-1)) / &
+ (G%mask2dBu(I,J) + G%mask2dBu(I,J-1))
+ enddo ; enddo
+ do J=Jsqh,Jeqh ; do i=ish,ieh
+ tauy(i,J) = 0.0
+ if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) &
+ tauy(i,J) = (G%mask2dBu(I,J)*tauy_in_B(I,J) + G%mask2dBu(I-1,J)*tauy_in_B(I-1,J)) / &
+ (G%mask2dBu(I,J) + G%mask2dBu(I-1,J))
+ enddo ; enddo
+ endif
+ elseif (wind_stagger == AGRID) then
+ taux_in_A(:,:) = 0.0 ; tauy_in_A(:,:) = 0.0
+ if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then
+ do j=js,je ; do i=is,ie
+ taux_in_A(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier
+ tauy_in_A(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier
+ enddo ; enddo
+ endif
+
+ if (halo == 0) then
+ call pass_vector(taux_in_A, tauy_in_A, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1)
+ else
+ call pass_vector(taux_in_A, tauy_in_A, G%Domain, stagger=AGRID, halo=max(1,halo))
+ endif
+
+ if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh
+ taux(I,j) = 0.0
+ if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) &
+ taux(I,j) = (G%mask2dT(i,j)*taux_in_A(i,j) + G%mask2dT(i+1,j)*taux_in_A(i+1,j)) / &
+ (G%mask2dT(i,j) + G%mask2dT(i+1,j))
+ enddo ; enddo ; endif
+
+ if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh
+ tauy(i,J) = 0.0
+ if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) &
+ tauy(i,J) = (G%mask2dT(i,j)*tauy_in_A(i,j) + G%mask2dT(i,J+1)*tauy_in_A(i,j+1)) / &
+ (G%mask2dT(i,j) + G%mask2dT(i,j+1))
+ enddo ; enddo ; endif
+
+ else ! C-grid wind stresses.
+ taux_in_C(:,:) = 0.0 ; tauy_in_C(:,:) = 0.0
+ if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then
+ do j=js,je ; do i=is,ie
+ taux_in_C(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier
+ tauy_in_C(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier
+ enddo ; enddo
+ endif
+
+ if (G%symmetric) call fill_symmetric_edges(taux_in_C, tauy_in_C, G%Domain)
+ call pass_vector(taux_in_C, tauy_in_C, G%Domain, halo=max(1,halo))
+
+ if (present(taux).and.present(tauy)) then
+ do j=jsh,jeh ; do I=Isqh,Ieqh
+ taux(I,j) = G%mask2dCu(I,j)*taux_in_C(I,j)
+ enddo ; enddo
+ do J=Jsqh,Jeqh ; do i=ish,ieh
+ tauy(i,J) = G%mask2dCv(i,J)*tauy_in_C(i,J)
+ enddo ; enddo
+ endif
+ endif ! endif for extracting wind stress fields with various staggerings
+ endif
+
+ if (do_ustar .or. do_gustless) then
+ ! Set surface friction velocity directly or as a function of staggering.
+ ! ustar is required for the bulk mixed layer formulation and other turbulent mixing
+ ! parametizations. The background gustiness (for example with a relatively small value
+ ! of 0.02 Pa) is intended to give reasonable behavior in regions of very weak winds.
+ if (associated(IOB%stress_mag)) then
+ if (do_ustar) then ; do j=js,je ; do i=is,ie
+ gustiness = CS%gust_const
+ !### SIMPLIFY THE TREATMENT OF GUSTINESS!
+ if (CS%read_gust_2d) then
+ if ((wind_stagger == CGRID_NE) .or. &
+ ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. &
+ ((wind_stagger == BGRID_NE) .and. &
+ (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + &
+ (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) &
+ gustiness = CS%gust(i,j)
+ endif
+ ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0))
+ enddo ; enddo ; endif
+ if (do_gustless) then ; do j=js,je ; do i=is,ie
+ gustless_ustar(i,j) = sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0)
+!### Change to:
+! gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0))
+ enddo ; enddo ; endif
+ elseif (wind_stagger == BGRID_NE) then
+ do j=js,je ; do i=is,ie
+ tau_mag = 0.0 ; gustiness = CS%gust_const
+ if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + &
+ (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then
+ tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_in_B(I,J)**2 + tauy_in_B(I,J)**2) + &
+ G%mask2dBu(I-1,J-1)*(taux_in_B(I-1,J-1)**2 + tauy_in_B(I-1,J-1)**2)) + &
+ (G%mask2dBu(I,J-1)*(taux_in_B(I,J-1)**2 + tauy_in_B(I,J-1)**2) + &
+ G%mask2dBu(I-1,J)*(taux_in_B(I-1,J)**2 + tauy_in_B(I-1,J)**2)) ) / &
+ ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) )
+ if (CS%read_gust_2d) gustiness = CS%gust(i,j)
+ endif
+ if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag)
+ if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0)
+!### Change to:
+! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag)
+ enddo ; enddo
+ elseif (wind_stagger == AGRID) then
+ do j=js,je ; do i=is,ie
+ tau_mag = G%mask2dT(i,j) * sqrt(taux_in_A(i,j)**2 + tauy_in_A(i,j)**2)
+ gustiness = CS%gust_const
+ if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j)
+ if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag)
+ if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0)
+!### Change to:
+! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag)
+ enddo ; enddo
+ else ! C-grid wind stresses.
+ do j=js,je ; do i=is,ie
+ taux2 = 0.0 ; tauy2 = 0.0
+ if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) &
+ taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + &
+ G%mask2dCu(I,j)*taux_in_C(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j))
+ if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) &
+ tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + &
+ G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J))
+ tau_mag = sqrt(taux2 + tauy2)
+
+ gustiness = CS%gust_const
+ if (CS%read_gust_2d) gustiness = CS%gust(i,j)
+
+ if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag)
+ if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0)
+!### Change to:
+! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag)
+ enddo ; enddo
+ endif ! endif for wind friction velocity fields
+ endif
+
+end subroutine extract_IOB_stresses
+
+
!> Adds thermodynamic flux adjustments obtained via data_override
!! Component name is 'OCN'
!! Available adjustments are:
@@ -950,23 +1101,19 @@ subroutine apply_force_adjustments(G, CS, Time, forces)
end subroutine apply_force_adjustments
+!> Save any restart files associated with the surface forcing.
subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, &
filename_suffix)
- type(surface_forcing_CS), pointer :: CS
+ type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned
+ !! by a previous call to surface_forcing_init
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
- type(time_type), intent(in) :: Time
- character(len=*), intent(in) :: directory
- logical, optional, intent(in) :: time_stamped
- character(len=*), optional, intent(in) :: filename_suffix
-! Arguments: CS - A pointer to the control structure returned by a previous
-! call to surface_forcing_init.
-! (in) G - The ocean's grid structure.
-! (in) Time - The model time at this call. This is needed for mpp_write calls.
-! (in, opt) directory - An optional directory into which to write these restart files.
-! (in, opt) time_stamped - If true, the restart file names include
-! a unique time stamp. The default is false.
-! (in, opt) filename_suffix - An optional suffix (e.g., a time-stamp) to append
-! to the restart file names.
+ type(time_type), intent(in) :: Time !< The current model time
+ character(len=*), intent(in) :: directory !< The directory into which to write the
+ !! restart files
+ logical, optional, intent(in) :: time_stamped !< If true, the restart file names include
+ !! a unique time stamp. The default is false.
+ character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time-
+ !! stamp) to append to the restart file names.
if (.not.associated(CS)) return
if (.not.associated(CS%restart_CSp)) return
@@ -974,22 +1121,17 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, &
end subroutine forcing_save_restart
-subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp)
- type(time_type), intent(in) :: Time
+!> Initialize the surface forcing, including setting parameters and allocating permanent memory.
+subroutine surface_forcing_init(Time, G, param_file, diag, CS)
+ type(time_type), intent(in) :: Time !< The current model time
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- type(diag_ctrl), target, intent(inout) :: diag
- type(surface_forcing_CS), pointer :: CS
- logical, optional, intent(in) :: restore_salt, restore_temp
-! Arguments: Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-! (in) restore_salt - If present and true, salinity restoring will be
-! applied in this model.
+ type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate
+ !! diagnostic output
+ type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control
+ !! structure for this module
+
+ ! Local variables
real :: utide ! The RMS tidal velocity, in m s-1.
type(directories) :: dirs
logical :: new_sim, iceberg_flux_diags
@@ -1046,11 +1188,19 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
"the ice-ocean heat fluxes are treated explicitly. No \n"//&
"limit is applied if a negative value is used.", units="Pa", &
default=-1.0)
+ call get_param(param_file, mdl, "RESTORE_SALINITY", CS%restore_salt, &
+ "If true, the coupled driver will add a globally-balanced \n"//&
+ "fresh-water flux that drives sea-surface salinity \n"//&
+ "toward specified values.", default=.false.)
+ call get_param(param_file, mdl, "RESTORE_TEMPERATURE", CS%restore_temp, &
+ "If true, the coupled driver will add a \n"//&
+ "heat flux that drives sea-surface temperauture \n"//&
+ "toward specified values.", default=.false.)
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\n"//&
"whether restoring is via a salt flux or virtual precip.",&
- default=restore_salt)
+ default=CS%restore_salt)
call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_BY_SCALING", &
CS%adjust_net_srestore_by_scaling, &
"If true, adjustments to salt restoring to achieve zero net are\n"//&
@@ -1080,11 +1230,11 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
"correction for the atmospheric (and sea-ice) pressure \n"//&
"limited by max_p_surf instead of the full atmospheric \n"//&
"pressure.", default=.true.)
-
-! smg: should get_param call should be removed when have A=B code reconciled.
-! this param is used to distinguish how to diagnose surface heat content from water.
- call get_param(param_file, mdl, "BULKMIXEDLAYER", CS%bulkmixedlayer, &
- default=CS%use_temperature,do_not_log=.true.)
+ call get_param(param_file, mdl, "APPROX_NET_MASS_SRC", CS%approx_net_mass_src, &
+ "If true, use the net mass sources from the ice-ocean \n"//&
+ "boundary type without any further adjustments to drive \n"//&
+ "the ocean dynamics. The actual net mass source may differ \n"//&
+ "due to internal corrections.", default=.false.)
call get_param(param_file, mdl, "WIND_STAGGER", stagger, &
"A case-insensitive character string to indicate the \n"//&
@@ -1100,7 +1250,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
"coupler. This is used for testing and should be =1.0 for any\n"//&
"production runs.", default=1.0)
- if (restore_salt) then
+ if (CS%restore_salt) then
call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, &
"The constant that relates the restoring surface fluxes \n"//&
"to the relative surface anomalies (akin to a piston \n"//&
@@ -1148,7 +1298,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
"a mask for SSS restoring.", default=.false.)
endif
- if (restore_temp) then
+ if (CS%restore_temp) then
call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, &
"The constant that relates the restoring surface fluxes \n"//&
"to the relative surface anomalies (akin to a piston \n"//&
@@ -1161,7 +1311,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
"The name of the surface temperature variable to read from "//&
"SST_RESTORE_FILE for restoring sst.", &
default="temp")
-! Convert CS%Flux_const from m day-1 to m s-1.
+ ! Convert CS%Flux_const from m day-1 to m s-1.
CS%Flux_const = CS%Flux_const / 86400.0
call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, &
@@ -1263,11 +1413,10 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, &
"If true, allows flux adjustments to specified via the \n"//&
"data_table using the component name 'OCN'.", default=.false.)
- if (CS%allow_flux_adjustments) then
- call data_override_init(Ocean_domain_in=G%Domain%mpp_domain)
- endif
- if (present(restore_salt)) then ; if (restore_salt) then
+ call data_override_init(Ocean_domain_in=G%Domain%mpp_domain)
+
+ if (CS%restore_salt) then
salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file)
CS%id_srestore = init_external_field(salt_file, CS%salt_restore_var_name, domain=G%Domain%mpp_domain)
call safe_alloc_ptr(CS%srestore_mask,isd,ied,jsd,jed); CS%srestore_mask(:,:) = 1.0
@@ -1275,9 +1424,9 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
flnam = trim(CS%inputdir) // 'salt_restore_mask.nc'
call MOM_read_data(flnam,'mask', CS%srestore_mask, G%domain, timelevel=1)
endif
- endif ; endif
+ endif
- if (present(restore_temp)) then ; if (restore_temp) then
+ if (CS%restore_temp) then
temp_file = trim(CS%inputdir) // trim(CS%temp_restore_file)
CS%id_trestore = init_external_field(temp_file, CS%temp_restore_var_name, domain=G%Domain%mpp_domain)
call safe_alloc_ptr(CS%trestore_mask,isd,ied,jsd,jed); CS%trestore_mask(:,:) = 1.0
@@ -1285,7 +1434,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
flnam = trim(CS%inputdir) // 'temp_restore_mask.nc'
call MOM_read_data(flnam, 'mask', CS%trestore_mask, G%domain, timelevel=1)
endif
- endif ; endif
+ endif
! Set up any restart fields associated with the forcing.
call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res")
@@ -1312,13 +1461,14 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
call cpu_clock_end(id_clock_forcing)
end subroutine surface_forcing_init
+!> Clean up and deallocate any memory associated with this module and its children.
subroutine surface_forcing_end(CS, fluxes)
- type(surface_forcing_CS), pointer :: CS
- type(forcing), optional, intent(inout) :: fluxes
-! Arguments: CS - A pointer to the control structure returned by a previous
-! call to surface_forcing_init, it will be deallocated here.
-! (inout) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
+ type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by
+ !! a previous call to surface_forcing_init, it will
+ !! be deallocated here.
+ type(forcing), optional, intent(inout) :: fluxes !< A structure containing pointers to all
+ !! possible mass, heat or salt flux forcing fields.
+ !! If present, it will be deallocated here.
if (present(fluxes)) call deallocate_forcing_type(fluxes)
@@ -1329,40 +1479,43 @@ subroutine surface_forcing_end(CS, fluxes)
end subroutine surface_forcing_end
+!> Write out a set of messages with checksums of the fields in an ice_ocen_boundary type
subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt)
- character(len=*), intent(in) :: id
- integer , intent(in) :: timestep
- type(ice_ocean_boundary_type), intent(in) :: iobt
- integer :: n,m, outunit
-
- outunit = stdout()
-
- write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep
- write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux )
- write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux )
- write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux )
- write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux )
- write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux )
- write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux )
- write(outunit,100) 'iobt%sw_flux_vis_dir', mpp_chksum( iobt%sw_flux_vis_dir)
- write(outunit,100) 'iobt%sw_flux_vis_dif', mpp_chksum( iobt%sw_flux_vis_dif)
- write(outunit,100) 'iobt%sw_flux_nir_dir', mpp_chksum( iobt%sw_flux_nir_dir)
- write(outunit,100) 'iobt%sw_flux_nir_dif', mpp_chksum( iobt%sw_flux_nir_dif)
- write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec )
- write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec )
- write(outunit,100) 'iobt%runoff ', mpp_chksum( iobt%runoff )
- write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving )
- write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p )
- if (associated(iobt%ustar_berg)) &
- write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg )
- if (associated(iobt%area_berg)) &
- write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg )
- if (associated(iobt%mass_berg)) &
- write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg )
+ character(len=*), intent(in) :: id !< An identifying string for this call
+ integer, intent(in) :: timestep !< The number of elapsed timesteps
+ type(ice_ocean_boundary_type), &
+ intent(in) :: iobt !< An ice-ocean boundary type with fluxes to drive the
+ !! ocean in a coupled model whose checksums are reported
+ integer :: n,m, outunit
+
+ outunit = stdout()
+
+ write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep
+ write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux )
+ write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux )
+ write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux )
+ write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux )
+ write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux )
+ write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux )
+ write(outunit,100) 'iobt%sw_flux_vis_dir', mpp_chksum( iobt%sw_flux_vis_dir)
+ write(outunit,100) 'iobt%sw_flux_vis_dif', mpp_chksum( iobt%sw_flux_vis_dif)
+ write(outunit,100) 'iobt%sw_flux_nir_dir', mpp_chksum( iobt%sw_flux_nir_dir)
+ write(outunit,100) 'iobt%sw_flux_nir_dif', mpp_chksum( iobt%sw_flux_nir_dif)
+ write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec )
+ write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec )
+ write(outunit,100) 'iobt%runoff ', mpp_chksum( iobt%runoff )
+ write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving )
+ write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p )
+ if (associated(iobt%ustar_berg)) &
+ write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg )
+ if (associated(iobt%area_berg)) &
+ write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg )
+ if (associated(iobt%mass_berg)) &
+ write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg )
100 FORMAT(" CHECKSUM::",A20," = ",Z20)
- call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%')
+ call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%')
end subroutine ice_ocn_bnd_type_chksum
diff --git a/config_src/coupled_driver/coupler_util.F90 b/config_src/coupled_driver/coupler_util.F90
index dde67c2976..2c72c56cce 100644
--- a/config_src/coupled_driver/coupler_util.F90
+++ b/config_src/coupled_driver/coupler_util.F90
@@ -1,9 +1,9 @@
+!> Provides a couple of interfaces to allow more transparent and
+!! robust extraction of the various fields in the coupler types.
module coupler_util
! This file is part of MOM6. See LICENSE.md for the license.
-! This code provides a couple of interfaces to allow more transparent and
-! robust extraction of the various fields in the coupler types.
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha
use coupler_types_mod, only : ind_csurf
@@ -15,24 +15,20 @@ module coupler_util
contains
+!> Extract an array of values in a coupler bc type
subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, &
is, ie, js, je, conversion)
- type(coupler_2d_bc_type), intent(in) :: BC_struc
- integer, intent(in) :: BC_index, BC_element
- real, dimension(:,:), intent(out) :: array_out
- integer, optional, intent(in) :: is, ie, js, je
- real, optional, intent(in) :: conversion
-! Arguments: BC_struc - The type from which the data is being extracted.
-! (in) BC_index - The boundary condition number being extracted.
-! (in) BC_element - The element of the boundary condition being extracted.
-! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition.
-! (out) array_out - The array being filled with the input values.
-! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled.
-! These must match the size of the corresponding value array or an
-! error message is issued.
-! (in, opt) conversion - A number that every element is multiplied by, to
-! permit sign convention or unit conversion.
-
+ type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted.
+ integer, intent(in) :: BC_index !< The boundary condition number being extracted.
+ integer, intent(in) :: BC_element !< The element of the boundary condition being extracted.
+ real, dimension(:,:), intent(out) :: array_out !< The array being filled with the input values.
+ integer, optional, intent(in) :: is !< Start i-index
+ integer, optional, intent(in) :: ie !< End i-index
+ integer, optional, intent(in) :: js !< Start j-index
+ integer, optional, intent(in) :: je !< End j-index
+ real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to
+ !! permit sign convention or unit conversion.
+ ! Local variables
real, pointer, dimension(:,:) :: Array_in
real :: conv
integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset
@@ -78,24 +74,21 @@ subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, &
end subroutine extract_coupler_values
+!> Set an array of values in a coupler bc type
subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, &
is, ie, js, je, conversion)
- real, dimension(:,:), intent(in) :: array_in
- type(coupler_2d_bc_type), intent(inout) :: BC_struc
- integer, intent(in) :: BC_index, BC_element
- integer, optional, intent(in) :: is, ie, js, je
- real, optional, intent(in) :: conversion
-! Arguments: array_in - The array containing the values to load into the BC.
-! (out) BC_struc - The type into which the data is being loaded.
-! (in) BC_index - The boundary condition number being extracted.
-! (in) BC_element - The element of the boundary condition being extracted.
-! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition.
-! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled.
-! These must match the size of the corresponding value array or an
-! error message is issued.
-! (in, opt) conversion - A number that every element is multiplied by, to
-! permit sign convention or unit conversion.
-
+ real, dimension(:,:), intent(in) :: array_in !< The array containing the values to load into the BC.
+ type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type from which the data is being extracted.
+ integer, intent(in) :: BC_index !< The boundary condition number being extracted.
+ integer, intent(in) :: BC_element !< The element of the boundary condition being extracted.
+ !! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition.
+ integer, optional, intent(in) :: is !< Start i-index
+ integer, optional, intent(in) :: ie !< End i-index
+ integer, optional, intent(in) :: js !< Start j-index
+ integer, optional, intent(in) :: je !< End j-index
+ real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to
+ !! permit sign convention or unit conversion.
+ ! Local variables
real, pointer, dimension(:,:) :: Array_out
real :: conv
integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset
diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90
index cd72884392..4e89945678 100644
--- a/config_src/coupled_driver/ocean_model_MOM.F90
+++ b/config_src/coupled_driver/ocean_model_MOM.F90
@@ -1,21 +1,15 @@
+!> Top-level module for the MOM6 ocean model in coupled mode.
module ocean_model_mod
! This file is part of MOM6. See LICENSE.md for the license.
-!-----------------------------------------------------------------------
-!
! This is the top level module for the MOM6 ocean model. It contains routines
! for initialization, termination and update of ocean model state. This
! particular version wraps all of the calls for MOM6 in the calls that had
! been used for MOM4.
!
-! Robert Hallberg
-!
-!
-!
! This code is a stop-gap wrapper of the MOM6 code to enable it to be called
! in the same way as MOM4.
-!
use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end
use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization
@@ -26,14 +20,12 @@ module ocean_model_mod
use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end
use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE
use MOM_domains, only : TO_ALL, Omit_Corners
-use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe
+use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
use MOM_error_handler, only : callTree_enter, callTree_leave
use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type
-use MOM_forcing_type, only : allocate_forcing_type
-use MOM_forcing_type, only : forcing, mech_forcing
-use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields
-use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing
-use MOM_forcing_type, only : set_derived_forcing_fields
+use MOM_forcing_type, only : forcing, mech_forcing, allocate_forcing_type
+use MOM_forcing_type, only : fluxes_accumulate, get_net_mass_forcing
+use MOM_forcing_type, only : copy_back_forcing_fields
use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags
use MOM_get_input, only : Get_MOM_Input, directories
use MOM_grid, only : ocean_grid_type
@@ -45,10 +37,10 @@ module ocean_model_mod
use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum
use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS
use MOM_surface_forcing, only : forcing_save_restart
-use MOM_time_manager, only : time_type, get_time, set_time, operator(>)
-use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/)
-use MOM_time_manager, only : operator(/=), operator(<=), operator(>=)
-use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real
+use MOM_time_manager, only : time_type, operator(>), operator(+), operator(-)
+use MOM_time_manager, only : operator(*), operator(/), operator(/=)
+use MOM_time_manager, only : operator(<=), operator(>=), operator(<)
+use MOM_time_manager, only : real_to_time, time_type_to_real
use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init
use MOM_tracer_flow_control, only : call_tracer_flux_init
use MOM_variables, only : surface
@@ -85,6 +77,7 @@ module ocean_model_mod
public ocean_public_type_chksum
public ocean_model_data_get
+!> This interface extracts a named scalar field or array from the ocean surface or public type
interface ocean_model_data_get
module procedure ocean_model_data1D_get
module procedure ocean_model_data2D_get
@@ -143,6 +136,8 @@ module ocean_model_mod
! This type is private, and can therefore vary between different ocean models.
logical :: is_ocean_PE = .false. !< True if this is an ocean PE.
type(time_type) :: Time !< The ocean model's time and master clock.
+ type(time_type) :: Time_dyn !< The ocean model's time for the dynamics. Time and Time_dyn
+ !! should be the same after a full time step.
integer :: Restart_control !< An integer that is bit-tested to determine whether
!! incremental restart files are saved and whether they
!! have a time stamped name. +1 (bit 0) for generic
@@ -150,16 +145,13 @@ module ocean_model_mod
!! restart file is saved at the end of a run segment
!! unless Restart_control is negative.
- integer :: nstep = 0 !< The number of calls to update_ocean.
+ integer :: nstep = 0 !< The number of calls to update_ocean that update the dynamics.
+ integer :: nstep_thermo = 0 !< The number of calls to update_ocean that update the thermodynamics.
logical :: use_ice_shelf !< If true, the ice shelf model is enabled.
logical :: use_waves !< If true use wave coupling.
logical :: icebergs_alter_ocean !< If true, the icebergs can change ocean the
!! ocean dynamics and forcing fluxes.
- logical :: restore_salinity !< If true, the coupled MOM driver adds a term to
- !! restore salinity to a specified value.
- logical :: restore_temp !< If true, the coupled MOM driver adds a term to
- !! restore sst to a specified value.
real :: press_to_z !< A conversion factor between pressure and ocean
!! depth in m, usually 1/(rho_0*g), in m Pa-1.
real :: C_p !< The heat capacity of seawater, in J K-1 kg-1.
@@ -220,20 +212,17 @@ module ocean_model_mod
contains
-!=======================================================================
-!
-!
-!
-! Initialize the ocean model.
-!
-
!> ocean_model_init initializes the ocean model, including registering fields
!! for restarts and reading restart files if appropriate.
+!!
+!! This subroutine initializes both the ocean state and the ocean surface type.
+!! Because of the way that indicies and domains are handled, Ocean_sfc must have
+!! been used in a previous call to initialize_ocean_type.
subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn)
type(ocean_public_type), target, &
- intent(inout) :: Ocean_sfc !< A structure containing various
- !! publicly visible ocean surface properties after initialization,
- !! the data in this type is intent(out).
+ intent(inout) :: Ocean_sfc !< A structure containing various publicly
+ !! visible ocean surface properties after initialization,
+ !! the data in this type is intent out.
type(ocean_state_type), pointer :: OS !< A structure whose internal
!! contents are private to ocean_model_mod that may be used to
!! contain all information about the ocean's interior state.
@@ -245,28 +234,22 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn)
!! in the calculation of additional gas or other
!! tracer fluxes, and can be used to spawn related
!! internal variables in the ice model.
-
-! This subroutine initializes both the ocean state and the ocean surface type.
-! Because of the way that indicies and domains are handled, Ocean_sfc must have
-! been used in a previous call to initialize_ocean_type.
-
-! Arguments: Ocean_sfc - A structure containing various publicly visible ocean
-! surface properties after initialization, this is intent(out).
-! (out,private) OS - A structure whose internal contents are private
-! to ocean_model_mod that may be used to contain all
-! information about the ocean's interior state.
-! (in) Time_init - The start time for the coupled model's calendar.
-! (in) Time_in - The time at which to initialize the ocean model.
+ ! Local variables
real :: Rho0 ! The Boussinesq ocean density, in kg m-3.
real :: G_Earth ! The gravitational acceleration in m s-2.
+ real :: HFrz !< If HFrz > 0 (m), melt potential will be computed.
+ !! The actual depth over which melt potential is computed will
+ !! min(HFrz, OBLD), where OBLD is the boundary layer depth.
+ !! If HFrz <= 0 (default), melt potential will not be computed.
+ logical :: use_melt_pot!< If true, allocate melt_potential array
+
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "ocean_model_init" ! This module's name.
- character(len=48) :: stagger
- integer :: secs, days
+ character(len=48) :: stagger ! A string indicating the staggering locations for the
+ ! surface velocities returned to the coupler.
type(param_file_type) :: param_file !< A structure to parse for run-time parameters
- logical :: use_temperature
- type(time_type) :: dt_geometric, dt_savedays, dt_from_base
+ logical :: use_temperature ! If true, temperature and salinity are state variables.
call callTree_enter("ocean_model_init(), ocean_model_MOM.F90")
if (associated(OS)) then
@@ -279,7 +262,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn)
OS%is_ocean_pe = Ocean_sfc%is_ocean_pe
if (.not.OS%is_ocean_pe) return
- OS%Time = Time_in
+ OS%Time = Time_in ; OS%Time_dyn = Time_in
call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, &
OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
diag_ptr=OS%diag, count_calls=.true.)
@@ -333,14 +316,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn)
else ; call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// &
trim(stagger)//" is invalid.") ; endif
- call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, &
- "If true, the coupled driver will add a globally-balanced \n"//&
- "fresh-water flux that drives sea-surface salinity \n"//&
- "toward specified values.", default=.false.)
- call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, &
- "If true, the coupled driver will add a \n"//&
- "heat flux that drives sea-surface temperauture \n"//&
- "toward specified values.", default=.false.)
call get_param(param_file, mdl, "RHO_0", Rho0, &
"The mean ocean density used with BOUSSINESQ true to \n"//&
"calculate accelerations and the mass for conservation \n"//&
@@ -361,11 +336,23 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn)
! Consider using a run-time flag to determine whether to do the diagnostic
! vertical integrals, since the related 3-d sums are not negligible in cost.
- call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, &
- do_integrals=.true., gas_fields_ocn=gas_fields_ocn)
+ call get_param(param_file, mdl, "HFREEZE", HFrz, &
+ "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//&
+ "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//&
+ "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//&
+ "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.)
+
+ if (HFrz .gt. 0.0) then
+ use_melt_pot=.true.
+ else
+ use_melt_pot=.false.
+ endif
+
+ call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, do_integrals=.true., &
+ gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot)
call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, &
- OS%forcing_CSp, OS%restore_salinity, OS%restore_temp)
+ OS%forcing_CSp)
if (OS%use_ice_shelf) then
call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, &
@@ -409,45 +396,32 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn)
call close_param_file(param_file)
call diag_mediator_close_registration(OS%diag)
- if (is_root_pe()) &
- write(*,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========'
+ call MOM_mesg('==== Completed MOM6 Coupled Initialization ====', 2)
call callTree_leave("ocean_model_init(")
end subroutine ocean_model_init
-! NAME="ocean_model_init"
-
-
-!=======================================================================
-!
-!
-!
-! Update in time the ocean model fields. This code wraps the call to step_MOM
-! with MOM4's call.
-!
-!
!> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the
!! ocean model's state from the input value of Ocean_state (which must be for
!! time time_start_update) for a time interval of Ocean_coupling_time_step,
!! returning the publicly visible ocean surface properties in Ocean_sfc and
!! storing the new ocean properties in Ocean_state.
-subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
- time_start_update, Ocean_coupling_time_step, &
- update_dyn, update_thermo, Ocn_fluxes_used)
+subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_update, &
+ Ocean_coupling_time_step, update_dyn, update_thermo, &
+ Ocn_fluxes_used, start_cycle, end_cycle, cycle_length)
type(ice_ocean_boundary_type), &
- intent(in) :: Ice_ocean_boundary !< A structure containing the
- !! various forcing fields coming from the ice.
+ intent(in) :: Ice_ocean_boundary !< A structure containing the various
+ !! forcing fields coming from the ice and atmosphere.
type(ocean_state_type), &
- pointer :: OS !< A pointer to a private structure containing
- !! the internal ocean state.
+ pointer :: OS !< A pointer to a private structure containing the
+ !! internal ocean state.
type(ocean_public_type), &
- intent(inout) :: Ocean_sfc !< A structure containing all the
- !! publicly visible ocean surface fields after
- !! a coupling time step. The data in this type is
- !! intent out.
+ intent(inout) :: Ocean_sfc !< A structure containing all the publicly visible
+ !! ocean surface fields after a coupling time step.
+ !! The data in this type is intent out.
type(time_type), intent(in) :: time_start_update !< The time at the beginning of the update step.
- type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over
- !! which to advance the ocean.
+ type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over which to
+ !! advance the ocean.
logical, optional, intent(in) :: update_dyn !< If present and false, do not do updates
!! due to the ocean dynamics.
logical, optional, intent(in) :: update_thermo !< If present and false, do not do updates
@@ -455,39 +429,38 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
logical, optional, intent(in) :: Ocn_fluxes_used !< If present, this indicates whether the
!! cumulative thermodynamic fluxes from the ocean,
!! like frazil, have been used and should be reset.
-
- type(time_type) :: Master_time ! This allows step_MOM to temporarily change
- ! the time that is seen by internal modules.
- type(time_type) :: Time1 ! The value of the ocean model's time at the
- ! start of a call to step_MOM.
- integer :: index_bnds(4) ! The computational domain index bounds in the
- ! ice-ocean boundary type.
- real :: weight ! Flux accumulation weight
- real :: dt_coupling ! The coupling time step in seconds.
- integer :: nts ! The number of baroclinic dynamics time steps
- ! within dt_coupling.
- real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec)
- real :: dt_dyn ! The dynamics time step in sec.
- real :: dtdia ! The diabatic time step in sec.
- real :: t_elapsed_seg ! The elapsed time in this update segment, in s.
- integer :: n, n_max, n_last_thermo
- type(time_type) :: Time2 ! A temporary time.
- logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans
- ! multiple dynamic timesteps.
- logical :: do_dyn ! If true, step the ocean dynamics and transport.
- logical :: do_thermo ! If true, step the ocean thermodynamics.
- logical :: step_thermo ! If true, take a thermodynamic step.
- integer :: secs, days
+ logical, optional, intent(in) :: start_cycle !< This indicates whether this call is to be
+ !! treated as the first call to step_MOM in a
+ !! time-stepping cycle; missing is like true.
+ logical, optional, intent(in) :: end_cycle !< This indicates whether this call is to be
+ !! treated as the last call to step_MOM in a
+ !! time-stepping cycle; missing is like true.
+ real, optional, intent(in) :: cycle_length !< The duration of a coupled time stepping cycle, in s.
+
+ ! Local variables
+ type(time_type) :: Time_seg_start ! Stores the ocean model time at the start of this call to allow
+ ! step_MOM to temporarily change the time as seen by internal modules.
+ type(time_type) :: Time1 ! The value of the ocean model's time at the start of a call to step_MOM.
+ integer :: index_bnds(4) ! The computational domain index bounds in the ice-ocean boundary type.
+ real :: weight ! Flux accumulation weight of the current fluxes.
+ real :: dt_coupling ! The coupling time step in seconds.
+ real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec)
+ real :: dt_dyn ! The dynamics time step in sec.
+ real :: dtdia ! The diabatic time step in sec.
+ real :: t_elapsed_seg ! The elapsed time in this update segment, in s.
+ integer :: n ! The internal iteration counter.
+ integer :: nts ! The number of baroclinic dynamics time steps in a thermodynamic step.
+ integer :: n_max ! The number of calls to step_MOM dynamics in this call to update_ocean_model.
+ integer :: n_last_thermo ! The iteration number the last time thermodynamics were updated.
+ logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans multiple dynamic timesteps.
+ logical :: do_dyn ! If true, step the ocean dynamics and transport.
+ logical :: do_thermo ! If true, step the ocean thermodynamics.
+ logical :: step_thermo ! If true, take a thermodynamic step.
integer :: is, ie, js, je
call callTree_enter("update_ocean_model(), ocean_model_MOM.F90")
- call get_time(Ocean_coupling_time_step, secs, days)
- dt_coupling = 86400.0*real(days) + real(secs)
+ dt_coupling = time_type_to_real(Ocean_coupling_time_step)
- if (time_start_update /= OS%Time) then
- call MOM_error(WARNING, "update_ocean_model: internal clock does not "//&
- "agree with time_start_update argument.")
- endif
if (.not.associated(OS)) then
call MOM_error(FATAL, "update_ocean_model called with an unassociated "// &
"ocean_state_type structure. ocean_model_init must be "// &
@@ -498,113 +471,111 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
do_dyn = .true. ; if (present(update_dyn)) do_dyn = update_dyn
do_thermo = .true. ; if (present(update_thermo)) do_thermo = update_thermo
+ if (do_thermo .and. (time_start_update /= OS%Time)) &
+ call MOM_error(WARNING, "update_ocean_model: internal clock does not "//&
+ "agree with time_start_update argument.")
+ if (do_dyn .and. (time_start_update /= OS%Time_dyn)) &
+ call MOM_error(WARNING, "update_ocean_model: internal dynamics clock does not "//&
+ "agree with time_start_update argument.")
+
+ if (.not.(do_dyn .or. do_thermo)) call MOM_error(FATAL, &
+ "update_ocean_model called without updating either dynamics or thermodynamics.")
+ if (do_dyn .and. do_thermo .and. (OS%Time /= OS%Time_dyn)) call MOM_error(FATAL, &
+ "update_ocean_model called to update both dynamics and thermodynamics with inconsistent clocks.")
+
! This is benign but not necessary if ocean_model_init_sfc was called or if
! OS%sfc_state%tr_fields was spawned in ocean_model_init. Consider removing it.
is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec
call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, &
(/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.)
- ! Translate Ice_ocean_boundary into fluxes.
+ ! Translate Ice_ocean_boundary into fluxes and forces.
call mpp_get_compute_domain(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), &
index_bnds(3), index_bnds(4))
- weight = 1.0
-
- call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, &
- OS%grid, OS%forcing_CSp)
+ if (do_dyn) then
+ call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, &
+ OS%forcing_CSp, dt_forcing=dt_coupling, reset_avg=OS%fluxes%fluxes_used)
+ if (OS%use_ice_shelf) &
+ call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces)
+ if (OS%icebergs_alter_ocean) &
+ call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, &
+ OS%sfc_state, dt_coupling, OS%marine_ice_CSp)
+ endif
- if (OS%fluxes%fluxes_used) then
- if (do_thermo) &
+ if (do_thermo) then
+ if (OS%fluxes%fluxes_used) then
call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, &
- OS%grid, OS%forcing_CSp, OS%sfc_state, &
- OS%restore_salinity, OS%restore_temp)
+ OS%grid, OS%forcing_CSp, OS%sfc_state)
- ! Add ice shelf fluxes
- if (OS%use_ice_shelf) then
- if (do_thermo) &
+ ! Add ice shelf fluxes
+ if (OS%use_ice_shelf) &
call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp)
- if (do_dyn) &
- call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces)
- endif
- if (OS%icebergs_alter_ocean) then
- if (do_dyn) &
- call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, &
- OS%sfc_state, dt_coupling, OS%marine_ice_CSp)
- if (do_thermo) &
+ if (OS%icebergs_alter_ocean) &
call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, &
- OS%sfc_state, dt_coupling, OS%marine_ice_CSp)
- endif
-
- ! Fields that exist in both the forcing and mech_forcing types must be copied.
- call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid, skip_pres=.true.)
+ OS%sfc_state, dt_coupling, OS%marine_ice_CSp)
#ifdef _USE_GENERIC_TRACER
- call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed?
- call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes
+ call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed?
+ call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, 1.0) ! Here weight=1, so just store the current fluxes
+ call disable_averaging(OS%diag)
#endif
- ! Indicate that there are new unused fluxes.
- OS%fluxes%fluxes_used = .false.
- OS%fluxes%dt_buoy_accum = dt_coupling
- else
- OS%flux_tmp%C_p = OS%fluxes%C_p
- if (do_thermo) &
+ ! Indicate that there are new unused fluxes.
+ OS%fluxes%fluxes_used = .false.
+ OS%fluxes%dt_buoy_accum = dt_coupling
+ else
+ ! The previous fluxes have not been used yet, so translate the input fluxes
+ ! into a temporary type and then accumulate them in about 20 lines.
+ OS%flux_tmp%C_p = OS%fluxes%C_p
call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, &
- OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp)
+ OS%grid, OS%forcing_CSp, OS%sfc_state)
- if (OS%use_ice_shelf) then
- if (do_thermo) &
+ if (OS%use_ice_shelf) &
call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp)
- if (do_dyn) &
- call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces)
- endif
- if (OS%icebergs_alter_ocean) then
- if (do_dyn) &
- call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, &
- OS%sfc_state, dt_coupling, OS%marine_ice_CSp)
- if (do_thermo) &
+ if (OS%icebergs_alter_ocean) &
call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, &
- OS%sfc_state, dt_coupling, OS%marine_ice_CSp)
- endif
-
- call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight)
- ! Some of the fields that exist in both the forcing and mech_forcing types
- ! (e.g., ustar) are time-averages must be copied back to the forces type.
- call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid)
+ OS%sfc_state, dt_coupling, OS%marine_ice_CSp)
+ call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight)
#ifdef _USE_GENERIC_TRACER
- call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average
+ ! Incorporate the current tracer fluxes into the running averages
+ call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight)
#endif
+ endif
endif
- call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0)
- call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid)
- if (OS%use_waves) then
+ ! The net mass forcing is not currently used in the MOM6 dynamics solvers, so this is may be unnecessary.
+ if (do_dyn .and. associated(OS%forces%net_mass_src) .and. .not.OS%forces%net_mass_src_set) &
+ call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src)
+
+ if (OS%use_waves .and. do_thermo) then
+ ! For now, the waves are only updated on the thermodynamics steps, because that is where
+ ! the wave intensities are actually used to drive mixing. At some point, the wave updates
+ ! might also need to become a part of the ocean dynamics, according to B. Reichl.
call Update_Surface_Waves(OS%grid, OS%GV, OS%time, ocean_coupling_time_step, OS%waves)
endif
- if (OS%nstep==0) then
+ if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model.
call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp)
endif
- call disable_averaging(OS%diag)
- Master_time = OS%Time ; Time1 = OS%Time
+ Time_seg_start = OS%Time ; if (do_dyn) Time_seg_start = OS%Time_dyn
+ Time1 = Time_seg_start
- if (OS%offline_tracer_mode) then
+ if (OS%offline_tracer_mode .and. do_thermo) then
call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp)
elseif ((.not.do_thermo) .or. (.not.do_dyn)) then
! The call sequence is being orchestrated from outside of update_ocean_model.
call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, &
- Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, &
+ Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, &
+ start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, &
reset_therm=Ocn_fluxes_used)
- !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling)
-
elseif (OS%single_step_call) then
call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves)
else
n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001)
dt_dyn = dt_coupling / real(n_max)
- thermo_does_span_coupling = (OS%thermo_spans_coupling .and. &
- (OS%dt_therm > 1.5*dt_coupling))
+ thermo_does_span_coupling = (OS%thermo_spans_coupling .and. (OS%dt_therm > 1.5*dt_coupling))
if (thermo_does_span_coupling) then
dt_therm = dt_coupling * floor(OS%dt_therm / dt_coupling + 0.001)
@@ -614,7 +585,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
n_last_thermo = 0
endif
- Time2 = Time1 ; t_elapsed_seg = 0.0
+ Time1 = Time_seg_start ; t_elapsed_seg = 0.0
do n=1,n_max
if (OS%diabatic_first) then
if (thermo_does_span_coupling) call MOM_error(FATAL, &
@@ -622,16 +593,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
"THERMO_SPANS_COUPLING and DIABATIC_FIRST.")
if (modulo(n-1,nts)==0) then
dtdia = dt_dyn*min(nts,n_max-(n-1))
- call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, &
+ call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, &
Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., &
start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling)
endif
- call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, &
+ call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, &
Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., &
start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling)
else
- call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, &
+ call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, &
Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., &
start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling)
@@ -646,28 +617,32 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
endif
if (step_thermo) then
- ! Back up Time2 to the start of the thermodynamic segment.
- Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5)))
- call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, &
+ ! Back up Time1 to the start of the thermodynamic segment.
+ Time1 = Time1 - real_to_time(dtdia - dt_dyn)
+ call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, &
Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., &
start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling)
endif
endif
t_elapsed_seg = t_elapsed_seg + dt_dyn
- Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5)))
+ Time1 = Time_seg_start + real_to_time(t_elapsed_seg)
enddo
endif
- OS%Time = Master_time + Ocean_coupling_time_step
- OS%nstep = OS%nstep + 1
+ if (do_dyn) OS%Time_dyn = Time_seg_start + Ocean_coupling_time_step
+ if (do_dyn) OS%nstep = OS%nstep + 1
+ OS%Time = Time_seg_start ! Reset the clock to compensate for shared pointers.
+ if (do_thermo) OS%Time = OS%Time + Ocean_coupling_time_step
+ if (do_thermo) OS%nstep_thermo = OS%nstep_thermo + 1
- call enable_averaging(dt_coupling, OS%Time, OS%diag)
- call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, &
- OS%diag, OS%forcing_CSp%handles)
- call disable_averaging(OS%diag)
+ if (do_dyn) then
+ call enable_averaging(dt_coupling, OS%Time_dyn, OS%diag)
+ call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles)
+ call disable_averaging(OS%diag)
+ endif
- if (OS%fluxes%fluxes_used) then
+ if (OS%fluxes%fluxes_used .and. do_thermo) then
call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag)
call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, &
OS%grid, OS%diag, OS%forcing_CSp%handles)
@@ -678,24 +653,13 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, &
! Ice_ocean_boundary%p, OS%press_to_z)
call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid)
- call coupler_type_send_data(Ocean_sfc%fields, OS%Time)
+ Time1 = OS%Time ; if (do_dyn) Time1 = OS%Time_dyn
+ call coupler_type_send_data(Ocean_sfc%fields, Time1)
call callTree_leave("update_ocean_model()")
end subroutine update_ocean_model
-! NAME="update_ocean_model"
-
-!=======================================================================
-!
-!
-!
-! write out restart file.
-! Arguments:
-! timestamp (optional, intent(in)) : A character string that represents the model time,
-! used for writing restart. timestamp will prepend to
-! the any restart file name as a prefix.
-!
-!
+!> This subroutine writes out the ocean model restart file.
subroutine ocean_model_restart(OS, timestamp)
type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the
!! internal ocean state being saved to a restart file
@@ -732,13 +696,6 @@ subroutine ocean_model_restart(OS, timestamp)
end subroutine ocean_model_restart
! NAME="ocean_model_restart"
-!=======================================================================
-!
-!
-!
-! Close down the ocean model
-!
-
!> ocean_model_end terminates the model run, saving the ocean state in a restart
!! and deallocating any data associated with the ocean.
subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time)
@@ -749,22 +706,11 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time)
!! upon termination.
type(time_type), intent(in) :: Time !< The model time, used for writing restarts.
-! This subroutine terminates the model run, saving the ocean state in a
-! restart file and deallocating any data associated with the ocean.
-
-! Arguments: Ocean_sfc - An ocean_public_type structure that is to be
-! deallocated upon termination.
-! (inout) Ocean_state - A pointer to the structure containing the internal
-! ocean state to be deallocated upon termination.
-! (in) Time - The model time, used for writing restarts.
-
call ocean_model_save_restart(Ocean_state, Time)
call diag_mediator_end(Time, Ocean_state%diag)
call MOM_end(Ocean_state%MOM_CSp)
if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp)
end subroutine ocean_model_end
-! NAME="ocean_model_end"
-
!> ocean_model_save_restart causes restart files associated with the ocean to be
!! written out.
@@ -776,12 +722,6 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix)
!! write these restart files.
character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time-stamp)
!! to append to the restart file names.
-! Arguments: Ocean_state - A structure containing the internal ocean state (in).
-! (in) Time - The model time at this call. This is needed for mpp_write calls.
-! (in, opt) directory - An optional directory into which to write these restart files.
-! (in, opt) filename_suffix - An optional suffix (e.g., a time-stamp) to append
-! to the restart file names.
-
! Note: This is a new routine - it will need to exist for the new incremental
! checkpointing. It will also be called by ocean_model_end, giving the same
! restart behavior as now in FMS.
@@ -808,15 +748,17 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix)
end subroutine ocean_model_save_restart
-!=======================================================================
-
+!> Initialize the public ocean type
subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, &
gas_fields_ocn)
- type(domain2D), intent(in) :: input_domain
- type(ocean_public_type), intent(inout) :: Ocean_sfc
- type(diag_ctrl), intent(in) :: diag
+ type(domain2D), intent(in) :: input_domain !< The ocean model domain description
+ type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly
+ !! visible ocean surface properties after initialization, whose
+ !! elements are allocated here.
+ type(diag_ctrl), intent(in) :: diag !< A structure that regulates diagnsotic output
logical, dimension(:,:), &
- optional, intent(in) :: maskmap
+ optional, intent(in) :: maskmap !< A mask indicating which virtual processors
+ !! are actually in use. If missing, all are used.
type(coupler_1d_bc_type), &
optional, intent(in) :: gas_fields_ocn !< If present, this type describes the
!! ocean and surface-ice fields that will participate
@@ -861,20 +803,23 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap,
end subroutine initialize_ocean_public_type
-subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, &
- patm, press_to_z)
- type(surface), intent(inout) :: sfc_state !< A structure containing fields that
- !! describe the surface state of the ocean.
+!> This subroutine translates the coupler's ocean_data_type into MOM's
+!! surface state variable. This may eventually be folded into the MOM
+!! code that calculates the surface state in the first place.
+!! Note the offset in the arrays because the ocean_data_type has no
+!! halo points in its arrays and always uses absolute indicies.
+subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z)
+ type(surface), intent(inout) :: sfc_state !< A structure containing fields that
+ !! describe the surface state of the ocean.
type(ocean_public_type), &
- target, intent(inout) :: Ocean_sfc
- type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
- real, optional, intent(in) :: patm(:,:)
- real, optional, intent(in) :: press_to_z
-! This subroutine translates the coupler's ocean_data_type into MOM's
-! surface state variable. This may eventually be folded into the MOM
-! code that calculates the surface state in the first place.
-! Note the offset in the arrays because the ocean_data_type has no
-! halo points in its arrays and always uses absolute indicies.
+ target, intent(inout) :: Ocean_sfc !< A structure containing various publicly
+ !! visible ocean surface fields, whose elements
+ !! have their data set here.
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
+ real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface, in Pa.
+ real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and
+ !! ocean depth in m, usually 1/(rho_0*g), in m Pa-1.
+ ! Local variables
real :: IgR0
character(len=48) :: val_str
integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd
@@ -967,21 +912,15 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, &
end subroutine convert_state_to_ocean_type
-
-!=======================================================================
-!
-!
-!
-! This subroutine extracts the surface properties from the ocean's internal
-! state and stores them in the ocean type returned to the calling ice model.
-! It has to be separate from the ocean_initialization call because the coupler
-! module allocates the space for some of these variables.
-!
-
+!> This subroutine extracts the surface properties from the ocean's internal
+!! state and stores them in the ocean type returned to the calling ice model.
+!! It has to be separate from the ocean_initialization call because the coupler
+!! module allocates the space for some of these variables.
subroutine ocean_model_init_sfc(OS, Ocean_sfc)
- type(ocean_state_type), pointer :: OS
- type(ocean_public_type), intent(inout) :: Ocean_sfc
-
+ type(ocean_state_type), pointer :: OS !< The structure with the complete ocean state
+ type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly
+ !! visible ocean surface properties after initialization, whose
+ !! elements have their data set here.
integer :: is, ie, js, je
is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec
@@ -993,7 +932,6 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc)
call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid)
end subroutine ocean_model_init_sfc
-!
!> ocean_model_flux_init is used to initialize properties of the air-sea fluxes
!! as determined by various run-time parameters. It can be called from
@@ -1018,16 +956,13 @@ subroutine ocean_model_flux_init(OS, verbosity)
end subroutine ocean_model_flux_init
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
-! Ocean_stock_pe - returns stocks of heat, water, etc. for conservation checks.!
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!> Ocean_stock_pe - returns the integrated stocks of heat, water, etc. for conservation checks.
!! Because of the way FMS is coded, only the root PE has the integrated amount,
!! while all other PEs get 0.
subroutine Ocean_stock_pe(OS, index, value, time_index)
use stock_constants_mod, only : ISTOCK_WATER, ISTOCK_HEAT,ISTOCK_SALT
type(ocean_state_type), pointer :: OS !< A structure containing the internal ocean state.
- !! The data in OS is intent(in).
+ !! The data in OS is intent in.
integer, intent(in) :: index !< The stock index for the quantity of interest.
real, intent(out) :: value !< Sum returned for the conservation quantity of interest.
integer, optional, intent(in) :: time_index !< An unused optional argument, present only for
@@ -1063,13 +998,18 @@ subroutine Ocean_stock_pe(OS, index, value, time_index)
end subroutine Ocean_stock_pe
-subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc)
+!> This subroutine extracts a named 2-D field from the ocean surface or public type
+subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc)
use MOM_constants, only : CELSIUS_KELVIN_OFFSET
- type(ocean_state_type), pointer :: OS
- type(ocean_public_type), intent(in) :: Ocean
- character(len=*) , intent(in) :: name
- real, dimension(isc:,jsc:), intent(out):: array2D
- integer , intent(in) :: isc,jsc
+ type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the
+ !! internal ocean state (intent in).
+ type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly
+ !! visible ocean surface fields.
+ character(len=*) , intent(in) :: name !< The name of the field to extract
+ real, dimension(isc:,jsc:), intent(out):: array2D !< The values of the named field, it must
+ !! cover only the computational domain
+ integer , intent(in) :: isc !< The starting i-index of array2D
+ integer , intent(in) :: jsc !< The starting j-index of array2D
integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j
@@ -1108,14 +1048,16 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc)
call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name)
end select
-
end subroutine ocean_model_data2D_get
-subroutine ocean_model_data1D_get(OS,Ocean, name, value)
- type(ocean_state_type), pointer :: OS
- type(ocean_public_type), intent(in) :: Ocean
- character(len=*) , intent(in) :: name
- real , intent(out):: value
+!> This subroutine extracts a named scalar field from the ocean surface or public type
+subroutine ocean_model_data1D_get(OS, Ocean, name, value)
+ type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the
+ !! internal ocean state (intent in).
+ type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly
+ !! visible ocean surface fields.
+ character(len=*) , intent(in) :: name !< The name of the field to extract
+ real , intent(out):: value !< The value of the named field
if (.not.associated(OS)) return
if (.not.OS%is_ocean_pe) return
@@ -1127,27 +1069,28 @@ subroutine ocean_model_data1D_get(OS,Ocean, name, value)
call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name)
end select
-
end subroutine ocean_model_data1D_get
+!> Write out FMS-format checsums on fields from the ocean surface state
subroutine ocean_public_type_chksum(id, timestep, ocn)
- character(len=*), intent(in) :: id
- integer , intent(in) :: timestep
- type(ocean_public_type), intent(in) :: ocn
- integer :: n,m, outunit
+ character(len=*), intent(in) :: id !< An identifying string for this call
+ integer, intent(in) :: timestep !< The number of elapsed timesteps
+ type(ocean_public_type), intent(in) :: ocn !< A structure containing various publicly
+ !! visible ocean surface fields.
+ integer :: n, m, outunit
- outunit = stdout()
+ outunit = stdout()
- write(outunit,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep
- write(outunit,100) 'ocean%t_surf ',mpp_chksum(ocn%t_surf )
- write(outunit,100) 'ocean%s_surf ',mpp_chksum(ocn%s_surf )
- write(outunit,100) 'ocean%u_surf ',mpp_chksum(ocn%u_surf )
- write(outunit,100) 'ocean%v_surf ',mpp_chksum(ocn%v_surf )
- write(outunit,100) 'ocean%sea_lev ',mpp_chksum(ocn%sea_lev)
- write(outunit,100) 'ocean%frazil ',mpp_chksum(ocn%frazil )
+ write(outunit,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep
+ write(outunit,100) 'ocean%t_surf ',mpp_chksum(ocn%t_surf )
+ write(outunit,100) 'ocean%s_surf ',mpp_chksum(ocn%s_surf )
+ write(outunit,100) 'ocean%u_surf ',mpp_chksum(ocn%u_surf )
+ write(outunit,100) 'ocean%v_surf ',mpp_chksum(ocn%v_surf )
+ write(outunit,100) 'ocean%sea_lev ',mpp_chksum(ocn%sea_lev)
+ write(outunit,100) 'ocean%frazil ',mpp_chksum(ocn%frazil )
- call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%')
+ call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%')
100 FORMAT(" CHECKSUM::",A20," = ",Z20)
end subroutine ocean_public_type_chksum
diff --git a/config_src/dynamic/MOM_memory.h b/config_src/dynamic/MOM_memory.h
index b2773188de..c3385b8b9a 100644
--- a/config_src/dynamic/MOM_memory.h
+++ b/config_src/dynamic/MOM_memory.h
@@ -1,50 +1,39 @@
-!********+*********+*********+*********+*********+*********+*********+*
-!* This include file determines the compile-time memory settings *
-!* for the Modular Ocean Model (MOM), versions 6 and later. *
-!********+*********+*********+*********+*********+*********+*********+*
+!/// \brief Compile-time memory settings
+!/// \details This include file determines the compile-time memory settings.
+!/// There are several variants of this file and only one should be in the search path for compilation.
+!/// \file MOM_memory.h
-! Specify the numerical domain.
+!/// The number of thickness grid points in the i-direction of the global domain.
#define NIGLOBAL_ NONSENSE_NIGLOBAL
+!/// The number of thickness grid points in the j-direction of the global domain.
#define NJGLOBAL_ NONSENSE_NJGLOBAL
- ! NIGLOBAL_ and NJGLOBAL_ are the number of thickness
- ! grid points in the zonal and meridional
- ! directions of the physical domain.
+!/// The number of layers in the vertical direction.
#define NK_ NONSENSE_NK
- ! The number of layers.
-
-#undef STATIC_MEMORY_
- ! If STATIC_MEMORY_ is defined, the principle
- ! variables will have sizes that are statically
- ! determined at compile time. Otherwise the
- ! sizes are not determined until run time. The
- ! STATIC option is substantially faster, but
- ! does not allow the PE count to be changed at
- ! run time.
-#undef SYMMETRIC_MEMORY_
- ! If defined, the velocity point data domain
- ! includes every face of the thickness points.
- ! In other words, some arrays are larger than
- ! others, depending on where they are on the
- ! staggered grid.
+!/// The number of processors in the i-direction.
#define NIPROC_ NONSENSE_NIPROC
- ! NIPROC_ is the number of processors in the
- ! x-direction.
+
+!/// The number of processors in the j-direction.
#define NJPROC_ NONSENSE_NJPROC
- ! NJPROC_ is the number of processors in the
- ! y-direction.
+!/// The maximum permitted number (each) of restart variables, time derivatives, etc.
+!/// This is mostly used for the size of pointer arrays, so it should be set generously.
#ifndef MAX_FIELDS_
#define MAX_FIELDS_ 50
#endif
- ! The maximum permitted number (each) of
- ! restart variables, time derivatives, etc.
- ! This is mostly used for the size of pointer
- ! arrays, so it should be set generously.
+!/// The number of memory halo cells on each side of the computational domain in the i-direction.
#define NIHALO_ 2
+
+!/// The number of memory halo cells on each side of the computational domain in the j-direction.
#define NJHALO_ 2
- ! NIHALO_ and NJHALO_ are the sizes of the
- ! memory halos on each side.
+
+!/// If SYMMETRIC_MEMORY_() is defined, the velocity point data domain includes every face of the thickness points.
+!/// In other words, some arrays are larger than others, depending on where they are on the staggered grid.
+#undef SYMMETRIC_MEMORY_
+
+!/// If STATIC_MEMORY_ is defined, the principle variables have sizes that are statically determined at compile time.
+!/// Otherwise the sizes are not determined until run time.
+#undef STATIC_MEMORY_
#include
diff --git a/config_src/dynamic_symmetric/MOM_memory.h b/config_src/dynamic_symmetric/MOM_memory.h
index 125dcf212f..4188663a2c 100644
--- a/config_src/dynamic_symmetric/MOM_memory.h
+++ b/config_src/dynamic_symmetric/MOM_memory.h
@@ -1,33 +1,39 @@
-!/*! \brief Compile-time memory settings */
-!/*! \details This include file determines the compile-time memory settings. There are several variants of this file and only one should be in the search path for compilation. */
-!/*! \file MOM_memory.h */
+!/// \brief Compile-time memory settings
+!/// \details This include file determines the compile-time memory settings.
+!/// There are several variants of this file and only one should be in the search path for compilation.
+!/// \file MOM_memory.h
-!/*! The number of thickness grid points in the i-direction of the global domain. */
+!/// The number of thickness grid points in the i-direction of the global domain.
#define NIGLOBAL_ NONSENSE_NIGLOBAL
-!/*! The number of thickness grid points in the j-direction of the global domain. */
+!/// The number of thickness grid points in the j-direction of the global domain.
#define NJGLOBAL_ NONSENSE_NJGLOBAL
-!/*! The number of layers in the vertical direction. */
+!/// The number of layers in the vertical direction.
#define NK_ NONSENSE_NK
-!/*! \def STATIC_MEMORY_ If STATIC_MEMORY_ is defined, the principle variables will have sizes that are statically determined at compile time. Otherwise the sizes are not determined until run time. */
-#undef STATIC_MEMORY_
-
-!/*! If SYMMETRIC_MEMORY_ is defined, the velocity point data domain includes every face of the thickness points. In other words, some arrays are larger than others, depending on where they are on the staggered grid. */
-#define SYMMETRIC_MEMORY_
-
-!/*! The number of processors in the i-direction. */
+!/// The number of processors in the i-direction.
#define NIPROC_ NONSENSE_NIPROC
-!/*! The number of processors in the j-direction. */
+!/// The number of processors in the j-direction.
#define NJPROC_ NONSENSE_NJPROC
-!/*! The maximum permitted number (each) of restart variables, time derivatives, etc. This is mostly used for the size of pointer arrays, so it should be set generously. */
+!/// The maximum permitted number (each) of restart variables, time derivatives, etc.
+!/// This is mostly used for the size of pointer arrays, so it should be set generously.
+#ifndef MAX_FIELDS_
#define MAX_FIELDS_ 50
+#endif
-!/*! The number of memory halo cells on each side of the computational domain in the i-direction */
+!/// The number of memory halo cells on each side of the computational domain in the i-direction.
#define NIHALO_ 2
-!/*! The number of memory halo cells on each side of the computational domain in the j-direction */
+!/// The number of memory halo cells on each side of the computational domain in the j-direction.
#define NJHALO_ 2
+!/// If SYMMETRIC_MEMORY_() is defined, the velocity point data domain includes every face of the thickness points.
+!/// In other words, some arrays are larger than others, depending on where they are on the staggered grid.
+#define SYMMETRIC_MEMORY_
+
+!/// If STATIC_MEMORY_ is defined, the principle variables have sizes that are statically determined at compile time.
+!/// Otherwise the sizes are not determined until run time.
+#undef STATIC_MEMORY_
+
#include
diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90
index c894f42270..4714194f40 100644
--- a/config_src/mct_driver/MOM_ocean_model.F90
+++ b/config_src/mct_driver/MOM_ocean_model.F90
@@ -139,7 +139,9 @@ module MOM_ocean_model
!! i.e. dzt(1) + eta_t + patm/rho0/grav (m)
frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil
!! formation in the ocean.
- area => NULL() !< cell area of the ocean surface, in m2.
+ melt_potential => NULL(), & !< Accumulated heat used to melt sea ice (in W/m^2)
+ area => NULL(), & !< cell area of the ocean surface, in m2.
+ OBLD => NULL() !< Ocean boundary layer depth, in m.
type(coupler_2d_bc_type) :: fields !< A structure that may contain an
!! array of named tracer-related fields.
integer :: avg_kount !< Used for accumulating averages of this type.
@@ -242,9 +244,15 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
! Because of the way that indicies and domains are handled, Ocean_sfc must have
! been used in a previous call to initialize_ocean_type.
- real :: Rho0 !< The Boussinesq ocean density, in kg m-3.
- real :: G_Earth !< The gravitational acceleration in m s-2.
- !! This include declares and sets the variable "version".
+ real :: Rho0 !< The Boussinesq ocean density, in kg m-3.
+ real :: G_Earth !< The gravitational acceleration in m s-2.
+ !! This include declares and sets the variable "version".
+ real :: HFrz !< If HFrz > 0 (m), melt potential will be computed.
+ !! The actual depth over which melt potential is computed will
+ !! min(HFrz, OBLD), where OBLD is the boundary layer depth.
+ !! If HFrz <= 0 (default), melt potential will not be computed.
+ logical :: use_melt_pot!< If true, allocate melt_potential array
+
#include "version_variable.h"
character(len=40) :: mdl = "ocean_model_init" !< This module's name.
character(len=48) :: stagger
@@ -337,8 +345,21 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
! Consider using a run-time flag to determine whether to do the diagnostic
! vertical integrals, since the related 3-d sums are not negligible in cost.
- call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, &
- do_integrals=.true., gas_fields_ocn=gas_fields_ocn)
+
+ call get_param(param_file, mdl, "HFREEZE", HFrz, &
+ "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//&
+ "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//&
+ "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//&
+ "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.)
+
+ if (HFrz .gt. 0.0) then
+ use_melt_pot=.true.
+ else
+ use_melt_pot=.false.
+ endif
+
+ call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, do_integrals=.true., &
+ gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot)
call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, &
OS%forcing_CSp, OS%restore_salinity, OS%restore_temp)
@@ -538,8 +559,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
OS%nstep = OS%nstep + 1
call enable_averaging(time_step, OS%Time, OS%diag)
- call mech_forcing_diags(OS%forces, OS%fluxes, time_step, OS%grid, &
- OS%diag, OS%forcing_CSp%handles)
+ call mech_forcing_diags(OS%forces, time_step, OS%grid, OS%diag, OS%forcing_CSp%handles)
call disable_averaging(OS%diag)
if (OS%fluxes%fluxes_used) then
@@ -706,13 +726,15 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap,
endif
call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec)
- allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), &
- Ocean_sfc%s_surf (isc:iec,jsc:jec), &
- Ocean_sfc%u_surf (isc:iec,jsc:jec), &
- Ocean_sfc%v_surf (isc:iec,jsc:jec), &
- Ocean_sfc%sea_lev(isc:iec,jsc:jec), &
- Ocean_sfc%area (isc:iec,jsc:jec), &
- Ocean_sfc%frazil (isc:iec,jsc:jec))
+ allocate (Ocean_sfc%t_surf (isc:iec,jsc:jec), &
+ Ocean_sfc%s_surf (isc:iec,jsc:jec), &
+ Ocean_sfc%u_surf (isc:iec,jsc:jec), &
+ Ocean_sfc%v_surf (isc:iec,jsc:jec), &
+ Ocean_sfc%sea_lev(isc:iec,jsc:jec), &
+ Ocean_sfc%area (isc:iec,jsc:jec), &
+ Ocean_sfc%OBLD (isc:iec,jsc:jec), &
+ Ocean_sfc%melt_potential(isc:iec,jsc:jec), &
+ Ocean_sfc%frazil (isc:iec,jsc:jec))
Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model
Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models
@@ -720,6 +742,8 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap,
Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models
Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav
Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model
+ Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (J/m^2) passed to ice model
+ Ocean_sfc%OBLD = 0.0 ! ocean boundary layer depth, in m
Ocean_sfc%area = 0.0
Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics
@@ -783,11 +807,15 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z)
do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
Ocean_sfc%sea_lev(i,j) = state%sea_lev(i+i0,j+j0)
+ Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0)
if (present(patm)) &
Ocean_sfc%sea_lev(i,j) = Ocean_sfc%sea_lev(i,j) + patm(i,j) * press_to_z
- if (associated(state%frazil)) &
+ if (associated(state%frazil)) &
Ocean_sfc%frazil(i,j) = state%frazil(i+i0,j+j0)
- Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0)
+ if (allocated(state%melt_potential)) &
+ Ocean_sfc%melt_potential(i,j) = state%melt_potential(i+i0,j+j0)
+ if (allocated(state%Hml)) &
+ Ocean_sfc%OBLD(i,j) = state%Hml(i+i0,j+j0)
enddo ; enddo
if (Ocean_sfc%stagger == AGRID) then
@@ -1012,6 +1040,8 @@ subroutine ocean_public_type_chksum(id, timestep, ocn)
write(outunit,100) 'ocean%v_surf ',mpp_chksum(ocn%v_surf )
write(outunit,100) 'ocean%sea_lev ',mpp_chksum(ocn%sea_lev)
write(outunit,100) 'ocean%frazil ',mpp_chksum(ocn%frazil )
+ write(outunit,100) 'ocean%OBLD ',mpp_chksum(ocn%OBLD )
+ write(outunit,100) 'ocean%melt_potential ',mpp_chksum(ocn%melt_potential)
call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%')
100 FORMAT(" CHECKSUM::",A20," = ",Z20)
diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90
index 5c4a43bfc0..6955c20aa1 100644
--- a/config_src/mct_driver/MOM_surface_forcing.F90
+++ b/config_src/mct_driver/MOM_surface_forcing.F90
@@ -250,6 +250,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
real :: delta_sst ! temporary storage for sst diff from restoring value
real :: C_p ! heat capacity of seawater ( J/(K kg) )
+ real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1.
call cpu_clock_begin(id_clock_forcing)
@@ -461,15 +462,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
! salt flux
! more salt restoring logic
if (associated(fluxes%salt_flux)) &
- fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(IOB%salt_flux(i-i0,j-j0) + fluxes%salt_flux(i,j))
+ fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0))
if (associated(fluxes%salt_flux_in)) &
- fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*IOB%salt_flux(i-i0,j-j0)
+ fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*(-IOB%salt_flux(i-i0,j-j0))
enddo; enddo
! adjust the NET fresh-water flux to zero, if flagged
if (CS%adjust_net_fresh_water_to_zero) then
+ sign_for_net_FW_bug = 1.
+ if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1.
do j=js,je ; do i=is,ie
net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + &
(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + &
@@ -480,9 +483,9 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system
! is constant.
! To do this correctly we will need a sea-ice melt field added to IOB. -AJA
- if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) &
- net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * &
- (fluxes%salt_flux(i,j) / CS%ice_salt_concentration)
+ if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) &
+ net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * &
+ (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration)
net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j)
enddo; enddo
@@ -1044,6 +1047,11 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
CS%adjust_net_fresh_water_to_zero, &
"If true, adjusts the net fresh-water forcing seen \n"//&
"by the ocean (including restoring) to zero.", default=.false.)
+ if (CS%adjust_net_fresh_water_to_zero) &
+ call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", &
+ CS%use_net_FW_adjustment_sign_bug, &
+ "If true, use the wrong sign for the adjustment to\n"//&
+ "the net fresh-water.", default=.false.)
call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", &
CS%adjust_net_fresh_water_by_scaling, &
"If true, adjustments to net fresh water to achieve zero net are\n"//&
diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90
index cc214306f0..8fa9f3d656 100644
--- a/config_src/mct_driver/ocn_cap_methods.F90
+++ b/config_src/mct_driver/ocn_cap_methods.F90
@@ -21,219 +21,238 @@ module ocn_cap_methods
contains
!=======================================================================
- !> Maps incomping ocean data to MOM6 data structures
- subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, Eclock, c1, c2, c3, c4)
- real(kind=8) , intent(in) :: x2o(:,:) !< incoming data
- type(cpl_indices_type) , intent(in) :: ind !< Structure with MCT attribute vects and indices
- type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid
- type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing
- type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state
- integer , intent(in) :: logunit !< Unit for stdout output
- type(ESMF_Clock) , intent(in) :: EClock !< Time and time step ? \todo Why must this
- real(kind=8), optional , intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition
-
- ! Local variables
- integer :: i, j, ig, jg, isc, iec, jsc, jec ! Grid indices
- integer :: k
- integer :: day, secs, rc
- type(ESMF_time) :: currTime
- character(*), parameter :: F01 = "('(ocn_import) ',a,4(i6,2x),d21.14)"
- !-----------------------------------------------------------------------
-
- isc = GRID%isc; iec = GRID%iec ; jsc = GRID%jsc; jec = GRID%jec
-
- k = 0
- do j = jsc, jec
- jg = j + grid%jsc - jsc
- do i = isc, iec
- ig = i + grid%jsc - isc
- k = k + 1 ! Increment position within gindex
-
- ! taux
- ice_ocean_boundary%u_flux(i,j) = x2o(ind%x2o_Foxx_taux,k)
-
- ! tauy
- ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k)
-
- ! liquid precipitation (rain)
- ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k)
-
- ! frozen precipitation (snow)
- ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k)
-
- ! longwave radiation, sum up and down (W/m2)
- ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k))
-
- ! specific humitidy flux
- ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign
-
- ! sensible heat flux (W/m2)
- ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) !???TODO: should this be a minus sign
-
- ! latent heat flux (W/m^2)
- ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) !???TODO: should this be a minus sign
-
- ! liquid runoff
- ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg)
-
- ! ice runoff
- ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(ig,jg)
-
- ! surface pressure
- ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg)
-
- ! salt flux
- ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg)
-
- ! 1) visible, direct shortwave (W/m2)
- ! 2) visible, diffuse shortwave (W/m2)
- ! 3) near-IR, direct shortwave (W/m2)
- ! 4) near-IR, diffuse shortwave (W/m2)
- if (present(c1) .and. present(c2) .and. present(c3) .and. present(c4)) then
- ! Use runtime coefficients to decompose net short-wave heat flux into 4 components
- ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg)
- ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg)
- ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg)
- ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg)
- else
- ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg)
- ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg)
- ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg)
- ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg)
- end if
- end do
- end do
-
- if (debug .and. is_root_pe()) then
- call ESMF_ClockGet(EClock, CurrTime=CurrTime, rc=rc)
- call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc)
-
- do j = GRID%jsc, GRID%jec
- do i = GRID%isc, GRID%iec
- write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i,j)
- write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i,j)
- write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i,j)
- write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j)
- write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j)
- write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i,j)
- write(logunit,F01)'import: day, secs, j, i, latent_flux = ',&
- day,secs,j,i,ice_ocean_boundary%latent_flux(i,j)
- write(logunit,F01)'import: day, secs, j, i, runoff = ',&
- day,secs,j,i,ice_ocean_boundary%rofl_flux(i,j) + ice_ocean_boundary%rofi_flux(i,j)
- write(logunit,F01)'import: day, secs, j, i, psurf = ',&
- day,secs,j,i,ice_ocean_boundary%p(i,j)
- write(logunit,F01)'import: day, secs, j, i, salt_flux = ',&
- day,secs,j,i,ice_ocean_boundary%salt_flux(i,j)
- write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',&
- day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i,j)
- write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',&
- day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i,j)
- write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',&
- day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j)
- write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',&
- day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j)
- end do
- end do
- end if
-
- end subroutine ocn_import
+!> Maps incomping ocean data to MOM6 data structures
+subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, Eclock, c1, c2, c3, c4)
+ real(kind=8) , intent(in) :: x2o(:,:) !< incoming data
+ type(cpl_indices_type) , intent(in) :: ind !< Structure with MCT attribute vects and indices
+ type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid
+ type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing
+ type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state
+ integer , intent(in) :: logunit !< Unit for stdout output
+ type(ESMF_Clock) , intent(in) :: EClock !< Time and time step ? \todo Why must this
+ real(kind=8), optional , intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition
+
+ ! Local variables
+ integer :: i, j, ig, jg, isc, iec, jsc, jec ! Grid indices
+ integer :: k
+ integer :: day, secs, rc
+ type(ESMF_time) :: currTime
+ character(*), parameter :: F01 = "('(ocn_import) ',a,4(i6,2x),d21.14)"
+ !-----------------------------------------------------------------------
+
+ isc = GRID%isc; iec = GRID%iec ; jsc = GRID%jsc; jec = GRID%jec
+
+ k = 0
+ do j = jsc, jec
+ jg = j + grid%jsc - jsc
+ do i = isc, iec
+ ig = i + grid%jsc - isc
+ k = k + 1 ! Increment position within gindex
+
+ ! taux
+ ice_ocean_boundary%u_flux(i,j) = x2o(ind%x2o_Foxx_taux,k)
+
+ ! tauy
+ ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k)
+
+ ! liquid precipitation (rain)
+ ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k)
+
+ ! frozen precipitation (snow)
+ ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k)
+
+ ! longwave radiation, sum up and down (W/m2)
+ ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k))
+
+ ! specific humitidy flux
+ ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign
+
+ ! sensible heat flux (W/m2)
+ ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) !???TODO: should this be a minus sign
+
+ ! latent heat flux (W/m^2)
+ ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) !???TODO: should this be a minus sign
+
+ ! liquid runoff
+ ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg)
+
+ ! ice runoff
+ ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(ig,jg)
+
+ ! surface pressure
+ ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg)
+
+ ! salt flux (minus sign needed here -GMM)
+ ice_ocean_boundary%salt_flux(i,j) = -x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg)
+
+ ! 1) visible, direct shortwave (W/m2)
+ ! 2) visible, diffuse shortwave (W/m2)
+ ! 3) near-IR, direct shortwave (W/m2)
+ ! 4) near-IR, diffuse shortwave (W/m2)
+ if (present(c1) .and. present(c2) .and. present(c3) .and. present(c4)) then
+ ! Use runtime coefficients to decompose net short-wave heat flux into 4 components
+ ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg)
+ ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg)
+ ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg)
+ ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg)
+ else
+ ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg)
+ ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg)
+ ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg)
+ ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg)
+ endif
+ enddo
+ enddo
+
+ if (debug .and. is_root_pe()) then
+ call ESMF_ClockGet(EClock, CurrTime=CurrTime, rc=rc)
+ call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc)
+
+ do j = GRID%jsc, GRID%jec
+ do i = GRID%isc, GRID%iec
+ write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i,j)
+ write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i,j)
+ write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i,j)
+ write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j)
+ write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j)
+ write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i,j)
+ write(logunit,F01)'import: day, secs, j, i, latent_flux = ',&
+ day,secs,j,i,ice_ocean_boundary%latent_flux(i,j)
+ write(logunit,F01)'import: day, secs, j, i, runoff = ',&
+ day,secs,j,i,ice_ocean_boundary%rofl_flux(i,j) + ice_ocean_boundary%rofi_flux(i,j)
+ write(logunit,F01)'import: day, secs, j, i, psurf = ',&
+ day,secs,j,i,ice_ocean_boundary%p(i,j)
+ write(logunit,F01)'import: day, secs, j, i, salt_flux = ',&
+ day,secs,j,i,ice_ocean_boundary%salt_flux(i,j)
+ write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',&
+ day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i,j)
+ write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',&
+ day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i,j)
+ write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',&
+ day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j)
+ write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',&
+ day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j)
+ enddo
+ enddo
+ endif
+
+end subroutine ocn_import
!=======================================================================
- !> Maps outgoing ocean data to MCT attribute vector real array
- subroutine ocn_export(ind, ocn_public, grid, o2x)
- type(cpl_indices_type), intent(inout) :: ind !< Structure with coupler indices and vectors
- type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state
- type(ocean_grid_type), intent(in) :: grid !< Ocean model grid
- real(kind=8), intent(inout) :: o2x(:,:) !< MCT outgoing bugger
-
- ! Local variables
- real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo
- integer :: i, j, n, ig, jg !< Grid indices
- real :: slp_L, slp_R, slp_C, slope, u_min, u_max
- !-----------------------------------------------------------------------
-
- ! Copy from ocn_public to o2x. ocn_public uses global indexing with no halos.
- ! The mask comes from "grid" that uses the usual MOM domain that has halos
- ! and does not use global indexing.
-
- n = 0
- do j=grid%jsc, grid%jec
- jg = j + grid%jdg_offset
- do i=grid%isc,grid%iec
- n = n+1
- ig = i + grid%idg_offset
- ! surface temperature in Kelvin
- o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j)
- o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j)
- o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j)
- o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j)
- ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain
- ! in order to update halos. i.e. does not use global indexing.
- ssh(i,j) = ocn_public%sea_lev(ig,jg)
- end do
- end do
-
- ! Update halo of ssh so we can calculate gradients
- call pass_var(ssh, grid%domain)
-
- ! d/dx ssh
- n = 0
- do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec
- n = n+1
- ! This is a simple second-order difference
- ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j)
- ! This is a PLM slope which might be less prone to the A-grid null mode
- slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j)
- if (grid%mask2dCu(I-1,j)==0.) slp_L = 0.
- slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j)
- if (grid%mask2dCu(I+1,j)==0.) slp_R = 0.
- slp_C = 0.5 * (slp_L + slp_R)
- if ( (slp_L * slp_R) > 0.0 ) then
- ! This limits the slope so that the edge values are bounded by the
- ! two cell averages spanning the edge.
- u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) )
- u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) )
- slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C )
- else
- ! Extrema in the mean values require a PCM reconstruction avoid generating
- ! larger extreme values.
- slope = 0.0
- end if
- o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j)
- if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0
- end do; end do
-
- ! d/dy ssh
- n = 0
- do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec
+!> Maps outgoing ocean data to MCT attribute vector real array
+subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day)
+ type(cpl_indices_type), intent(inout) :: ind !< Structure with coupler indices and vectors
+ type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state
+ type(ocean_grid_type), intent(in) :: grid !< Ocean model grid
+ real(kind=8), intent(inout) :: o2x(:,:) !< MCT outgoing bugger
+ real(kind=8), intent(in) :: dt_int !< Amount of time over which to advance the
+ !! ocean (ocean_coupling_time_step), in sec
+ integer, intent(in) :: ncouple_per_day !< Number of ocean coupling calls per day
+
+ ! Local variables
+ real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo
+ integer :: i, j, n, ig, jg !< Grid indices
+ real :: slp_L, slp_R, slp_C, slope, u_min, u_max
+ real :: I_time_int !< The inverse of coupling time interval in s-1.
+
+ !-----------------------------------------------------------------------
+
+ ! Use Adcroft's rule of reciprocals; it does the right thing here.
+ I_time_int = 0.0 ; if (dt_int > 0.0) I_time_int = 1.0 / dt_int
+
+ ! Copy from ocn_public to o2x. ocn_public uses global indexing with no halos.
+ ! The mask comes from "grid" that uses the usual MOM domain that has halos
+ ! and does not use global indexing.
+
+ n = 0
+ do j=grid%jsc, grid%jec
+ jg = j + grid%jdg_offset
+ do i=grid%isc,grid%iec
n = n+1
- ! This is a simple second-order difference
- ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j)
- ! This is a PLM slope which might be less prone to the A-grid null mode
- slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1)
- if (grid%mask2dCv(i,J-1)==0.) slp_L = 0.
-
- slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J)
- if (grid%mask2dCv(i,J+1)==0.) slp_R = 0.
-
- slp_C = 0.5 * (slp_L + slp_R)
- !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R
- if ((slp_L * slp_R) > 0.0) then
- ! This limits the slope so that the edge values are bounded by the
- ! two cell averages spanning the edge.
- u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) )
- u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) )
- slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C )
+ ig = i + grid%idg_offset
+ ! surface temperature in Kelvin
+ o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j)
+ o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j)
+ o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j)
+ o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j)
+ o2x(ind%o2x_So_bldepth, n) = ocn_public%OBLD(ig,jg) * grid%mask2dT(i,j)
+ ! ocean melt and freeze potential (o2x_Fioo_q), W m-2
+ if (ocn_public%frazil(ig,jg) > 0.0) then
+ ! Frazil: change from J/m^2 to W/m^2
+ o2x(ind%o2x_Fioo_q, n) = ocn_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int
else
- ! Extrema in the mean values require a PCM reconstruction avoid generating
- ! larger extreme values.
- slope = 0.0
- end if
- o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j)
- if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0
- end do; end do
-
- end subroutine ocn_export
+ ! Melt_potential: change from J/m^2 to W/m^2
+ o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int !* ncouple_per_day
+ ! make sure Melt_potential is always <= 0
+ if (o2x(ind%o2x_Fioo_q, n) > 0.0) o2x(ind%o2x_Fioo_q, n) = 0.0
+ endif
+ ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain
+ ! in order to update halos. i.e. does not use global indexing.
+ ssh(i,j) = ocn_public%sea_lev(ig,jg)
+ enddo
+ enddo
+
+ ! Update halo of ssh so we can calculate gradients
+ call pass_var(ssh, grid%domain)
+
+ ! d/dx ssh
+ n = 0
+ do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec
+ n = n+1
+ ! This is a simple second-order difference
+ ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j)
+ ! This is a PLM slope which might be less prone to the A-grid null mode
+ slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j)
+ if (grid%mask2dCu(I-1,j)==0.) slp_L = 0.
+ slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j)
+ if (grid%mask2dCu(I+1,j)==0.) slp_R = 0.
+ slp_C = 0.5 * (slp_L + slp_R)
+ if ( (slp_L * slp_R) > 0.0 ) then
+ ! This limits the slope so that the edge values are bounded by the
+ ! two cell averages spanning the edge.
+ u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) )
+ u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) )
+ slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C )
+ else
+ ! Extrema in the mean values require a PCM reconstruction avoid generating
+ ! larger extreme values.
+ slope = 0.0
+ endif
+ o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j)
+ if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0
+ enddo; enddo
+
+ ! d/dy ssh
+ n = 0
+ do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec
+ n = n+1
+ ! This is a simple second-order difference
+ ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j)
+ ! This is a PLM slope which might be less prone to the A-grid null mode
+ slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1)
+ if (grid%mask2dCv(i,J-1)==0.) slp_L = 0.
+
+ slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J)
+ if (grid%mask2dCv(i,J+1)==0.) slp_R = 0.
+
+ slp_C = 0.5 * (slp_L + slp_R)
+ !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R
+ if ((slp_L * slp_R) > 0.0) then
+ ! This limits the slope so that the edge values are bounded by the
+ ! two cell averages spanning the edge.
+ u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) )
+ u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) )
+ slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C )
+ else
+ ! Extrema in the mean values require a PCM reconstruction avoid generating
+ ! larger extreme values.
+ slope = 0.0
+ endif
+ o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j)
+ if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0
+ enddo; enddo
+
+end subroutine ocn_export
end module ocn_cap_methods
diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90
index 63a24b153d..97692ccc65 100644
--- a/config_src/mct_driver/ocn_comp_mct.F90
+++ b/config_src/mct_driver/ocn_comp_mct.F90
@@ -310,7 +310,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )
glb%grid => glb%ocn_state%grid
! Allocate IOB data type (needs to be called after glb%grid is set)
- write(6,*)'DEBUG: isc,iec,jsc,jec= ',glb%grid%isc, glb%grid%iec, glb%grid%jsc, glb%grid%jec
+ !write(6,*)'DEBUG: isc,iec,jsc,jec= ',glb%grid%isc, glb%grid%iec, glb%grid%jsc, glb%grid%jec
call IOB_allocate(ice_ocean_boundary, glb%grid%isc, glb%grid%iec, glb%grid%jsc, glb%grid%jec)
call t_stopf('MOM_init')
@@ -373,7 +373,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )
! end if
if (debug .and. root_pe().eq.pe_here()) print *, "calling ocn_export"
- call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr)
+ call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr, mom_cpl_dt, ncouple_per_day)
call t_stopf('MOM_mct_init')
@@ -423,6 +423,10 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)
integer :: shrlogunit ! original log file unit
integer :: shrloglev ! original log level
logical, save :: firstCall = .true.
+ real (kind=8), parameter :: seconds_in_day = 86400.0 !< number of seconds in one day
+ integer :: ocn_cpl_dt !< one ocn coupling interval in seconds. (to be received from cesm)
+ real (kind=8) :: mom_cpl_dt !< one ocn coupling interval in seconds. (internal)
+ integer :: ncouple_per_day !< number of ocean coupled call in one day (non-dim)
! reset shr logging to ocn log file:
if (is_root_pe()) then
@@ -441,6 +445,10 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)
call ESMF_TimeIntervalGet(ocn_cpl_interval, yy=year, mm=month, d=day, s=seconds, sn=seconds_n, sd=seconds_d, rc=rc)
coupling_timestep = set_time(seconds, days=day, err_msg=err_msg)
+ call seq_timemgr_EClockGetData(EClock, dtime=ocn_cpl_dt)
+ ncouple_per_day = seconds_in_day / ocn_cpl_dt
+ mom_cpl_dt = seconds_in_day / ncouple_per_day
+
! The following if-block is to correct monthly mean outputs:
! With this change, MOM6 starts at the same date as the other components, and runs for the same
! duration as other components, unlike POP, which would have one missing interval due to ocean
@@ -502,7 +510,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)
call update_ocean_model(ice_ocean_boundary, glb%ocn_state, glb%ocn_public, time_start, coupling_timestep)
! Return export state to driver
- call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr)
+ call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr, mom_cpl_dt, ncouple_per_day)
!--- write out intermediate restart file when needed.
! Check alarms for flag to write restart at end of day
@@ -806,6 +814,5 @@ end subroutine ocean_model_init_sfc
!! Boundary layer depth
!! CO2
!! DMS
-!! o2x_Fioo_q !< Heat flux?
end module ocn_comp_mct
diff --git a/config_src/mct_driver/ocn_cpl_indices.F90 b/config_src/mct_driver/ocn_cpl_indices.F90
index 4bd9c1f383..52f94f6106 100644
--- a/config_src/mct_driver/ocn_cpl_indices.F90
+++ b/config_src/mct_driver/ocn_cpl_indices.F90
@@ -16,7 +16,7 @@ module ocn_cpl_indices
integer :: o2x_So_dhdx !< Zonal slope in the sea surface height
integer :: o2x_So_dhdy !< Meridional lope in the sea surface height
integer :: o2x_So_bldepth !< Boundary layer depth (m)
- integer :: o2x_Fioo_q !< Heat flux?
+ integer :: o2x_Fioo_q !< Ocean melt and freeze potential (W/m2)
integer :: o2x_Faoo_fco2_ocn !< CO2 flux
integer :: o2x_Faoo_fdms_ocn !< DMS flux
diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90
deleted file mode 100644
index f009a72e8e..0000000000
--- a/config_src/nuopc_driver/time_utils.F90
+++ /dev/null
@@ -1,161 +0,0 @@
-module time_utils_mod
-
- use fms_mod, only: uppercase
- use mpp_mod, only: mpp_error, FATAL
- use time_manager_mod, only: time_type, set_time, set_date, get_date
- use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR
- use time_manager_mod, only: fms_get_calendar_type => get_calendar_type
- use ESMF
-
- implicit none
- private
-
- !-------------------- interface blocks ---------------------
- interface fms2esmf_cal
- module procedure fms2esmf_cal_c
- module procedure fms2esmf_cal_i
- end interface fms2esmf_cal
- interface esmf2fms_time
- module procedure esmf2fms_time_t
- module procedure esmf2fms_timestep
- end interface esmf2fms_time
-
- public fms2esmf_cal
- public esmf2fms_time
- public fms2esmf_time
- public string_to_date
-
- contains
-
- !-------------------- module code ---------------------
-
- function fms2esmf_cal_c(calendar)
-! ! Return Value:
- type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c
-! ! Arguments:
- character(len=*), intent(in) :: calendar
-
- select case( uppercase(trim(calendar)) )
- case( 'GREGORIAN' )
- fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN
- case( 'JULIAN' )
- fms2esmf_cal_c = ESMF_CALKIND_JULIAN
- case( 'NOLEAP' )
- fms2esmf_cal_c = ESMF_CALKIND_NOLEAP
- case( 'THIRTY_DAY' )
- fms2esmf_cal_c = ESMF_CALKIND_360DAY
- case( 'NO_CALENDAR' )
- fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR
- case default
- call mpp_error(FATAL, &
- 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' )
- end select
- end function fms2esmf_cal_c
-
- function fms2esmf_cal_i(calendar)
-! ! Return Value:
- type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i
-! ! Arguments:
- integer, intent(in) :: calendar
-
- select case(calendar)
- case(THIRTY_DAY_MONTHS)
- fms2esmf_cal_i = ESMF_CALKIND_360DAY
- case(GREGORIAN)
- fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN
- case(JULIAN)
- fms2esmf_cal_i = ESMF_CALKIND_JULIAN
- case(NOLEAP)
- fms2esmf_cal_i = ESMF_CALKIND_NOLEAP
- case(NO_CALENDAR)
- fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR
- end select
- end function fms2esmf_cal_i
-
- function esmf2fms_time_t(time)
- ! Return Value
- type(Time_type) :: esmf2fms_time_t
- ! Input Arguments
- type(ESMF_Time), intent(in) :: time
- ! Local Variables
- integer :: yy, mm, dd, h, m, s
- type(ESMF_CALKIND_FLAG) :: calkind
-
- integer :: rc
-
- call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, &
- calkindflag=calkind, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
-
- esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s)
-
- end function esmf2fms_time_t
-
- function esmf2fms_timestep(timestep)
- ! Return Value
- type(Time_type) :: esmf2fms_timestep
- ! Input Arguments
- type(ESMF_TimeInterval), intent(in):: timestep
- ! Local Variables
- integer :: s
- type(ESMF_CALKIND_FLAG) :: calkind
-
- integer :: rc
-
- call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
-
- esmf2fms_timestep = set_time(s, 0)
-
- end function esmf2fms_timestep
-
- function fms2esmf_time(time, calkind)
- ! Return Value
- type(ESMF_Time) :: fms2esmf_time
- ! Input Arguments
- type(Time_type), intent(in) :: time
- type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind
- ! Local Variables
- integer :: yy, mm, d, h, m, s
- type(ESMF_CALKIND_FLAG) :: l_calkind
-
- integer :: rc
-
- if(present(calkind)) then
- l_calkind = calkind
- else
- l_calkind = fms2esmf_cal(fms_get_calendar_type())
- endif
-
- call get_date(time, yy, mm, d, h, m, s)
-
- call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, &
- calkindflag=l_calkind, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
-
- end function fms2esmf_time
-
- function string_to_date(string, rc)
- character(len=15), intent(in) :: string
- integer, intent(out), optional :: rc
- type(time_type) :: string_to_date
-
- integer :: yr,mon,day,hr,min,sec
-
- if(present(rc)) rc = ESMF_SUCCESS
-
- read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec
- string_to_date = set_date(yr, mon, day, hr, min, sec)
-
- end function string_to_date
-
-end module time_utils_mod
diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90
index 578aa68a2a..68852f89d9 100644
--- a/config_src/solo_driver/MESO_surface_forcing.F90
+++ b/config_src/solo_driver/MESO_surface_forcing.F90
@@ -1,48 +1,8 @@
+!> Sets forcing for the MESO configuration
module MESO_surface_forcing
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* Rewritten by Robert Hallberg, June 2009 *
-!* *
-!* This file contains the subroutines that a user should modify to *
-!* to set the surface wind stresses and fluxes of buoyancy or *
-!* temperature and fresh water. They are called when the run-time *
-!* parameters WIND_CONFIG or BUOY_CONFIG are set to "USER". The *
-!* standard version has simple examples, along with run-time error *
-!* messages that will cause the model to abort if this code has not *
-!* been modified. This code is intended for use with relatively *
-!* simple specifications of the forcing. For more complicated forms, *
-!* it is probably a good idea to read the forcing from input files *
-!* using "file" for WIND_CONFIG and BUOY_CONFIG. *
-!* *
-!* MESO_wind_forcing should set the surface wind stresses (taux and *
-!* tauy) perhaps along with the surface friction velocity (ustar). *
-!* *
-!* MESO_buoyancy forcing is used to set the surface buoyancy *
-!* forcing, which may include a number of fresh water flux fields *
-!* (evap, liq_precip, froz_precip, liq_runoff, froz_runoff, and *
-!* vprec) and the surface heat fluxes (sw, lw, latent and sens) *
-!* if temperature and salinity are state variables, or it may simply *
-!* be the buoyancy flux if it is not. This routine also has coded a *
-!* restoring to surface values of temperature and salinity. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v, tauy *
-!* j x ^ x ^ x At >: u, taux *
-!* j > o > o > At o: h, fluxes. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
use MOM_diag_mediator, only : post_data, query_averaging_enabled
use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr
use MOM_domains, only : pass_var, pass_vector, AGRID
@@ -52,116 +12,46 @@ module MESO_surface_forcing
use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing
use MOM_grid, only : ocean_grid_type
use MOM_io, only : file_exists, MOM_read_data, slasher
-use MOM_time_manager, only : time_type, operator(+), operator(/), get_time
+use MOM_time_manager, only : time_type, operator(+), operator(/)
use MOM_tracer_flow_control, only : call_tracer_set_forcing
use MOM_tracer_flow_control, only : tracer_flow_control_CS
use MOM_variables, only : surface
implicit none ; private
-public MESO_wind_forcing, MESO_buoyancy_forcing, MESO_surface_forcing_init
+public MESO_buoyancy_forcing, MESO_surface_forcing_init
+!> This control structure is used to store parameters associated with the MESO forcing.
type, public :: MESO_surface_forcing_CS ; private
- ! This control structure should be used to store any run-time variables
- ! associated with the user-specified forcing. It can be readily modified
- ! for a specific case, and because it is private there will be no changes
- ! needed in other code (although they will have to be recompiled).
- ! The variables in the cannonical example are used for some common
- ! cases, but do not need to be used.
-
- logical :: use_temperature ! If true, temperature and salinity are used as
- ! state variables.
- logical :: restorebuoy ! If true, use restoring surface buoyancy forcing.
- real :: Rho0 ! The density used in the Boussinesq
- ! approximation, in kg m-3.
- real :: G_Earth ! The gravitational acceleration in m s-2.
- real :: Flux_const ! The restoring rate at the surface, in m s-1.
- real :: gust_const ! A constant unresolved background gustiness
- ! that contributes to ustar, in Pa.
+
+ logical :: use_temperature !< If true, temperature and salinity are used as state variables.
+ logical :: restorebuoy !< If true, use restoring surface buoyancy forcing.
+ real :: Rho0 !< The density used in the Boussinesq approximation, in kg m-3.
+ real :: G_Earth !< The gravitational acceleration in m s-2.
+ real :: Flux_const !< The restoring rate at the surface, in m s-1.
+ real :: gust_const !< A constant unresolved background gustiness
+ !! that contributes to ustar, in Pa.
real, dimension(:,:), pointer :: &
- T_Restore(:,:) => NULL(), & ! The temperature to restore the SST to, in C.
- S_Restore(:,:) => NULL(), & ! The salinity to restore the sea surface salnity
- ! toward, in PSU.
- PmE(:,:) => NULL(), & ! The prescribed precip minus evap, in m s-1.
- Solar(:,:) => NULL(), & ! The shortwave forcing into the ocean, in W m-2 m s-1.
- Heat(:,:) => NULL() ! The prescribed longwave, latent and sensible
- ! heat flux into the ocean, in W m-2.
- character(len=200) :: inputdir ! The directory where NetCDF input files are.
- character(len=200) :: salinityrestore_file, SSTrestore_file
- character(len=200) :: Solar_file, heating_file, PmE_file
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
+ T_Restore(:,:) => NULL(), & !< The temperature to restore the SST toward, in C.
+ S_Restore(:,:) => NULL(), & !< The salinity to restore the sea surface salnity toward, in PSU.
+ PmE(:,:) => NULL(), & !< The prescribed precip minus evap, in m s-1.
+ Solar(:,:) => NULL() !< The shortwave forcing into the ocean, in W m-2 m s-1.
+ real, dimension(:,:), pointer :: Heat(:,:) => NULL() !< The prescribed longwave, latent and sensible
+ !! heat flux into the ocean, in W m-2.
+ character(len=200) :: inputdir !< The directory where NetCDF input files are.
+ character(len=200) :: salinityrestore_file !< The file with the target sea surface salinity
+ character(len=200) :: SSTrestore_file !< The file with the target sea surface temperature
+ character(len=200) :: Solar_file !< The file with the shortwave forcing
+ character(len=200) :: heating_file !< The file with the longwave, latent, and sensible heating
+ character(len=200) :: PmE_file !< The file with precipitation minus evaporation
+ type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
+ !! timing of diagnostic output.
end type MESO_surface_forcing_CS
-logical :: first_call = .true.
+logical :: first_call = .true. !< True until after the first call to the MESO forcing routines
contains
-!### This subroutine sets zero surface wind stresses, but it is not even
-!### used by the MESO experimeents. This subroutine can be deleted. -RWH
-subroutine MESO_wind_forcing(sfc_state, forces, day, G, CS)
- type(surface), intent(inout) :: sfc_state !< A structure containing fields that
- !! describe the surface state of the ocean.
- type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces
- type(time_type), intent(in) :: day !< The time of the fluxes
- type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
- type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a previous
- !! call to MESO_surface_forcing_init
-
-! This subroutine sets the surface wind stresses, forces%taux and forces%tauy.
-! These are the stresses in the direction of the model grid (i.e. the same
-! direction as the u- and v- velocities.) They are both in Pa.
-! In addition, this subroutine can be used to set the surface friction
-! velocity, forces%ustar, in m s-1. This is needed with a bulk mixed layer.
-!
-! Arguments: state - A structure containing fields that describe the
-! surface state of the ocean.
-! (out) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) day - Time of the fluxes.
-! (in) G - The ocean's grid structure.
-! (in) CS - A pointer to the control structure returned by a previous
-! call to MESO_surface_forcing_init
-
- integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq
- integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
-
- ! When modifying the code, comment out this error message. It is here
- ! so that the original (unmodified) version is not accidentally used.
- call MOM_error(FATAL, "MESO_wind_surface_forcing: " // &
- "User forcing routine called without modification." )
-
- is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
- Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
-
- ! Allocate the forcing arrays, if necessary.
- call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.)
-
- ! Set the surface wind stresses, in units of Pa. A positive taux
- ! accelerates the ocean to the (pseudo-)east.
-
- ! The i-loop extends to is-1 so that taux can be used later in the
- ! calculation of ustar - otherwise the lower bound would be Isq.
- do j=js,je ; do I=is-1,Ieq
- forces%taux(I,j) = G%mask2dCu(I,j) * 0.0 ! Change this to the desired expression.
- enddo ; enddo
- do J=js-1,Jeq ; do i=is,ie
- forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 ! Change this to the desired expression.
- enddo ; enddo
-
- ! Set the surface friction velocity, in units of m s-1. ustar
- ! is always positive.
- if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
- ! This expression can be changed if desired, but need not be.
- forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + &
- sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
- 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0)
- enddo ; enddo ; endif
-
-end subroutine MESO_wind_forcing
-
!> This subroutine sets up the MESO buoyancy forcing, which uses control-theory style
!! specification restorative buoyancy fluxes at large scales.
subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)
@@ -175,10 +65,6 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)
type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by
!! a previous call to MESO_surface_forcing_init
-! This subroutine specifies the current surface fluxes of buoyancy or
-! temperature and fresh water. It may also be modified to add
-! surface fluxes of user provided tracers.
-
! When temperature is used, there are long list of fluxes that need to be
! set - essentially the same as for a full coupled model, but most of these
! can be simply set to zero. The net fresh water flux should probably be
@@ -189,17 +75,6 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)
! are in W m-2 and positive for heat going into the ocean. All fresh water
! fluxes are in kg m-2 s-1 and positive for water moving into the ocean.
-! Arguments: state - A structure containing fields that describe the
-! surface state of the ocean.
-! (out) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) day_start - Start time of the fluxes.
-! (in) day_interval - Length of time over which these fluxes
-! will be applied.
-! (in) G - The ocean's grid structure.
-! (in) CS - A pointer to the control structure returned by a previous
-! call to MESO_surface_forcing_init
-
real :: Temp_restore ! The temperature that is being restored toward, in C.
real :: Salin_restore ! The salinity that is being restored toward, in PSU.
real :: density_restore ! The potential density that is being restored
@@ -338,14 +213,6 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS)
type(MESO_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the
!! control structure for this module
-! Arguments: Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "MESO_surface_forcing" ! This module's name.
@@ -413,4 +280,27 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS)
end subroutine MESO_surface_forcing_init
+!> \namespace meso_surface_forcing
+!!
+!! Rewritten by Robert Hallberg, June 2009
+!!
+!! This file contains the subroutines that a user should modify to
+!! to set the surface wind stresses and fluxes of buoyancy or
+!! temperature and fresh water. They are called when the run-time
+!! parameters WIND_CONFIG or BUOY_CONFIG are set to "USER". The
+!! standard version has simple examples, along with run-time error
+!! messages that will cause the model to abort if this code has not
+!! been modified. This code is intended for use with relatively
+!! simple specifications of the forcing. For more complicated forms,
+!! it is probably a good idea to read the forcing from input files
+!! using "file" for WIND_CONFIG and BUOY_CONFIG.
+!!
+!! MESO_buoyancy forcing is used to set the surface buoyancy
+!! forcing, which may include a number of fresh water flux fields
+!! (evap, liq_precip, froz_precip, liq_runoff, froz_runoff, and
+!! vprec) and the surface heat fluxes (sw, lw, latent and sens)
+!! if temperature and salinity are state variables, or it may simply
+!! be the buoyancy flux if it is not. This routine also has coded a
+!! restoring to surface values of temperature and salinity.
+
end module MESO_surface_forcing
diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90
index 61c3f4a509..4933f29182 100644
--- a/config_src/solo_driver/MOM_driver.F90
+++ b/config_src/solo_driver/MOM_driver.F90
@@ -48,7 +48,8 @@ program MOM_main
use MOM_string_functions,only : uppercase
use MOM_surface_forcing, only : set_forcing, forcing_save_restart
use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS
- use MOM_time_manager, only : time_type, set_date, set_time, get_date, time_type_to_real
+ use MOM_time_manager, only : time_type, set_date, get_date
+ use MOM_time_manager, only : real_to_time, time_type_to_real
use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/)
use MOM_time_manager, only : operator(>), operator(<), operator(>=)
use MOM_time_manager, only : increment_date, set_calendar_type, month_name
@@ -137,7 +138,7 @@ program MOM_main
real :: dt_dyn, dtdia, t_elapsed_seg
integer :: n, n_max, nts, n_last_thermo
logical :: diabatic_first, single_step_call
- type(time_type) :: Time2
+ type(time_type) :: Time2, time_chg
integer :: Restart_control ! An integer that is bit-tested to determine whether
! incremental restart files are saved and whether they
@@ -290,7 +291,7 @@ program MOM_main
Start_time = set_date(date_init(1),date_init(2), date_init(3), &
date_init(4),date_init(5),date_init(6))
else
- Start_time = set_time(0,days=0)
+ Start_time = real_to_time(0.0)
endif
call time_interp_external_init
@@ -356,7 +357,7 @@ program MOM_main
endif
ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001))
- Time_step_ocean = set_time(int(floor(dt_forcing+0.5)))
+ Time_step_ocean = real_to_time(dt_forcing)
elapsed_time_master = (abs(dt_forcing - time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing)
if (elapsed_time_master) &
call MOM_mesg("Using real elapsed time for the master clock.", 2)
@@ -415,7 +416,7 @@ program MOM_main
call get_param(param_file, mod_name, "RESTINT", restint, &
"The interval between saves of the restart file in units \n"//&
"of TIMEUNIT. Use 0 (the default) to not save \n"//&
- "incremental restart files at all.", default=set_time(0), &
+ "incremental restart files at all.", default=real_to_time(0.0), &
timeunit=Time_unit)
call get_param(param_file, mod_name, "WRITE_CPU_STEPS", cpu_steps, &
"The number of coupled timesteps between writing the cpu \n"//&
@@ -454,7 +455,7 @@ program MOM_main
if (((.not.BTEST(Restart_control,1)) .and. (.not.BTEST(Restart_control,0))) &
.or. (Restart_control < 0)) permit_incr_restart = .false.
- if (restint > set_time(0)) then
+ if (restint > real_to_time(0.0)) then
! restart_time is the next integral multiple of restint.
restart_time = Start_time + restint * &
(1 + ((Time + Time_step_ocean) - Start_time) / restint)
@@ -532,7 +533,7 @@ program MOM_main
dtdia = dt_dyn*(n - n_last_thermo)
! Back up Time2 to the start of the thermodynamic segment.
if (n > n_last_thermo+1) &
- Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5)))
+ Time2 = Time2 - real_to_time(dtdia - dt_dyn)
call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, &
do_dynamics=.false., do_thermodynamics=.true., &
start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing)
@@ -541,7 +542,7 @@ program MOM_main
endif
t_elapsed_seg = t_elapsed_seg + dt_dyn
- Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5)))
+ Time2 = Time1 + real_to_time(t_elapsed_seg)
enddo
endif
@@ -549,17 +550,17 @@ program MOM_main
! This is here to enable fractional-second time steps.
elapsed_time = elapsed_time + dt_forcing
if (elapsed_time > 2e9) then
- ! This is here to ensure that the conversion from a real to an integer
- ! can be accurately represented in long runs (longer than ~63 years).
- ! It will also ensure that elapsed time does not lose resolution of order
- ! the timetype's resolution, provided that the timestep and tick are
- ! larger than 10-5 seconds. If a clock with a finer resolution is used,
- ! a smaller value would be required.
- segment_start_time = segment_start_time + set_time(int(floor(elapsed_time)))
- elapsed_time = elapsed_time - floor(elapsed_time)
+ ! This is here to ensure that the conversion from a real to an integer can be accurately
+ ! represented in long runs (longer than ~63 years). It will also ensure that elapsed time
+ ! does not lose resolution of order the timetype's resolution, provided that the timestep and
+ ! tick are larger than 10-5 seconds. If a clock with a finer resolution is used, a smaller
+ ! value would be required.
+ time_chg = real_to_time(elapsed_time)
+ segment_start_time = segment_start_time + time_chg
+ elapsed_time = elapsed_time - time_type_to_real(time_chg)
endif
if (elapsed_time_master) then
- Master_Time = segment_start_time + set_time(int(floor(elapsed_time+0.5)))
+ Master_Time = segment_start_time + real_to_time(elapsed_time)
else
Master_Time = Master_Time + Time_step_ocean
endif
@@ -570,8 +571,7 @@ program MOM_main
endif ; endif
call enable_averaging(dt_forcing, Time, diag)
- call mech_forcing_diags(forces, fluxes, dt_forcing, grid, diag, &
- surface_forcing_CSp%handles)
+ call mech_forcing_diags(forces, dt_forcing, grid, diag, surface_forcing_CSp%handles)
call disable_averaging(diag)
if (.not. offline_tracer_mode) then
diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90
index 38ac1917a8..a3a9a12204 100644
--- a/config_src/solo_driver/MOM_surface_forcing.F90
+++ b/config_src/solo_driver/MOM_surface_forcing.F90
@@ -1,53 +1,14 @@
+!> Functions that calculate the surface wind stresses and fluxes of buoyancy
+!! or temperature/salinity andfresh water, in ocean-only (solo) mode.
+!!
+!! These functions are called every time step, even if the wind stresses
+!! or buoyancy fluxes are constant in time - in that case these routines
+!! return quickly without doing anything. In addition, any I/O of forcing
+!! fields is controlled by surface_forcing_init, located in this file.
module MOM_surface_forcing
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, November 1998 - May 2002 *
-!* Edited by Stephen Griffies, June 2014 *
-!* *
-!* This program contains the subroutines that calculate the *
-!* surface wind stresses and fluxes of buoyancy or temp/saln and *
-!* fresh water. These subroutines are called every time step, *
-!* even if the wind stresses or buoyancy fluxes are constant in time *
-!* - in that case these routines return quickly without doing *
-!* anything. In addition, any I/O of forcing fields is controlled *
-!* by surface_forcing_init, located in this file. *
-!* *
-!* set_forcing is a small entry subroutine for the subroutines in *
-!* this file. It provides the external access to these subroutines. *
-!* *
-!* wind_forcing determines the wind stresses and places them into *
-!* forces%taux and forces%tauy. Often wind_forcing must be tailored *
-!* for a particular application - either by specifying file and input *
-!* variable names or by providing appropriate internal expressions *
-!* for the stresses within a modified version of USER_wind_forcing. *
-!* *
-!* buoyancy_forcing determines the surface fluxes of heat, fresh *
-!* water and salt, as appropriate. A restoring boundary *
-!* condition plus a specified flux from a file is implemented here, *
-!* but a user-provided internal expression can be set by modifying *
-!* and calling USER_buoyancy_forcing. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v, tauy *
-!* j x ^ x ^ x At >: u, taux *
-!* j > o > o > At o: h, fluxes. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts
-!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end
-!### use MOM_controlled_forcing, only : ctrl_forcing_CS
use MOM_constants, only : hlv, hlf
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
use MOM_cpu_clock, only : CLOCK_MODULE
@@ -71,11 +32,11 @@ module MOM_surface_forcing
use MOM_io, only : EAST_FACE, NORTH_FACE, num_timelevels
use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS
use MOM_restart, only : restart_init_end, save_restart, restore_state
-use MOM_time_manager, only : time_type, operator(+), operator(/), get_time, set_time
+use MOM_time_manager, only : time_type, operator(+), operator(/), get_time, time_type_to_real
use MOM_tracer_flow_control, only : call_tracer_set_forcing
use MOM_tracer_flow_control, only : tracer_flow_control_CS
use MOM_variables, only : surface
-use MESO_surface_forcing, only : MESO_wind_forcing, MESO_buoyancy_forcing
+use MESO_surface_forcing, only : MESO_buoyancy_forcing
use MESO_surface_forcing, only : MESO_surface_forcing_init, MESO_surface_forcing_CS
use Neverland_surface_forcing, only : Neverland_wind_forcing, Neverland_buoyancy_forcing
use Neverland_surface_forcing, only : Neverland_surface_forcing_init, Neverland_surface_forcing_CS
@@ -104,104 +65,134 @@ module MOM_surface_forcing
public surface_forcing_init
public forcing_save_restart
-! surface_forcing_CS is a structure containing pointers to the forcing fields
-! which may be used to drive MOM. All fluxes are positive into the ocean.
+!> Structure containing pointers to the forcing fields that may be used to drive MOM.
+!! All fluxes are positive into the ocean.
type, public :: surface_forcing_CS ; private
- logical :: use_temperature ! if true, temp & salinity used as state variables
- logical :: restorebuoy ! if true, use restoring surface buoyancy forcing
- logical :: adiabatic ! if true, no diapycnal mass fluxes or surface buoyancy forcing
- logical :: variable_winds ! if true, wind stresses vary with time
- logical :: variable_buoyforce ! if true, buoyancy forcing varies with time.
- real :: south_lat ! southern latitude of the domain
- real :: len_lat ! domain length in latitude
-
- real :: Rho0 ! Boussinesq reference density (kg/m^3)
- real :: G_Earth ! gravitational acceleration (m/s^2)
- real :: Flux_const ! piston velocity for surface restoring (m/s)
- real :: Flux_const_T ! piston velocity for surface temperature restoring (m/s)
- real :: Flux_const_S ! piston velocity for surface salinity restoring (m/s)
- real :: latent_heat_fusion ! latent heat of fusion (J/kg)
- real :: latent_heat_vapor ! latent heat of vaporization (J/kg)
- real :: tau_x0, tau_y0 ! Constant wind stresses used in the WIND_CONFIG="const" forcing
-
- real :: gust_const ! constant unresolved background gustiness for ustar (Pa)
- logical :: read_gust_2d ! if true, use 2-dimensional gustiness supplied from a file
- real, pointer :: gust(:,:) => NULL() ! spatially varying unresolved background gustiness (Pa)
- ! gust is used when read_gust_2d is true.
-
- real, pointer :: T_Restore(:,:) => NULL() ! temperature to damp (restore) the SST to (deg C)
- real, pointer :: S_Restore(:,:) => NULL() ! salinity to damp (restore) the SSS (g/kg)
- real, pointer :: Dens_Restore(:,:) => NULL() ! density to damp (restore) surface density (kg/m^3)
-
- integer :: buoy_last_lev_read = -1 ! The last time level read from buoyancy input files
-
- real :: gyres_taux_const, gyres_taux_sin_amp, gyres_taux_cos_amp, gyres_taux_n_pis
- ! if WIND_CONFIG=='gyres' then use
- ! = A, B, C and n respectively for
- ! taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L)
-
- real :: T_north, T_south ! target temperatures at north and south used in
- ! buoyancy_forcing_linear
- real :: S_north, S_south ! target salinity at north and south used in
- ! buoyancy_forcing_linear
-
- logical :: first_call_set_forcing = .true.
- logical :: archaic_OMIP_file = .true.
- logical :: dataOverrideIsInitialized = .false.
-
- real :: wind_scale ! value by which wind-stresses are scaled, ND.
- real :: constantHeatForcing ! value used for sensible heat flux when buoy_config="const"
-
- character(len=8) :: wind_stagger
- type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL()
+ logical :: use_temperature !< if true, temp & salinity used as state variables
+ logical :: restorebuoy !< if true, use restoring surface buoyancy forcing
+ logical :: adiabatic !< if true, no diapycnal mass fluxes or surface buoyancy forcing
+ logical :: variable_winds !< if true, wind stresses vary with time
+ logical :: variable_buoyforce !< if true, buoyancy forcing varies with time.
+ real :: south_lat !< southern latitude of the domain
+ real :: len_lat !< domain length in latitude
+
+ real :: Rho0 !< Boussinesq reference density (kg/m^3)
+ real :: G_Earth !< gravitational acceleration (m/s^2)
+ real :: Flux_const !< piston velocity for surface restoring (m/s)
+ real :: Flux_const_T !< piston velocity for surface temperature restoring (m/s)
+ real :: Flux_const_S !< piston velocity for surface salinity restoring (m/s)
+ real :: latent_heat_fusion !< latent heat of fusion (J/kg)
+ real :: latent_heat_vapor !< latent heat of vaporization (J/kg)
+ real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" forcing
+ real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" forcing
+
+ real :: gust_const !< constant unresolved background gustiness for ustar (Pa)
+ logical :: read_gust_2d !< if true, use 2-dimensional gustiness supplied from a file
+ real, pointer :: gust(:,:) => NULL() !< spatially varying unresolved background gustiness (Pa)
+ !! gust is used when read_gust_2d is true.
+
+ real, pointer :: T_Restore(:,:) => NULL() !< temperature to damp (restore) the SST to (deg C)
+ real, pointer :: S_Restore(:,:) => NULL() !< salinity to damp (restore) the SSS (g/kg)
+ real, pointer :: Dens_Restore(:,:) => NULL() !< density to damp (restore) surface density (kg/m^3)
+
+ integer :: buoy_last_lev_read = -1 !< The last time level read from buoyancy input files
+
+ ! if WIND_CONFIG=='gyres' then use the following as = A, B, C and n respectively for
+ ! taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L)
+ real :: gyres_taux_const !< A constant wind stress, in Pa.
+ real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres, in Pa, if WIND_CONFIG=='gyres'.
+ real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres, in Pa, if WIND_CONFIG=='gyres'.
+ real :: gyres_taux_n_pis !< The number of sine lobes in the basin if if WIND_CONFIG=='gyres'
+
+
+ real :: T_north !< target temperatures at north used in buoyancy_forcing_linear
+ real :: T_south !< target temperatures at south used in buoyancy_forcing_linear
+ real :: S_north !< target salinity at north used in buoyancy_forcing_linear
+ real :: S_south !< target salinity at south used in buoyancy_forcing_linear
+
+ logical :: first_call_set_forcing = .true. !< True until after the first call to set_forcing
+ logical :: archaic_OMIP_file = .true. !< If true use the variable names and data fields from
+ !! a very old version of the OMIP forcing
+ logical :: dataOverrideIsInitialized = .false. !< If true, data override has been initialized
+
+ real :: wind_scale !< value by which wind-stresses are scaled, ND.
+ real :: constantHeatForcing !< value used for sensible heat flux when buoy_config="const"
+
+ character(len=8) :: wind_stagger !< A character indicating how the wind stress components
+ !! are staggered in WIND_FILE. Valid values are A or C for now.
+ type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< A pointer to the structure
+ !! that is used to orchestrate the calling of tracer packages
!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL()
- type(MOM_restart_CS), pointer :: restart_CSp => NULL()
-
- type(diag_ctrl), pointer :: diag ! structure used to regulate timing of diagnostic output
-
- character(len=200) :: inputdir ! directory where NetCDF input files are.
- character(len=200) :: wind_config ! indicator for wind forcing type (2gyre, USER, FILE..)
- character(len=200) :: wind_file ! if wind_config is "file", file to use
- character(len=200) :: buoy_config ! indicator for buoyancy forcing type
-
- character(len=200) :: longwave_file = ''
- character(len=200) :: shortwave_file = ''
- character(len=200) :: evaporation_file = ''
- character(len=200) :: sensibleheat_file = ''
- character(len=200) :: latentheat_file = ''
-
- character(len=200) :: rain_file = ''
- character(len=200) :: snow_file = ''
- character(len=200) :: runoff_file = ''
-
- character(len=200) :: longwaveup_file = ''
- character(len=200) :: shortwaveup_file = ''
-
- character(len=200) :: SSTrestore_file = ''
- character(len=200) :: salinityrestore_file = ''
-
- character(len=80) :: & ! Variable names in the input files
- stress_x_var = '', stress_y_var = '', ustar_var = '', &
- LW_var = '', SW_var = '', latent_var = '', sens_var = '', evap_var = '', &
- rain_var = '', snow_var = '', lrunoff_var = '', frunoff_var = '', &
- SST_restore_var = '', SSS_restore_var = ''
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure
+
+ type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output
+
+ character(len=200) :: inputdir !< directory where NetCDF input files are.
+ character(len=200) :: wind_config !< indicator for wind forcing type (2gyre, USER, FILE..)
+ character(len=200) :: wind_file !< if wind_config is "file", file to use
+ character(len=200) :: buoy_config !< indicator for buoyancy forcing type
+
+ character(len=200) :: longwave_file = '' !< The file from which the longwave heat flux is read
+ character(len=200) :: shortwave_file = '' !< The file from which the shortwave heat flux is read
+ character(len=200) :: evaporation_file = '' !< The file from which the evaporation is read
+ character(len=200) :: sensibleheat_file = '' !< The file from which the sensible heat flux is read
+ character(len=200) :: latentheat_file = '' !< The file from which the latent heat flux is read
+
+ character(len=200) :: rain_file = '' !< The file from which the rainfall is read
+ character(len=200) :: snow_file = '' !< The file from which the snowfall is read
+ character(len=200) :: runoff_file = '' !< The file from which the runoff is read
+
+ character(len=200) :: longwaveup_file = '' !< The file from which the upward longwave heat flux is read
+ character(len=200) :: shortwaveup_file = '' !< The file from which the upward shorwave heat flux is read
+
+ character(len=200) :: SSTrestore_file = '' !< The file from which to read the sea surface
+ !! temperature to restore toward
+ character(len=200) :: salinityrestore_file = '' !< The file from which to read the sea surface
+ !! salinity to restore toward
+
+ character(len=80) :: stress_x_var = '' !< X-windstress variable name in the input file
+ character(len=80) :: stress_y_var = '' !< Y-windstress variable name in the input file
+ character(len=80) :: ustar_var = '' !< ustar variable name in the input file
+ character(len=80) :: LW_var = '' !< lonngwave heat flux variable name in the input file
+ character(len=80) :: SW_var = '' !< shortwave heat flux variable name in the input file
+ character(len=80) :: latent_var = '' !< latent heat flux variable name in the input file
+ character(len=80) :: sens_var = '' !< sensible heat flux variable name in the input file
+ character(len=80) :: evap_var = '' !< evaporation variable name in the input file
+ character(len=80) :: rain_var = '' !< rainfall variable name in the input file
+ character(len=80) :: snow_var = '' !< snowfall variable name in the input file
+ character(len=80) :: lrunoff_var = '' !< liquid runoff variable name in the input file
+ character(len=80) :: frunoff_var = '' !< frozen runoff variable name in the input file
+ character(len=80) :: SST_restore_var = '' !< target sea surface temeperature variable name in the input file
+ character(len=80) :: SSS_restore_var = '' !< target sea surface salinity variable name in the input file
! These variables give the number of time levels in the various forcing files.
- integer :: SW_nlev = -1, LW_nlev = -1, latent_nlev = -1, sens_nlev = -1
- integer :: wind_nlev = -1, evap_nlev = -1, precip_nlev = -1, runoff_nlev = -1
- integer :: SST_nlev = -1, SSS_nlev = -1
+ integer :: wind_nlev = -1 !< The number of time levels in the file of wind stress
+ integer :: SW_nlev = -1 !< The number of time levels in the file of shortwave heat flux
+ integer :: LW_nlev = -1 !< The number of time levels in the file of longwave heat flux
+ integer :: latent_nlev = -1 !< The number of time levels in the file of latent heat flux
+ integer :: sens_nlev = -1 !< The number of time levels in the file of sensible heat flux
+ integer :: evap_nlev = -1 !< The number of time levels in the file of evaporation
+ integer :: precip_nlev = -1 !< The number of time levels in the file of precipitation
+ integer :: runoff_nlev = -1 !< The number of time levels in the file of runoff
+ integer :: SST_nlev = -1 !< The number of time levels in the file of target SST
+ integer :: SSS_nlev = -1 !< The number of time levels in the file of target SSS
! These variables give the last time level read for the various forcing files.
- integer :: wind_last_lev = -1
- integer :: SW_last_lev = -1, LW_last_lev = -1, latent_last_lev = -1
- integer :: sens_last_lev = -1
- integer :: evap_last_lev = -1, precip_last_lev = -1, runoff_last_lev = -1
- integer :: SST_last_lev = -1, SSS_last_lev = -1
-
- ! Diagnostics handles
- type(forcing_diags), public :: handles
-
+ integer :: wind_last_lev = -1 !< The last time level read of wind stress
+ integer :: SW_last_lev = -1 !< The last time level read of shortwave heat flux
+ integer :: LW_last_lev = -1 !< The last time level read of longwave heat flux
+ integer :: latent_last_lev = -1 !< The last time level read of latent heat flux
+ integer :: sens_last_lev = -1 !< The last time level read of sensible heat flux
+ integer :: evap_last_lev = -1 !< The last time level read of evaporation
+ integer :: precip_last_lev = -1 !< The last time level read of precipitation
+ integer :: runoff_last_lev = -1 !< The last time level read of runoff
+ integer :: SST_last_lev = -1 !< The last time level read of target SST
+ integer :: SSS_last_lev = -1 !< The last time level read of target SSS
+
+ type(forcing_diags), public :: handles !< A structure with diagnostics handles
+
+ !>@{ Control structures for named forcing packages
type(user_revise_forcing_CS), pointer :: urf_CS => NULL()
type(user_surface_forcing_CS), pointer :: user_forcing_CSp => NULL()
type(BFB_surface_forcing_CS), pointer :: BFB_forcing_CSp => NULL()
@@ -210,14 +201,16 @@ module MOM_surface_forcing
type(Neverland_surface_forcing_CS), pointer :: Neverland_forcing_CSp => NULL()
type(SCM_idealized_hurricane_CS), pointer :: SCM_idealized_hurricane_CSp => NULL()
type(SCM_CVmix_tests_CS), pointer :: SCM_CVmix_tests_CSp => NULL()
+ !!@}
end type surface_forcing_CS
-integer :: id_clock_forcing
+integer :: id_clock_forcing !< A CPU time clock
contains
-!> This subroutine calls other subroutines in this file to get surface forcing fields.
+!> Calls subroutines in this file to get surface forcing fields.
+!!
!! It also allocates and initializes the fields in the forcing and mech_forcing types
!! the first time it is called.
subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS)
@@ -230,21 +223,9 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! This subroutine calls other subroutines in this file to get surface forcing fields.
-! It also allocates and initializes the fields in the flux type.
-
-! Arguments:
-! (inout) state = structure describing ocean surface state
-! (inout) fluxes = structure with pointers to forcing fields; unused have NULL ptrs
-! (in) day_start = Start time of the fluxes
-! (in) day_interval = Length of time over which these fluxes applied
-! (in) G = ocean grid structure
-! (in) CS = pointer to control struct returned by previous surface_forcing_init call
-
+ ! Local variables
real :: dt ! length of time in seconds over which fluxes applied
type(time_type) :: day_center ! central time of the fluxes.
- integer :: intdt
integer :: isd, ied, jsd, jed
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -252,8 +233,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS
call callTree_enter("set_forcing, MOM_surface_forcing.F90")
day_center = day_start + day_interval/2
- call get_time(day_interval, intdt)
- dt = real(intdt)
+ dt = time_type_to_real(day_interval)
if (CS%first_call_set_forcing) then
! Allocate memory for the mechanical and thermodyanmic forcing fields.
@@ -293,8 +273,6 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS
call wind_forcing_const(sfc_state, forces, 0., 0., day_center, G, CS)
elseif (trim(CS%wind_config) == "const") then
call wind_forcing_const(sfc_state, forces, CS%tau_x0, CS%tau_y0, day_center, G, CS)
- elseif (trim(CS%wind_config) == "MESO") then
- call MESO_wind_forcing(sfc_state, forces, day_center, G, CS%MESO_forcing_CSp)
elseif (trim(CS%wind_config) == "Neverland") then
call Neverland_wind_forcing(sfc_state, forces, day_center, G, CS%Neverland_forcing_CSp)
elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then
@@ -373,7 +351,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS
end subroutine set_forcing
-!> This subroutine sets the surface wind stresses to constant values
+!> Sets the surface wind stresses to constant values
subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -384,25 +362,13 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! subroutine sets the surface wind stresses to zero
-
-! Arguments:
-! state = structure describing ocean surface state
-! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs
-! (in) day = time of the fluxes
-! (in) G = ocean grid structure
-! (in) CS = pointer to control returned by previous surface_forcing_init call
-
+ ! Local variables
real :: mag_tau
integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq
- integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
call callTree_enter("wind_forcing_const, MOM_surface_forcing.F90")
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
!set steady surface wind stresses, in units of Pa.
mag_tau = sqrt( tau_x0**2 + tau_y0**2)
@@ -429,7 +395,7 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS)
end subroutine wind_forcing_const
-!> This subroutine sets the surface wind stresses to set up two idealized gyres.
+!> Sets the surface wind stresses to set up two idealized gyres.
subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -438,25 +404,13 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! This subroutine sets the surface wind stresses according to double gyre.
-
-! Arguments:
-! state = structure describing ocean surface state
-! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs
-! (in) day = time of the fluxes
-! (in) G = ocean grid structure
-! (in) CS = pointer to control struct returned by previous surface_forcing_init call
-
+ ! Local variables
real :: PI
integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq
- integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
call callTree_enter("wind_forcing_2gyre, MOM_surface_forcing.F90")
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
!set the steady surface wind stresses, in units of Pa.
PI = 4.0*atan(1.0)
@@ -474,7 +428,7 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS)
end subroutine wind_forcing_2gyre
-!> This subroutine sets the surface wind stresses to set up a single idealized gyre.
+!> Sets the surface wind stresses to set up a single idealized gyre.
subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -483,25 +437,13 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! This subroutine sets the surface wind stresses according to single gyre.
-
-! Arguments:
-! state = structure describing ocean surface state
-! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs
-! (in) day = time of the fluxes
-! (in) G = ocean grid structure
-! (in) CS = pointer to control struct returned by previous surface_forcing_init call
-
+ ! Local variables
real :: PI
integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq
- integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
call callTree_enter("wind_forcing_1gyre, MOM_surface_forcing.F90")
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
! set the steady surface wind stresses, in units of Pa.
PI = 4.0*atan(1.0)
@@ -517,8 +459,7 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS)
call callTree_leave("wind_forcing_1gyre")
end subroutine wind_forcing_1gyre
-
-!> This subroutine sets the surface wind stresses to set up idealized gyres.
+!> Sets the surface wind stresses to set up idealized gyres.
subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -527,29 +468,25 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! This subroutine sets the surface wind stresses according to gyres.
+ ! Local variables
real :: PI, y
integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq
- integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
call callTree_enter("wind_forcing_gyres, MOM_surface_forcing.F90")
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
! steady surface wind stresses (Pa)
PI = 4.0*atan(1.0)
- do j=jsd,jed ; do I=is-1,IedB
+ do j=js-1,je+1 ; do I=is-1,Ieq
y = (G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat
forces%taux(I,j) = CS%gyres_taux_const + &
( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) &
+ CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) )
enddo ; enddo
- do J=js-1,JedB ; do i=isd,ied
+ do J=js-1,Jeq ; do i=is-1,ie+1
forces%tauy(i,J) = 0.0
enddo ; enddo
@@ -564,7 +501,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS)
end subroutine wind_forcing_gyres
-! This subroutine sets the surface wind stresses from input files.
+! Sets the surface wind stresses from input files.
subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -573,16 +510,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! This subroutine sets the surface wind stresses.
-
-! Arguments:
-! state = structure describing ocean surface state
-! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs
-! (in) day = time of the fluxes
-! (in) G = ocean grid structure
-! (in) CS = pointer to control struct returned by previous surface_forcing_init call
-
+ ! Local variables
character(len=200) :: filename ! The name of the input file.
real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional
real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points, in Pa.
@@ -591,16 +519,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS)
integer :: time_lev ! The time level that is used for a field.
integer :: days, seconds
integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq
- integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
logical :: read_Ustar
call callTree_enter("wind_forcing_from_file, MOM_surface_forcing.F90")
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
- call get_time(day,seconds,days)
+ call get_time(day, seconds, days)
time_lev_daily = days - 365*floor(real(days) / 365.0)
if (time_lev_daily < 31) then ; time_lev_monthly = 0
@@ -725,7 +650,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS)
end subroutine wind_forcing_from_file
-! This subroutine sets the surface wind stresses via the data override facility.
+! Sets the surface wind stresses via the data override facility.
subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -734,15 +659,7 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, CS)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-! This subroutine sets the surface wind stresses
-
-! Arguments:
-! state = structure describing ocean surface state
-! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs
-! (in) day = time of the fluxes
-! (in) G = ocean grid structure
-! (in) CS = pointer to control struct returned by previous surface_forcing_init call
-
+ ! Local variables
real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional
real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points, in Pa.
integer :: i, j, is_in, ie_in, js_in, je_in
@@ -798,7 +715,7 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, CS)
end subroutine wind_forcing_by_data_override
-!> This subroutine specifies zero surface bouyancy fluxes from input files.
+!> Specifies zero surface bouyancy fluxes from input files.
subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -809,12 +726,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! This subroutine specifies the current surface fluxes of buoyancy
-! temperature and fresh water. It may also be modified to add
-! surface fluxes of user provided tracers.
-! This case has surface buoyancy forcing from input files.
-
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
temp, & ! A 2-d temporary work array with various units.
SST_anom, & ! Instantaneous sea surface temperature anomalies from a
@@ -843,7 +755,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS)
Irho0 = 1.0/CS%Rho0
! Read the buoyancy forcing file
- call get_time(day,seconds,days)
+ call get_time(day, seconds, days)
time_lev_daily = days - 365*floor(real(days) / 365.0)
@@ -1081,7 +993,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS)
call callTree_leave("buoyancy_forcing_from_files")
end subroutine buoyancy_forcing_from_files
-!> This subroutine specifies zero surface bouyancy fluxes from data over-ride.
+!> Specifies zero surface bouyancy fluxes from data over-ride.
subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -1092,20 +1004,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! This subroutine specifies the current surface fluxes of buoyancy
-! temperature and fresh water. It may also be modified to add
-! surface fluxes of user provided tracers.
-! This case has surface buoyancy forcing from data over-ride.
-
-! Arguments:
-! state = structure describing ocean surface state
-! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs
-! (in) day = time of the fluxes
-! (in) dt = amount of time over which the fluxes apply
-! (in) G = ocean grid structure
-! (in) CS = pointer to control struct returned by previous surface_forcing_init call
-
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
temp, & ! A 2-d temporary work array with various units.
SST_anom, & ! Instantaneous sea surface temperature anomalies from a
@@ -1271,20 +1170,7 @@ subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! This subroutine specifies the current surface fluxes of buoyancy
-! temperature and fresh water. It may also be modified to add
-! surface fluxes of user provided tracers.
-! This case has zero surface buoyancy forcing.
-
-! Arguments:
-! (inout) state = structure describing ocean surface state
-! (inout) fluxes = structure with pointers to forcing fields; unused have NULL ptrs
-! (in) day = time of the fluxes
-! (in) dt = amount of time over which the fluxes apply
-! (in) G = ocean grid structure
-! (in) CS = pointer to control struct returned by previous surface_forcing_init call
-
+ ! Local variables
integer :: i, j, is, ie, js, je
call callTree_enter("buoyancy_forcing_zero, MOM_surface_forcing.F90")
@@ -1316,7 +1202,7 @@ subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS)
end subroutine buoyancy_forcing_zero
-!> This subroutine sets up spatially and temporally constant surface heat fluxes.
+!> Sets up spatially and temporally constant surface heat fluxes.
subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -1327,20 +1213,7 @@ subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! This subroutine specifies the current surface fluxes of buoyancy
-! temperature and fresh water. It may also be modified to add
-! surface fluxes of user provided tracers.
-! We here define a constant surface heat flux.
-
-! Arguments:
-! (inout) state = structure describing ocean surface state
-! (inout) fluxes = structure with pointers to forcing fields; unused have NULL ptrs
-! (in) day = time of the fluxes
-! (in) dt = amount of time over which the fluxes apply
-! (in) G = ocean grid structure
-! (in) CS = pointer to control struct returned by previous surface_forcing_init call
-
+ ! Local variables
integer :: i, j, is, ie, js, je
call callTree_enter("buoyancy_forcing_const, MOM_surface_forcing.F90")
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
@@ -1370,9 +1243,8 @@ subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, CS)
call callTree_leave("buoyancy_forcing_const")
end subroutine buoyancy_forcing_const
-
-!> This subroutine sets surface fluxes of heat and salinity by restoring to temperature and
-!! saliinty profiles that vary linearly with latitude.
+!> Sets surface fluxes of heat and salinity by restoring to temperature and
+!! salinity profiles that vary linearly with latitude.
subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -1383,19 +1255,7 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
-
-! This subroutine specifies the current surface fluxes of buoyancy
-! temperature and fresh water. It may also be modified to add
-! surface fluxes of user provided tracers.
-
-! Arguments:
-! (inout) state = structure describing ocean surface state
-! (inout) fluxes = structure with pointers to forcing fields; unused have NULL ptrs
-! (in) day = time of the fluxes
-! (in) dt = amount of time over which the fluxes apply
-! (in) G = ocean grid structure
-! (in) CS = pointer to control struct returned by previous surface_forcing_init call
-
+ ! Local variables
real :: y, T_restore, S_restore
integer :: i, j, is, ie, js, je
@@ -1477,15 +1337,6 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, &
character(len=*), optional, intent(in) :: filename_suffix !< optional suffix (e.g., a time-stamp)
!! to append to the restart fname
-! Arguments:
-! CS = pointer to control structure from previous surface_forcing_init call
-! (in) G = ocean grid structure
-! (in) Time = model time at this call; needed for mpp_write calls
-! (in, opt) directory = optional directory into which to write these restart files
-! (in, opt) time_stamped = if true, the restart file names include a unique time stamp
-! default is false.
-! (in, opt) filename_suffix = optional suffix (e.g., a time-stamp) to append to the restart fname
-
if (.not.associated(CS)) return
if (.not.associated(CS%restart_CSp)) return
@@ -1501,16 +1352,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp)
type(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output
type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by
!! a previous surface_forcing_init call
- type(tracer_flow_control_CS), pointer :: tracer_flow_CSp
-
-! Arguments:
-! Time = current model time
-! (in) G = ocean grid structure
-! (in) param_file = structure indicating the open file to parse for model parameter values
-! (in) diag = structure used to regulate diagnostic output
-! (in/out) CS = pointer set to point to the control structure for this module
-! (in) tracer_flow_CSp = pointer to the control structure of the tracer flow control module
-
+ type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< Forcing for tracers?
+ ! Local variables
type(directories) :: dirs
logical :: new_sim
type(time_type) :: Time_frc
@@ -1849,7 +1692,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp)
"With wind_config const, this is the constant zonal\n"//&
"wind-stress", units="Pa", fail_if_missing=.true.)
call get_param(param_file, mdl, "CONST_WIND_TAUY", CS%tau_y0, &
- "With wind_config const, this is the constant zonal\n"//&
+ "With wind_config const, this is the constant meridional\n"//&
"wind-stress", units="Pa", fail_if_missing=.true.)
elseif (trim(CS%wind_config) == "SCM_CVmix_tests" .or. &
trim(CS%buoy_config) == "SCM_CVmix_tests") then
diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90
index 55476f9051..326b807293 100644
--- a/config_src/solo_driver/Neverland_surface_forcing.F90
+++ b/config_src/solo_driver/Neverland_surface_forcing.F90
@@ -12,7 +12,7 @@ module Neverland_surface_forcing
use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing
use MOM_grid, only : ocean_grid_type
use MOM_io, only : file_exists, read_data, slasher
-use MOM_time_manager, only : time_type, operator(+), operator(/), get_time
+use MOM_time_manager, only : time_type, operator(+), operator(/)
use MOM_variables, only : surface
implicit none ; private
@@ -22,9 +22,10 @@ module Neverland_surface_forcing
public Neverland_surface_forcing_init
!> This control structure should be used to store any run-time variables
-!! associated with the Neverland forcing. It can be readily modified
-!! for a specific case, and because it is private there will be no changes
-!! needed in other code (although they will have to be recompiled).
+!! associated with the Neverland forcing.
+!!
+!! It can be readily modified for a specific case, and because it is private there
+!! will be no changes needed in other code (although they will have to be recompiled).
type, public :: Neverland_surface_forcing_CS ; private
logical :: use_temperature !< If true, use temperature and salinity.
@@ -47,15 +48,15 @@ module Neverland_surface_forcing
!! Neverland forcing configuration.
subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
- !! describe the surface state of the ocean.
+ !! describe the surface state of the ocean.
type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces
- type(time_type), intent(in) :: day !< Time used for determining the fluxes.
- type(ocean_grid_type), intent(inout) :: G !< Grid structure.
- type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module.
- ! Local variable
+ type(time_type), intent(in) :: day !< Time used for determining the fluxes.
+ type(ocean_grid_type), intent(inout) :: G !< Grid structure.
+ type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module.
+
+ ! Local variables
integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
-
real :: x, y
real :: PI
real :: tau_max, off
@@ -109,26 +110,26 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS)
end subroutine Neverland_wind_forcing
!> Returns the value of a cosine-bell function evaluated at x/L
- real function cosbell(x,L)
+real function cosbell(x,L)
- real , intent(in) :: x !< non-dimensional position
- real , intent(in) :: L !< non-dimensional width
- real :: PI !< 3.1415926... calculated as 4*atan(1)
+ real , intent(in) :: x !< non-dimensional position
+ real , intent(in) :: L !< non-dimensional width
+ real :: PI !< 3.1415926... calculated as 4*atan(1)
- PI = 4.0*atan(1.0)
- cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0)))
- end function cosbell
+ PI = 4.0*atan(1.0)
+ cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0)))
+end function cosbell
!> Returns the value of a sin-spike function evaluated at x/L
- real function spike(x,L)
+real function spike(x,L)
- real , intent(in) :: x !< non-dimensional position
- real , intent(in) :: L !< non-dimensional width
- real :: PI !< 3.1415926... calculated as 4*atan(1)
+ real , intent(in) :: x !< non-dimensional position
+ real , intent(in) :: L !< non-dimensional width
+ real :: PI !< 3.1415926... calculated as 4*atan(1)
- PI = 4.0*atan(1.0)
- spike = (1 - sin(PI*MIN(ABS(x/L),0.5)))
- end function spike
+ PI = 4.0*atan(1.0)
+ spike = (1 - sin(PI*MIN(ABS(x/L),0.5)))
+end function spike
!> Surface fluxes of buoyancy for the Neverland configurations.
@@ -217,7 +218,7 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS)
! This include declares and sets the variable "version".
#include "version_variable.h"
! Local variables
- character(len=40) :: mod = "Neverland_surface_forcing" ! This module's name.
+ character(len=40) :: mdl = "Neverland_surface_forcing" ! This module's name.
if (associated(CS)) then
call MOM_error(WARNING, "Neverland_surface_forcing_init called with an associated "// &
@@ -228,31 +229,31 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS)
CS%diag => diag
! Read all relevant parameters and write them to the model log.
- call log_version(param_file, mod, version, "")
- call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, &
+ call log_version(param_file, mdl, version, "")
+ call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, &
"If true, Temperature and salinity are used as state \n"//&
"variables.", default=.true.)
- call get_param(param_file, mod, "G_EARTH", CS%G_Earth, &
+ call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, &
"The gravitational acceleration of the Earth.", &
units="m s-2", default = 9.80)
- call get_param(param_file, mod, "RHO_0", CS%Rho0, &
+ call get_param(param_file, mdl, "RHO_0", CS%Rho0, &
"The mean ocean density used with BOUSSINESQ true to \n"//&
"calculate accelerations and the mass for conservation \n"//&
"properties, or with BOUSSINSEQ false to convert some \n"//&
"parameters from vertical units of m to kg m-2.", &
units="kg m-3", default=1035.0)
-! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, &
+! call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, &
! "The background gustiness in the winds.", units="Pa", &
! default=0.02)
- call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, &
+ call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, &
"If true, the buoyancy fluxes drive the model back \n"//&
"toward some specified surface state with a rate \n"//&
"given by FLUXCONST.", default= .false.)
if (CS%restorebuoy) then
- call get_param(param_file, mod, "FLUXCONST", CS%flux_const, &
+ call get_param(param_file, mdl, "FLUXCONST", CS%flux_const, &
"The constant that relates the restoring surface fluxes \n"//&
"to the relative surface anomalies (akin to a piston \n"//&
"velocity). Note the non-MKS units.", units="m day-1", &
diff --git a/config_src/solo_driver/atmos_ocean_fluxes.F90 b/config_src/solo_driver/atmos_ocean_fluxes.F90
index 5494954398..4a4ddf6da3 100644
--- a/config_src/solo_driver/atmos_ocean_fluxes.F90
+++ b/config_src/solo_driver/atmos_ocean_fluxes.F90
@@ -13,7 +13,7 @@ module atmos_ocean_fluxes_mod
!> This subroutine duplicates an interface used by the FMS coupler, but only
!! returns a value of -1. None of the arguments are used for anything.
function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, &
- param, flag, ice_restart_file, ocean_restart_file, &
+ param, flag, mol_wt, ice_restart_file, ocean_restart_file, &
units, caller, verbosity) result (coupler_index)
character(len=*), intent(in) :: name !< An unused argument
@@ -22,6 +22,7 @@ function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index,
integer, optional, intent(in) :: atm_tr_index !< An unused argument
real, dimension(:), optional, intent(in) :: param !< An unused argument
logical, dimension(:), optional, intent(in) :: flag !< An unused argument
+ real, optional, intent(in) :: mol_wt !< An unused argument
character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument
character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument
character(len=*), optional, intent(in) :: units !< An unused argument
diff --git a/config_src/solo_driver/coupler_types.F90 b/config_src/solo_driver/coupler_types.F90
index 99a74e085c..10d22a8eff 100644
--- a/config_src/solo_driver/coupler_types.F90
+++ b/config_src/solo_driver/coupler_types.F90
@@ -1,12 +1,13 @@
+!> This module contains the coupler-type declarations and methods for use in
+!! ocean-only configurations of MOM6.
+!!
+!! It is intended that the version of coupler_types_mod that is avialable from
+!! FMS will conform to this version with the FMS city release after warsaw.
+
module coupler_types_mod
! This file is part of MOM6. See LICENSE.md for the license.
-! This module contains the coupler-type declarations and methods for use in
-! ocean-only configurations of MOM6. It is intended that the version of
-! coupler_types_mod that is avialable from FMS will conform to this version with
-! the FMS city release after warsaw.
-
use fms_io_mod, only: restart_file_type, register_restart_field
use fms_io_mod, only: query_initialized, restore_state
use time_manager_mod, only: time_type
@@ -28,9 +29,11 @@ module coupler_types_mod
public coupler_type_copy_1d_2d
public coupler_type_copy_1d_3d
+
!
! 3-d fields
!
+!> A type with a 3-d array of values and metadata
type, public :: coupler_3d_values_type
character(len=48) :: name = ' ' !< The diagnostic name for this array
real, pointer, contiguous, dimension(:,:,:) :: values => NULL() !< The pointer to the
@@ -47,6 +50,7 @@ module coupler_types_mod
!! if it can not be read from a restart file
end type coupler_3d_values_type
+!> A field with one or more related 3-d variables and collective metadata
type, public :: coupler_3d_field_type
character(len=48) :: name = ' ' !< name
integer :: num_fields = 0 !< num_fields
@@ -66,19 +70,24 @@ module coupler_types_mod
real :: mol_wt = 0.0 !< mol_wt
end type coupler_3d_field_type
+!> A collection of 3-D boundary conditions for exchange between components
type, public :: coupler_3d_bc_type
integer :: num_bcs = 0 !< The number of boundary condition fields
type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary
!! condition fields
logical :: set = .false. !< If true, this type has been initialized
- integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type
- integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type
- integer :: ks, ke !< The k-direction index ranges for this type
+ !>@{ The i- and j-direction data and computational domain index ranges for this type
+ integer :: isd, isc, iec, ied ! The i-direction data and computational domain index ranges for this type
+ integer :: jsd, jsc, jec, jed ! The j-direction data and computational domain index ranges for this type
+ !!@}
+ integer :: ks !< The k-direction start index for this type
+ integer :: ke !< The k-direction end index for this type
end type coupler_3d_bc_type
!
! 2-d fields
!
+!> A type with a 2-d array of values and metadata
type, public :: coupler_2d_values_type
character(len=48) :: name = ' ' !< The diagnostic name for this array
real, pointer, contiguous, dimension(:,:) :: values => NULL() !< The pointer to the
@@ -95,6 +104,7 @@ module coupler_types_mod
!! if it can not be read from a restart file
end type coupler_2d_values_type
+!> A field with one or more related 2-d variables and collective metadata
type, public :: coupler_2d_field_type
character(len=48) :: name = ' ' !< name
integer :: num_fields = 0 !< num_fields
@@ -114,18 +124,22 @@ module coupler_types_mod
real :: mol_wt = 0.0 !< mol_wt
end type coupler_2d_field_type
+!> A collection of 2-D boundary conditions for exchange between components
type, public :: coupler_2d_bc_type
integer :: num_bcs = 0 !< The number of boundary condition fields
type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary
!! condition fields
logical :: set = .false. !< If true, this type has been initialized
- integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type
- integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type
+ !>@{ The i- and j-direction data and computational domain index ranges for this type
+ integer :: isd, isc, iec, ied ! The i-direction data and computational domain index ranges for this type
+ integer :: jsd, jsc, jec, jed ! The j-direction data and computational domain index ranges for this type
+ !!@}
end type coupler_2d_bc_type
!
! 1-d fields
!
+!> A type with a 1-d array of values and metadata
type, public :: coupler_1d_values_type
character(len=48) :: name = ' ' !< The diagnostic name for this array
real, pointer, dimension(:) :: values => NULL() !< The pointer to the array of values
@@ -139,6 +153,7 @@ module coupler_types_mod
!! if it can not be read from a restart file
end type coupler_1d_values_type
+!> A field with one or more related 1-d variables and collective metadata
type, public :: coupler_1d_field_type
character(len=48) :: name = ' ' !< name
integer :: num_fields = 0 !< num_fields
@@ -156,6 +171,7 @@ module coupler_types_mod
real :: mol_wt = 0.0 !< mol_wt
end type coupler_1d_field_type
+!> A collection of 1-D boundary conditions for exchange between components
type, public :: coupler_1d_bc_type
integer :: num_bcs = 0 !< The number of boundary condition fields
type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary
diff --git a/config_src/solo_driver/coupler_util.F90 b/config_src/solo_driver/coupler_util.F90
index dde67c2976..cc63a9563d 100644
--- a/config_src/solo_driver/coupler_util.F90
+++ b/config_src/solo_driver/coupler_util.F90
@@ -1,9 +1,9 @@
+!> Provides a couple of interfaces to allow more transparent and
+!! robust extraction of the various fields in the coupler types.
module coupler_util
! This file is part of MOM6. See LICENSE.md for the license.
-! This code provides a couple of interfaces to allow more transparent and
-! robust extraction of the various fields in the coupler types.
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha
use coupler_types_mod, only : ind_csurf
@@ -15,24 +15,19 @@ module coupler_util
contains
+!> Extract an array of values in a coupler bc type
subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, &
is, ie, js, je, conversion)
- type(coupler_2d_bc_type), intent(in) :: BC_struc
- integer, intent(in) :: BC_index, BC_element
- real, dimension(:,:), intent(out) :: array_out
- integer, optional, intent(in) :: is, ie, js, je
- real, optional, intent(in) :: conversion
-! Arguments: BC_struc - The type from which the data is being extracted.
-! (in) BC_index - The boundary condition number being extracted.
-! (in) BC_element - The element of the boundary condition being extracted.
-! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition.
-! (out) array_out - The array being filled with the input values.
-! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled.
-! These must match the size of the corresponding value array or an
-! error message is issued.
-! (in, opt) conversion - A number that every element is multiplied by, to
-! permit sign convention or unit conversion.
-
+ type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted.
+ integer, intent(in) :: BC_index !< The boundary condition number being extracted.
+ integer, intent(in) :: BC_element !< The element of the boundary condition being extracted.
+ real, dimension(:,:), intent(out) :: array_out !< The array being filled with the input values.
+ integer, optional, intent(in) :: is !< Start i-index
+ integer, optional, intent(in) :: ie !< End i-index
+ integer, optional, intent(in) :: js !< Start j-index
+ integer, optional, intent(in) :: je !< End j-index
+ real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to
+ ! Local variables
real, pointer, dimension(:,:) :: Array_in
real :: conv
integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset
@@ -78,24 +73,20 @@ subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, &
end subroutine extract_coupler_values
+!> Set an array of values in a coupler bc type
subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, &
is, ie, js, je, conversion)
- real, dimension(:,:), intent(in) :: array_in
- type(coupler_2d_bc_type), intent(inout) :: BC_struc
- integer, intent(in) :: BC_index, BC_element
- integer, optional, intent(in) :: is, ie, js, je
- real, optional, intent(in) :: conversion
-! Arguments: array_in - The array containing the values to load into the BC.
-! (out) BC_struc - The type into which the data is being loaded.
-! (in) BC_index - The boundary condition number being extracted.
-! (in) BC_element - The element of the boundary condition being extracted.
-! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition.
-! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled.
-! These must match the size of the corresponding value array or an
-! error message is issued.
-! (in, opt) conversion - A number that every element is multiplied by, to
-! permit sign convention or unit conversion.
-
+ real, dimension(:,:), intent(in) :: array_in !< The array containing the values to load into the BC.
+ type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type from which the data is being extracted.
+ integer, intent(in) :: BC_index !< The boundary condition number being extracted.
+ integer, intent(in) :: BC_element !< The element of the boundary condition being extracted.
+ integer, optional, intent(in) :: is !< Start i-index
+ integer, optional, intent(in) :: ie !< End i-index
+ integer, optional, intent(in) :: js !< Start j-index
+ integer, optional, intent(in) :: je !< End j-index
+ real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to
+ !! permit sign convention or unit conversion.
+ ! Local variables
real, pointer, dimension(:,:) :: Array_out
real :: conv
integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset
diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90
index 6a70999d50..7a27c75e18 100644
--- a/config_src/solo_driver/user_surface_forcing.F90
+++ b/config_src/solo_driver/user_surface_forcing.F90
@@ -1,48 +1,8 @@
+!> Template for user to code up surface forcing.
module user_surface_forcing
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* Rewritten by Robert Hallberg, June 2009 *
-!* *
-!* This file contains the subroutines that a user should modify to *
-!* to set the surface wind stresses and fluxes of buoyancy or *
-!* temperature and fresh water. They are called when the run-time *
-!* parameters WIND_CONFIG or BUOY_CONFIG are set to "USER". The *
-!* standard version has simple examples, along with run-time error *
-!* messages that will cause the model to abort if this code has not *
-!* been modified. This code is intended for use with relatively *
-!* simple specifications of the forcing. For more complicated forms, *
-!* it is probably a good idea to read the forcing from input files *
-!* using "file" for WIND_CONFIG and BUOY_CONFIG. *
-!* *
-!* USER_wind_forcing should set the surface wind stresses (taux and *
-!* tauy) perhaps along with the surface friction velocity (ustar). *
-!* *
-!* USER_buoyancy forcing is used to set the surface buoyancy *
-!* forcing, which may include a number of fresh water flux fields *
-!* (evap, lprec, fprec, lrunoff, frunoff, and *
-!* vprec) and the surface heat fluxes (sw, lw, latent and sens) *
-!* if temperature and salinity are state variables, or it may simply *
-!* be the buoyancy flux if it is not. This routine also has coded a *
-!* restoring to surface values of temperature and salinity. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v, tauy *
-!* j x ^ x ^ x At >: u, taux *
-!* j > o > o > At o: h, fluxes. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
use MOM_diag_mediator, only : post_data, query_averaging_enabled
use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr
use MOM_domains, only : pass_var, pass_vector, AGRID
@@ -52,7 +12,7 @@ module user_surface_forcing
use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing
use MOM_grid, only : ocean_grid_type
use MOM_io, only : file_exists, read_data
-use MOM_time_manager, only : time_type, operator(+), operator(/), get_time
+use MOM_time_manager, only : time_type, operator(+), operator(/)
use MOM_tracer_flow_control, only : call_tracer_set_forcing
use MOM_tracer_flow_control, only : tracer_flow_control_CS
use MOM_variables, only : surface
@@ -61,26 +21,25 @@ module user_surface_forcing
public USER_wind_forcing, USER_buoyancy_forcing, USER_surface_forcing_init
+!> This control structure should be used to store any run-time variables
+!! associated with the user-specified forcing.
+!!
+!! It can be readily modified for a specific case, and because it is private there
+!! will be no changes needed in other code (although they will have to be recompiled).
type, public :: user_surface_forcing_CS ; private
- ! This control structure should be used to store any run-time variables
- ! associated with the user-specified forcing. It can be readily modified
- ! for a specific case, and because it is private there will be no changes
- ! needed in other code (although they will have to be recompiled).
! The variables in the cannonical example are used for some common
! cases, but do not need to be used.
- logical :: use_temperature ! If true, temperature and salinity are used as
- ! state variables.
- logical :: restorebuoy ! If true, use restoring surface buoyancy forcing.
- real :: Rho0 ! The density used in the Boussinesq
- ! approximation, in kg m-3.
- real :: G_Earth ! The gravitational acceleration in m s-2.
- real :: Flux_const ! The restoring rate at the surface, in m s-1.
- real :: gust_const ! A constant unresolved background gustiness
- ! that contributes to ustar, in Pa.
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
+ logical :: use_temperature !< If true, temperature and salinity are used as state variables.
+ logical :: restorebuoy !< If true, use restoring surface buoyancy forcing.
+ real :: Rho0 !< The density used in the Boussinesq approximation, in kg m-3.
+ real :: G_Earth !< The gravitational acceleration in m s-2.
+ real :: Flux_const !< The restoring rate at the surface, in m s-1.
+ real :: gust_const !< A constant unresolved background gustiness
+ !! that contributes to ustar, in Pa.
+
+ type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
+ !! timing of diagnostic output.
end type user_surface_forcing_CS
contains
@@ -90,30 +49,15 @@ module user_surface_forcing
!! direction as the u- and v- velocities.) They are both in Pa.
subroutine USER_wind_forcing(sfc_state, forces, day, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
- !! describe the surface state of the ocean.
+ !! describe the surface state of the ocean.
type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces
type(time_type), intent(in) :: day !< The time of the fluxes
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned
!! by a previous call to user_surface_forcing_init
-! This subroutine sets the surface wind stresses, forces%taux and forces%tauy.
-! These are the stresses in the direction of the model grid (i.e. the same
-! direction as the u- and v- velocities.) They are both in Pa.
-! In addition, this subroutine can be used to set the surface friction
-! velocity, forces%ustar, in m s-1. This is needed with a bulk mixed layer.
-!
-! Arguments: state - A structure containing fields that describe the
-! surface state of the ocean.
-! (out) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) day - Time of the fluxes.
-! (in) G - The ocean's grid structure.
-! (in) CS - A pointer to the control structure returned by a previous
-! call to user_surface_forcing_init
-
+ ! Local variables
integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq
- integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
! When modifying the code, comment out this error message. It is here
! so that the original (unmodified) version is not accidentally used.
@@ -122,8 +66,6 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, CS)
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
! Allocate the forcing arrays, if necessary.
call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.)
@@ -179,22 +121,12 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)
! are in W m-2 and positive for heat going into the ocean. All fresh water
! fluxes are in kg m-2 s-1 and positive for water moving into the ocean.
-! Arguments: state - A structure containing fields that describe the
-! surface state of the ocean.
-! (out) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) day_start - Start time of the fluxes.
-! (in) day_interval - Length of time over which these fluxes
-! will be applied.
-! (in) G - The ocean's grid structure.
-! (in) CS - A pointer to the control structure returned by a previous
-! call to user_surface_forcing_init
-
+ ! Local variables
real :: Temp_restore ! The temperature that is being restored toward, in C.
real :: Salin_restore ! The salinity that is being restored toward, in PSU.
real :: density_restore ! The potential density that is being restored
! toward, in kg m-3.
- real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1.
+ real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1.
real :: buoy_rest_const ! A constant relating density anomalies to the
! restoring buoyancy flux, in m5 s-3 kg-1.
@@ -307,14 +239,6 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS)
type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to
!! the control structure for this module
-! Arguments: Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "user_surface_forcing" ! This module's name.
@@ -362,4 +286,28 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS)
end subroutine USER_surface_forcing_init
+!! \namespace user_surface_forcing
+!!
+!! This file contains the subroutines that a user should modify to
+!! to set the surface wind stresses and fluxes of buoyancy or
+!! temperature and fresh water. They are called when the run-time
+!! parameters WIND_CONFIG or BUOY_CONFIG are set to "USER". The
+!! standard version has simple examples, along with run-time error
+!! messages that will cause the model to abort if this code has no
+!! been modified. This code is intended for use with relatively
+!! simple specifications of the forcing. For more complicated forms,
+!! it is probably a good idea to read the forcing from input files
+!! using "file" for WIND_CONFIG and BUOY_CONFIG.
+!!
+!! USER_wind_forcing() should set the surface wind stresses (taux and
+!! tauy) perhaps along with the surface friction velocity (ustar).
+!!
+!! USER_buoyancy() forcing is used to set the surface buoyancy
+!! forcing, which may include a number of fresh water flux fields
+!! (evap, lprec, fprec, lrunoff, frunoff, and
+!! vprec) and the surface heat fluxes (sw, lw, latent and sens)
+!! if temperature and salinity are state variables, or it may simply
+!! be the buoyancy flux if it is not. This routine also has coded a
+!! restoring to surface values of temperature and salinity.
+
end module user_surface_forcing
diff --git a/config_src/unit_drivers/MOM_sum_driver.F90 b/config_src/unit_drivers/MOM_sum_driver.F90
index a5c3c029a6..4778bc2167 100644
--- a/config_src/unit_drivers/MOM_sum_driver.F90
+++ b/config_src/unit_drivers/MOM_sum_driver.F90
@@ -166,17 +166,13 @@ program MOM_main
contains
subroutine benchmark_init_topog_local(D, G, param_file, max_depth)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- real, intent(out), dimension(SZI_(G),SZJ_(G)) :: D
- type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- real, intent(in) :: max_depth
-! Arguments: D - the bottom depth in m. Intent out.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: D !< The ocean bottom depth in m
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ real, intent(in) :: max_depth !< The maximum ocean depth in m
! This subroutine sets up the benchmark test case topography
- real :: min_depth ! The minimum and maximum depths in m.
+ real :: min_depth ! The minimum ocean depth in m.
real :: PI ! 3.1415926... calculated as 4*atan(1)
real :: D0 ! A constant to make the maximum !
! basin depth MAXIMUM_DEPTH. !
diff --git a/docs/Doxyfile_nortd b/docs/Doxyfile_nortd
index 0d34cc4764..e07ce4f0b6 100644
--- a/docs/Doxyfile_nortd
+++ b/docs/Doxyfile_nortd
@@ -1,4 +1,4 @@
-# Doxyfile 1.8.12
+# Doxyfile 1.8.15
# This file describes the settings to be used by the documentation system
# doxygen (www.doxygen.org) for a project.
@@ -17,11 +17,11 @@
# Project related configuration options
#---------------------------------------------------------------------------
-# This tag specifies the encoding used for all characters in the config file
-# that follow. The default is UTF-8 which is also the encoding used for all text
-# before the first occurrence of this tag. Doxygen uses libiconv (or the iconv
-# built into libc) for the transcoding. See http://www.gnu.org/software/libiconv
-# for the list of possible encodings.
+# This tag specifies the encoding used for all characters in the configuration
+# file that follow. The default is UTF-8 which is also the encoding used for all
+# text before the first occurrence of this tag. Doxygen uses libiconv (or the
+# iconv built into libc) for the transcoding. See
+# https://www.gnu.org/software/libiconv/ for the list of possible encodings.
# The default value is: UTF-8.
DOXYFILE_ENCODING = UTF-8
@@ -58,7 +58,7 @@ PROJECT_LOGO =
# entered, it will be relative to the location where doxygen was started. If
# left blank the current directory will be used.
-#OUTPUT_DIRECTORY =
+OUTPUT_DIRECTORY =
# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub-
# directories (in 2 levels) under the output directory of each output format and
@@ -93,6 +93,14 @@ ALLOW_UNICODE_NAMES = NO
OUTPUT_LANGUAGE = English
+# The OUTPUT_TEXT_DIRECTION tag is used to specify the direction in which all
+# documentation generated by doxygen is written. Doxygen will use this
+# information to generate all generated output in the proper direction.
+# Possible values are: None, LTR, RTL and Context.
+# The default value is: None.
+
+OUTPUT_TEXT_DIRECTION = None
+
# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member
# descriptions after the members that are listed in the file and class
# documentation (similar to Javadoc). Set to NO to disable this.
@@ -226,7 +234,8 @@ TAB_SIZE = 2
# will allow you to put the command \sideeffect (or @sideeffect) in the
# documentation, which will result in a user-defined paragraph with heading
# "Side Effects:". You can put \n's in the value part of an alias to insert
-# newlines.
+# newlines (in the resulting output). You can put ^^ in the value part of an
+# alias to insert a newline as if a physical newline was in the original file.
ALIASES =
@@ -327,7 +336,7 @@ BUILTIN_STL_SUPPORT = NO
CPP_CLI_SUPPORT = NO
# Set the SIP_SUPPORT tag to YES if your project consists of sip (see:
-# http://www.riverbankcomputing.co.uk/software/sip/intro) sources only. Doxygen
+# https://www.riverbankcomputing.com/software/sip/intro) sources only. Doxygen
# will parse them like normal C++ but will assume all classes use public instead
# of private inheritance when no explicit protection keyword is present.
# The default value is: NO.
@@ -425,7 +434,7 @@ LOOKUP_CACHE_SIZE = 0
# normally produced when WARNINGS is set to YES.
# The default value is: NO.
-EXTRACT_ALL = YES
+EXTRACT_ALL = NO
# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will
# be included in the documentation.
@@ -698,7 +707,7 @@ LAYOUT_FILE = layout.xml
# The CITE_BIB_FILES tag can be used to specify one or more bib files containing
# the reference definitions. This must be a list of .bib files. The .bib
# extension is automatically appended if omitted. This requires the bibtex tool
-# to be installed. See also http://en.wikipedia.org/wiki/BibTeX for more info.
+# to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info.
# For LaTeX the style of the bibliography can be controlled using
# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the
# search path. See also \cite for info how to create references.
@@ -743,7 +752,8 @@ WARN_IF_DOC_ERROR = YES
# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that
# are documented, but have no documentation for their parameters or return
# value. If set to NO, doxygen will only warn about wrong or incomplete
-# parameter documentation, but not about the absence of documentation.
+# parameter documentation, but not about the absence of documentation. If
+# EXTRACT_ALL is set to YES then this flag will automatically be disabled.
# The default value is: NO.
WARN_NO_PARAMDOC = NO
@@ -777,20 +787,19 @@ WARN_LOGFILE = doxygen.log
# The INPUT tag is used to specify the files and/or directories that contain
# documented source files. You may enter file names like myfile.cpp or
# directories like /usr/src/myproject. Separate the files or directories with
-# spaces.
+# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING
# Note: If this tag is empty the current directory is searched.
INPUT = ../src \
front_page.md \
../config_src/solo_driver \
- ../config_src/dynamic_symmetric \
- ../config_src/coupled_driver/coupler_util.F90 \
+ ../config_src/dynamic_symmetric
../config_src/coupled_driver/ocean_model_MOM.F90
# This tag can be used to specify the character encoding of the source files
# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses
# libiconv (or the iconv built into libc) for the transcoding. See the libiconv
-# documentation (see: http://www.gnu.org/software/libiconv) for the list of
+# documentation (see: https://www.gnu.org/software/libiconv/) for the list of
# possible encodings.
# The default value is: UTF-8.
@@ -807,8 +816,8 @@ INPUT_ENCODING = UTF-8
# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp,
# *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h,
# *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc,
-# *.m, *.markdown, *.md, *.mm, *.dox, *.py, *.pyw, *.f90, *.f, *.for, *.tcl,
-# *.vhd, *.vhdl, *.ucf and *.qsf.
+# *.m, *.markdown, *.md, *.mm, *.dox, *.py, *.pyw, *.f90, *.f95, *.f03, *.f08,
+# *.f, *.for, *.tcl, *.vhd, *.vhdl, *.ucf and *.qsf.
FILE_PATTERNS = *.c \
*.cc \
@@ -860,7 +869,9 @@ EXCLUDE_SYMLINKS = NO
# Note that the wildcards are matched against the file with absolute path, so to
# exclude all test directories for example use the pattern */test/*
-EXCLUDE_PATTERNS = makedep.py Makefile INSTALL
+EXCLUDE_PATTERNS = makedep.py \
+ Makefile \
+ INSTALL
# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names
# (namespaces, classes, functions, etc.) that should be excluded from the
@@ -897,7 +908,8 @@ EXAMPLE_RECURSIVE = NO
# that contain images that are to be included in the documentation (see the
# \image command).
-IMAGE_PATH = images ../src
+IMAGE_PATH = images \
+ ../src
# The INPUT_FILTER tag can be used to specify a program that doxygen should
# invoke to filter for each input file. Doxygen will invoke the filter program
@@ -982,7 +994,7 @@ INLINE_SOURCES = YES
STRIP_CODE_COMMENTS = NO
# If the REFERENCED_BY_RELATION tag is set to YES then for each documented
-# function all documented functions referencing it will be listed.
+# entity all documented functions referencing it will be listed.
# The default value is: NO.
REFERENCED_BY_RELATION = YES
@@ -1014,12 +1026,12 @@ SOURCE_TOOLTIPS = YES
# If the USE_HTAGS tag is set to YES then the references to source code will
# point to the HTML generated by the htags(1) tool instead of doxygen built-in
# source browser. The htags tool is part of GNU's global source tagging system
-# (see http://www.gnu.org/software/global/global.html). You will need version
+# (see https://www.gnu.org/software/global/global.html). You will need version
# 4.8.6 or higher.
#
# To use it do the following:
# - Install the latest version of global
-# - Enable SOURCE_BROWSER and USE_HTAGS in the config file
+# - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file
# - Make sure the INPUT points to the root of the source tree
# - Run doxygen as normal
#
@@ -1159,7 +1171,7 @@ HTML_EXTRA_FILES =
# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen
# will adjust the colors in the style sheet and background images according to
# this color. Hue is specified as an angle on a colorwheel, see
-# http://en.wikipedia.org/wiki/Hue for more information. For instance the value
+# https://en.wikipedia.org/wiki/Hue for more information. For instance the value
# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300
# purple, and 360 is red again.
# Minimum value: 0, maximum value: 359, default value: 220.
@@ -1189,12 +1201,23 @@ HTML_COLORSTYLE_GAMMA = 80
# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML
# page will contain the date and time when the page was generated. Setting this
# to YES can help to show when doxygen was last run and thus if the
-# to NO can help when comparing the output of multiple runs.
-# The default value is: YES.
+# documentation is up to date.
+# The default value is: NO.
# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_TIMESTAMP = NO
+# If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML
+# documentation will contain a main index with vertical navigation menus that
+# are dynamically created via Javascript. If disabled, the navigation index will
+# consists of multiple levels of tabs that are statically embedded in every HTML
+# page. Disable this option to support browsers that do not have Javascript,
+# like the Qt help browser.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_DYNAMIC_MENUS = YES
+
# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML
# documentation will contain sections that can be hidden and shown after the
# page has loaded.
@@ -1218,12 +1241,12 @@ HTML_INDEX_NUM_ENTRIES = 900
# If the GENERATE_DOCSET tag is set to YES, additional index files will be
# generated that can be used as input for Apple's Xcode 3 integrated development
-# environment (see: http://developer.apple.com/tools/xcode/), introduced with
+# environment (see: https://developer.apple.com/tools/xcode/), introduced with
# OSX 10.5 (Leopard). To create a documentation set, doxygen will generate a
# Makefile in the HTML output directory. Running make will produce the docset in
# that directory and running make install will install the docset in
# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at
-# startup. See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html
+# startup. See https://developer.apple.com/tools/creatingdocsetswithdoxygen.html
# for more information.
# The default value is: NO.
# This tag requires that the tag GENERATE_HTML is set to YES.
@@ -1339,7 +1362,7 @@ QCH_FILE =
# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help
# Project output. For more information please see Qt Help Project / Namespace
-# (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#namespace).
+# (see: http://doc.qt.io/qt-4.8/qthelpproject.html#namespace).
# The default value is: org.doxygen.Project.
# This tag requires that the tag GENERATE_QHP is set to YES.
@@ -1347,8 +1370,7 @@ QHP_NAMESPACE = org.doxygen.Project
# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt
# Help Project output. For more information please see Qt Help Project / Virtual
-# Folders (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#virtual-
-# folders).
+# Folders (see: http://doc.qt.io/qt-4.8/qthelpproject.html#virtual-folders).
# The default value is: doc.
# This tag requires that the tag GENERATE_QHP is set to YES.
@@ -1356,23 +1378,21 @@ QHP_VIRTUAL_FOLDER = doc
# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom
# filter to add. For more information please see Qt Help Project / Custom
-# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom-
-# filters).
+# Filters (see: http://doc.qt.io/qt-4.8/qthelpproject.html#custom-filters).
# This tag requires that the tag GENERATE_QHP is set to YES.
QHP_CUST_FILTER_NAME =
# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the
# custom filter to add. For more information please see Qt Help Project / Custom
-# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom-
-# filters).
+# Filters (see: http://doc.qt.io/qt-4.8/qthelpproject.html#custom-filters).
# This tag requires that the tag GENERATE_QHP is set to YES.
QHP_CUST_FILTER_ATTRS =
# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this
# project's filter section matches. Qt Help Project / Filter Attributes (see:
-# http://qt-project.org/doc/qt-4.8/qthelpproject.html#filter-attributes).
+# http://doc.qt.io/qt-4.8/qthelpproject.html#filter-attributes).
# This tag requires that the tag GENERATE_QHP is set to YES.
QHP_SECT_FILTER_ATTRS =
@@ -1465,7 +1485,7 @@ EXT_LINKS_IN_WINDOW = NO
FORMULA_FONTSIZE = 10
-# Use the FORMULA_TRANPARENT tag to determine whether or not the images
+# Use the FORMULA_TRANSPARENT tag to determine whether or not the images
# generated for formulas are transparent PNGs. Transparent PNGs are not
# supported properly for IE 6.0, but are supported on all modern browsers.
#
@@ -1477,7 +1497,7 @@ FORMULA_FONTSIZE = 10
FORMULA_TRANSPARENT = YES
# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see
-# http://www.mathjax.org) which uses client side Javascript for the rendering
+# https://www.mathjax.org) which uses client side Javascript for the rendering
# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX
# installed or if you want to formulas look prettier in the HTML output. When
# enabled you may also need to install MathJax separately and configure the path
@@ -1504,8 +1524,8 @@ MATHJAX_FORMAT = HTML-CSS
# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax
# Content Delivery Network so you can quickly see the result without installing
# MathJax. However, it is strongly recommended to install a local copy of
-# MathJax from http://www.mathjax.org before deployment.
-# The default value is: http://cdn.mathjax.org/mathjax/latest.
+# MathJax from https://www.mathjax.org before deployment.
+# The default value is: https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/.
# This tag requires that the tag USE_MATHJAX is set to YES.
MATHJAX_RELPATH = http://cdn.mathjax.org/mathjax/latest
@@ -1566,7 +1586,7 @@ SERVER_BASED_SEARCH = NO
#
# Doxygen ships with an example indexer (doxyindexer) and search engine
# (doxysearch.cgi) which are based on the open source search engine library
-# Xapian (see: http://xapian.org/).
+# Xapian (see: https://xapian.org/).
#
# See the section "External Indexing and Searching" for details.
# The default value is: NO.
@@ -1579,7 +1599,7 @@ EXTERNAL_SEARCH = NO
#
# Doxygen ships with an example indexer (doxyindexer) and search engine
# (doxysearch.cgi) which are based on the open source search engine library
-# Xapian (see: http://xapian.org/). See the section "External Indexing and
+# Xapian (see: https://xapian.org/). See the section "External Indexing and
# Searching" for details.
# This tag requires that the tag SEARCHENGINE is set to YES.
@@ -1631,10 +1651,11 @@ LATEX_OUTPUT = latex
# The LATEX_CMD_NAME tag can be used to specify the LaTeX command name to be
# invoked.
#
-# Note that when enabling USE_PDFLATEX this option is only used for generating
-# bitmaps for formulas in the HTML output, but not in the Makefile that is
-# written to the output directory.
-# The default file is: latex.
+# Note that when not enabling USE_PDFLATEX the default is latex when enabling
+# USE_PDFLATEX the default is pdflatex and when in the later case latex is
+# chosen this is overwritten by pdflatex. For specific output languages the
+# default can have been set differently, this depends on the implementation of
+# the output language.
# This tag requires that the tag GENERATE_LATEX is set to YES.
LATEX_CMD_NAME = latex
@@ -1766,7 +1787,7 @@ LATEX_SOURCE_CODE = NO
# The LATEX_BIB_STYLE tag can be used to specify the style to use for the
# bibliography, e.g. plainnat, or ieeetr. See
-# http://en.wikipedia.org/wiki/BibTeX and \cite for more info.
+# https://en.wikipedia.org/wiki/BibTeX and \cite for more info.
# The default value is: plain.
# This tag requires that the tag GENERATE_LATEX is set to YES.
@@ -1819,9 +1840,9 @@ COMPACT_RTF = NO
RTF_HYPERLINKS = NO
-# Load stylesheet definitions from file. Syntax is similar to doxygen's config
-# file, i.e. a series of assignments. You only have to provide replacements,
-# missing definitions are set to their default value.
+# Load stylesheet definitions from file. Syntax is similar to doxygen's
+# configuration file, i.e. a series of assignments. You only have to provide
+# replacements, missing definitions are set to their default value.
#
# See also section "Doxygen usage" for information on how to generate the
# default style sheet that doxygen normally uses.
@@ -1830,8 +1851,8 @@ RTF_HYPERLINKS = NO
RTF_STYLESHEET_FILE =
# Set optional variables used in the generation of an RTF document. Syntax is
-# similar to doxygen's config file. A template extensions file can be generated
-# using doxygen -e rtf extensionFile.
+# similar to doxygen's configuration file. A template extensions file can be
+# generated using doxygen -e rtf extensionFile.
# This tag requires that the tag GENERATE_RTF is set to YES.
RTF_EXTENSIONS_FILE =
@@ -1949,9 +1970,9 @@ DOCBOOK_PROGRAMLISTING = NO
#---------------------------------------------------------------------------
# If the GENERATE_AUTOGEN_DEF tag is set to YES, doxygen will generate an
-# AutoGen Definitions (see http://autogen.sf.net) file that captures the
-# structure of the code including all documentation. Note that this feature is
-# still experimental and incomplete at the moment.
+# AutoGen Definitions (see http://autogen.sourceforge.net/) file that captures
+# the structure of the code including all documentation. Note that this feature
+# is still experimental and incomplete at the moment.
# The default value is: NO.
GENERATE_AUTOGEN_DEF = NO
@@ -2033,7 +2054,8 @@ SEARCH_INCLUDES = YES
# preprocessor.
# This tag requires that the tag SEARCH_INCLUDES is set to YES.
-INCLUDE_PATH = ../src/framework ../config_src/dynamic_symmetric
+INCLUDE_PATH = ../src/framework \
+ ../config_src/dynamic_symmetric
# You can use the INCLUDE_FILE_PATTERNS tag to specify one or more wildcard
# patterns (like *.h and *.hpp) to filter out the header-files in the
@@ -2373,6 +2395,11 @@ DIAFILE_DIRS =
PLANTUML_JAR_PATH =
+# When using plantuml, the PLANTUML_CFG_FILE tag can be used to specify a
+# configuration file for plantuml.
+
+PLANTUML_CFG_FILE =
+
# When using plantuml, the specified paths are searched for files specified by
# the !include statement in a plantuml block.
diff --git a/docs/README.md b/docs/README.md
index c861440fa2..aafe349ebc 100644
--- a/docs/README.md
+++ b/docs/README.md
@@ -17,7 +17,7 @@ which will generate html in `docs/_build/html/`. Start at `docs/_build/html/inde
The doxygen generated HTML can be obtained locally (and slightly more quickly) with
```bash
-make nortd
+make nortd SPHINXBUILD=false
```
which will generate html in `docs/APIs/`. Start at `docs/APIs/index.html`. If doxygen is not already available this will install a local copy of doxygen.
diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90
index c56d8a3fc3..192b278a09 100644
--- a/src/ALE/MOM_ALE.F90
+++ b/src/ALE/MOM_ALE.F90
@@ -1,8 +1,10 @@
!> This module contains the main regridding routines.
+!!
!! Regridding comprises two steps:
-!! (1) Interpolation and creation of a new grid based on target interface
-!! densities (or any other criterion).
-!! (2) Remapping of quantities between old grid and new grid.
+!! 1. Interpolation and creation of a new grid based on target interface
+!! densities (or any other criterion).
+!! 2. Remapping of quantities between old grid and new grid.
+!!
!! Original module written by Laurent White, 2008.06.09
module MOM_ALE
@@ -327,7 +329,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h)
if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, tv%T, CS%diag)
if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, tv%S, CS%diag)
if (CS%id_e_preale > 0) then
- call find_eta(h, tv, GV%g_Earth, G, GV, eta_preale)
+ call find_eta(h, tv, G, GV, eta_preale, eta_to_m=1.0)
call post_data(CS%id_e_preale, eta_preale, CS%diag)
endif
@@ -758,14 +760,12 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg,
nz = GV%ke
ppt2mks = 0.001
- if (associated(Reg)) then
- ntr = Reg%ntr
- else
- ntr = 0
- endif
+ ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr
if (present(dt)) then
Idt = 1.0/dt
+ work_conc(:,:,:) = 0.0
+ work_cont(:,:,:) = 0.0
endif
! Remap tracer
@@ -799,22 +799,23 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg,
endif ; enddo ; enddo
! tendency diagnostics.
- if (Tr%id_remap_conc > 0) then
- call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag)
- endif
- if (Tr%id_remap_cont > 0) then
- call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag)
- endif
- if (Tr%id_remap_cont_2d > 0) then
- do j = G%jsc,G%jec ; do i = G%isc,G%iec
- work_2d(i,j) = 0.0
- do k = 1,GV%ke
- work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k)
- enddo
- enddo ; enddo
- call post_data(Tr%id_remap_cont_2d, work_2d, CS_ALE%diag)
+ if (present(dt)) then
+ if (Tr%id_remap_conc > 0) then
+ call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag)
+ endif
+ if (Tr%id_remap_cont > 0) then
+ call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag)
+ endif
+ if (Tr%id_remap_cont_2d > 0) then
+ do j = G%jsc,G%jec ; do i = G%isc,G%iec
+ work_2d(i,j) = 0.0
+ do k = 1,GV%ke
+ work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k)
+ enddo
+ enddo ; enddo
+ call post_data(Tr%id_remap_cont_2d, work_2d, CS_ALE%diag)
+ endif
endif
-
enddo ! m=1,ntr
endif ! endif for ntr > 0
@@ -864,7 +865,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg,
endif
if (CS_ALE%id_vert_remap_h > 0) call post_data(CS_ALE%id_vert_remap_h, h_old, CS_ALE%diag)
- if (CS_ALE%id_vert_remap_h_tendency > 0) then
+ if ((CS_ALE%id_vert_remap_h_tendency > 0) .and. present(dt)) then
do k = 1, nz ; do j = G%jsc,G%jec ; do i = G%isc,G%iec
work_cont(i,j,k) = (h_new(i,j,k) - h_old(i,j,k))*Idt
enddo ; enddo ; enddo
@@ -1163,9 +1164,9 @@ end subroutine ALE_update_regrid_weights
!> Update the vertical grid type with ALE information.
!! This subroutine sets information in the verticalGrid_type to be
!! consistent with the use of ALE mode.
-subroutine ALE_updateVerticalGridType( CS, GV )
- type(ALE_CS), pointer :: CS ! module control structure
- type(verticalGrid_type), pointer :: GV ! vertical grid information
+subroutine ALE_updateVerticalGridType(CS, GV)
+ type(ALE_CS), pointer :: CS !< ALE control structure
+ type(verticalGrid_type), pointer :: GV !< vertical grid information
integer :: nk
@@ -1224,7 +1225,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h )
integer :: i, j, k
do j = G%jsd,G%jed ; do i = G%isd,G%ied
- h(i,j,:) = GV%m_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j) )
+ h(i,j,:) = GV%m_to_H * getStaticThickness( CS%regridCS, 0., G%Zd_to_m*G%bathyT(i,j) )
enddo ; enddo
end subroutine ALE_initThicknessToCoord
diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90
index ebe8b93bf6..1e7da482a3 100644
--- a/src/ALE/MOM_regridding.F90
+++ b/src/ALE/MOM_regridding.F90
@@ -51,6 +51,8 @@ module MOM_regridding
!! target_density(k+1) = coordinateResolution(k) + coordinateResolution(k)
!! It is only used in "rho" mode.
real, dimension(:), allocatable :: target_density
+
+ !> A flag to indicate that the target_density arrays has been filled with data.
logical :: target_density_set = .false.
!> This array is set by function set_regrid_max_depths()
@@ -104,12 +106,12 @@ module MOM_regridding
!! If false, integrate from the bottom upward, as does the rest of the model.
logical :: integrate_downward_for_e = .true.
- type(zlike_CS), pointer :: zlike_CS => null()
- type(sigma_CS), pointer :: sigma_CS => null()
- type(rho_CS), pointer :: rho_CS => null()
- type(hycom_CS), pointer :: hycom_CS => null()
- type(slight_CS), pointer :: slight_CS => null()
- type(adapt_CS), pointer :: adapt_CS => null()
+ type(zlike_CS), pointer :: zlike_CS => null() !< Control structure for z-like coordinate generator
+ type(sigma_CS), pointer :: sigma_CS => null() !< Control structure for sigma coordinate generator
+ type(rho_CS), pointer :: rho_CS => null() !< Control structure for rho coordinate generator
+ type(hycom_CS), pointer :: hycom_CS => null() !< Control structure for hybrid coordinate generator
+ type(slight_CS), pointer :: slight_CS => null() !< Control structure for Slight-coordinate generator
+ type(adapt_CS), pointer :: adapt_CS => null() !< Control structure for adaptive coordinate generator
end type
@@ -137,7 +139,7 @@ module MOM_regridding
" SLIGHT - stretched coordinates above continuous isopycnal\n"//&
" ADAPTIVE - optimize for smooth neutral density surfaces"
-! Documentation for regridding interpolation schemes
+!> Documentation for regridding interpolation schemes
character(len=*), parameter, public :: regriddingInterpSchemeDoc = &
" P1M_H2 (2nd-order accurate)\n"//&
" P1M_H4 (2nd-order accurate)\n"//&
@@ -149,8 +151,12 @@ module MOM_regridding
" P3M_IH6IH5 (4th-order accurate)\n"//&
" PQM_IH4IH3 (4th-order accurate)\n"//&
" PQM_IH6IH5 (5th-order accurate)"
+
+!> Default interpolation scheme
character(len=*), parameter, public :: regriddingDefaultInterpScheme = "P1M_H2"
+!> Default mode for boundary extrapolation
logical, parameter, public :: regriddingDefaultBoundaryExtrapolation = .false.
+!> Default minimum thickness for some coordinate generation modes
real, parameter, public :: regriddingDefaultMinThickness = 1.e-3
#undef __DO_SAFETY_CHECKS__
@@ -158,12 +164,12 @@ module MOM_regridding
contains
!> Initialization and configures a regridding control structure based on customizable run-time parameters
-subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, param_prefix, param_suffix)
+subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, param_prefix, param_suffix)
type(regridding_CS), intent(inout) :: CS !< Regridding control structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
real, intent(in) :: max_depth !< The maximum depth of the ocean, in m.
type(param_file_type), intent(in) :: param_file !< Parameter file
- character(len=*), intent(in) :: mod !< Name of calling module.
+ character(len=*), intent(in) :: mdl !< Name of calling module.
character(len=*), intent(in) :: coord_mode !< Coordinate mode
character(len=*), intent(in) :: param_prefix !< String to prefix to parameter names.
!! If empty, causes main model parameters to be used.
@@ -193,12 +199,12 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
250., 375., 500., 500., 500., 500., 500., 500., &
500., 500., 500., 500., 500., 500., 500., 500. /)
- call get_param(param_file, mod, "INPUTDIR", inputdir, default=".")
+ call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
inputdir = slasher(inputdir)
main_parameters=.false.
if (len_trim(param_prefix)==0) main_parameters=.true.
- if (main_parameters .and. len_trim(param_suffix)>0) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// &
+ if (main_parameters .and. len_trim(param_suffix)>0) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// &
'Suffix provided without prefix for parameter names!')
CS%nk = 0
@@ -207,7 +213,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
if (main_parameters) then
! Read coordinate units parameter (main model = REGRIDDING_COORDINATE_UNITS)
- call get_param(param_file, mod, "REGRIDDING_COORDINATE_UNITS", coord_units, &
+ call get_param(param_file, mdl, "REGRIDDING_COORDINATE_UNITS", coord_units, &
"Units of the regridding coordinuate.",&
default=coordinateUnits(coord_mode))
else
@@ -222,7 +228,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
param_name = trim(param_prefix)//"_INTERP_SCHEME_"//trim(param_suffix)
string2 = 'PPM_H4' ! Default for diagnostics
endif
- call get_param(param_file, mod, "INTERPOLATION_SCHEME", string, &
+ call get_param(param_file, mdl, "INTERPOLATION_SCHEME", string, &
"This sets the interpolation scheme to use to\n"//&
"determine the new grid. These parameters are\n"//&
"only relevant when REGRIDDING_COORDINATE_MODE is\n"//&
@@ -233,7 +239,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
endif
if (main_parameters .and. coord_is_state_dependent) then
- call get_param(param_file, mod, "BOUNDARY_EXTRAPOLATION", tmpLogical, &
+ call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION", tmpLogical, &
"When defined, a proper high-order reconstruction\n"//&
"scheme is used within boundary cells rather\n"//&
"than PCM. E.g., if PPM is used for remapping, a\n"//&
@@ -255,7 +261,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
string2 = 'UNIFORM'
if (max_depth>3000.) string2='WOA09' ! For convenience
endif
- call get_param(param_file, mod, param_name, string, &
+ call get_param(param_file, mdl, param_name, string, &
"Determines how to specify the coordinate\n"//&
"resolution. Valid options are:\n"//&
" PARAM - use the vector-parameter "//trim(coord_res_param)//"\n"//&
@@ -285,7 +291,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
ke = extract_integer(string(9:len_trim(string)),'',1)
tmpReal = extract_real(string(9:len_trim(string)),',',2,missing_value=max_depth)
else
- call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// &
+ call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// &
'Unable to interpret "'//trim(string)//'".')
endif
allocate(dz(ke))
@@ -296,13 +302,13 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
GV%Rlay(1)+0.5*(GV%Rlay(1)-GV%Rlay(2)), &
GV%Rlay(ke)+0.5*(GV%Rlay(ke)-GV%Rlay(ke-1)) )
endif
- if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, &
+ if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, &
trim(message), units=trim(coord_units))
elseif (trim(string)=='PARAM') then
! Read coordinate resolution (main model = ALE_RESOLUTION)
ke = GV%ke ! Use model nk by default
allocate(dz(ke))
- call get_param(param_file, mod, coord_res_param, dz, &
+ call get_param(param_file, mdl, coord_res_param, dz, &
trim(message), units=trim(coord_units), fail_if_missing=.true.)
elseif (index(trim(string),'FILE:')==1) then
! FILE:filename,var_name is assumed to be reading level thickness variables
@@ -314,7 +320,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
! Otherwise assume we should look for the file in INPUTDIR
fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) )
endif
- if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")")
varName = trim( extractWord(trim(string(6:)), 2) )
@@ -322,12 +328,12 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
if (field_exists(fileName,'dz')) then; varName = 'dz'
elseif (field_exists(fileName,'dsigma')) then; varName = 'dsigma'
elseif (field_exists(fileName,'ztest')) then; varName = 'ztest'
- else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"Coordinate variable not specified and none could be guessed.")
endif
endif
! This check fails when the variable is a dimension variable! -AJA
- !if (.not. field_exists(fileName,trim(varName))) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ !if (.not. field_exists(fileName,trim(varName))) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
! "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")")
if (CS%regridding_scheme == REGRIDDING_SIGMA) then
expected_units = 'nondim'
@@ -339,7 +345,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
if (index(trim(varName),'interfaces=')==1) then
varName=trim(varName(12:))
call check_grid_def(filename, varName, expected_units, message, ierr)
- if (ierr) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "//&
+ if (ierr) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "//&
"Unsupported format in grid definition '"//trim(filename)//"'. Error message "//trim(message))
call field_size(trim(fileName), trim(varName), nzf)
ke = nzf(1)-1
@@ -361,15 +367,15 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
call MOM_read_data(trim(fileName), trim(varName), dz)
endif
if (main_parameters .and. ke/=GV%ke) then
- call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// &
+ call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// &
'Mismatch in number of model levels and "'//trim(string)//'".')
endif
- if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, &
+ if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, &
trim(message), units=coordinateUnits(coord_mode))
elseif (index(trim(string),'FNC1:')==1) then
ke = GV%ke; allocate(dz(ke))
call dz_function1( trim(string(6:)), dz )
- if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, &
+ if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, &
trim(message), units=coordinateUnits(coord_mode))
elseif (index(trim(string),'RFNC1:')==1) then
! Function used for set target interface densities
@@ -380,24 +386,24 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
allocate(rho_target(ke+1))
fileName = trim( extractWord(trim(string(8:)), 1) )
if (fileName(1:1)/='.' .and. filename(1:1)/='/') fileName = trim(inputdir) // trim( fileName )
- if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// &
+ if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// &
"Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")")
varName = trim( extractWord(trim(string(8:)), 2) )
- if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// &
+ if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// &
"Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")")
call MOM_read_data(trim(fileName), trim(varName), rho_target)
varName = trim( extractWord(trim(string(8:)), 3) )
if (varName(1:5) == 'FNC1:') then ! Use FNC1 to calculate dz
call dz_function1( trim(string((index(trim(string),'FNC1:')+5):)), dz )
else ! Read dz from file
- if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// &
+ if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// &
"Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")")
call MOM_read_data(trim(fileName), trim(varName), dz)
endif
if (main_parameters) then
- call log_param(param_file, mod, "!"//coord_res_param, dz, &
+ call log_param(param_file, mdl, "!"//coord_res_param, dz, &
trim(message), units=coordinateUnits(coord_mode))
- call log_param(param_file, mod, "!TARGET_DENSITIES", rho_target, &
+ call log_param(param_file, mdl, "!TARGET_DENSITIES", rho_target, &
'HYBRID target densities for itnerfaces', units=coordinateUnits(coord_mode))
endif
elseif (index(trim(string),'WOA09')==1) then
@@ -408,16 +414,16 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
tmpReal = tmpReal + woa09_dz(ke)
enddo
elseif (index(trim(string),'WOA09:')==1) then
- if (len_trim(string)==6) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// &
+ if (len_trim(string)==6) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// &
'Expected string of form "WOA09:N" but got "'//trim(string)//'".')
ke = extract_integer(string(7:len_trim(string)),'',1)
endif
- if (ke>40 .or. ke<1) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// &
+ if (ke>40 .or. ke<1) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// &
'For "WOA05:N" N must 0 0. ) then
dz(ke) = dz(ke) + ( max_depth - tmpReal )
else
- call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"MAXIMUM_DEPTH was too shallow to adjust bottom layer of DZ!"//trim(string))
endif
endif
@@ -460,7 +466,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
! \todo This line looks like it would overwrite the target densities set just above?
elseif (coordinateMode(coord_mode) == REGRIDDING_RHO) then
call set_target_densities_from_GV(GV, CS)
- call log_param(param_file, mod, "!TARGET_DENSITIES", CS%target_density, &
+ call log_param(param_file, mdl, "!TARGET_DENSITIES", CS%target_density, &
'RHO target densities for interfaces', units=coordinateUnits(coord_mode))
endif
@@ -468,7 +474,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
call initCoord(CS, coord_mode)
if (main_parameters .and. coord_is_state_dependent) then
- call get_param(param_file, mod, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, &
+ call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, &
"When interpolating potential density profiles we can add\n"//&
"some artificial compressibility solely to make homogenous\n"//&
"regions appear stratified.", default=0.)
@@ -476,7 +482,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
endif
if (main_parameters) then
- call get_param(param_file, mod, "MIN_THICKNESS", tmpReal, &
+ call get_param(param_file, mdl, "MIN_THICKNESS", tmpReal, &
"When regridding, this is the minimum layer\n"//&
"thickness allowed.", units="m",&
default=regriddingDefaultMinThickness )
@@ -487,21 +493,21 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
if (coordinateMode(coord_mode) == REGRIDDING_SLIGHT) then
! Set SLight-specific regridding parameters.
- call get_param(param_file, mod, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, &
+ call get_param(param_file, mdl, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, &
"The nominal thickness of fixed thickness near-surface\n"//&
"layers with the SLight coordinate.", units="m", default=1.0)
- call get_param(param_file, mod, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, &
+ call get_param(param_file, mdl, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, &
"The number of fixed-depth surface layers with the SLight\n"//&
"coordinate.", units="nondimensional", default=2)
- call get_param(param_file, mod, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, &
+ call get_param(param_file, mdl, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, &
"The thickness of the surface region over which to average\n"//&
"when calculating the density to use to define the interior\n"//&
"with the SLight coordinate.", units="m", default=1.0)
- call get_param(param_file, mod, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, &
+ call get_param(param_file, mdl, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, &
"The number of layers to offset the surface density when\n"//&
"defining where the interior ocean starts with SLight.", &
units="nondimensional", default=2.0)
- call get_param(param_file, mod, "SLIGHT_FIX_HALOCLINES", fix_haloclines, &
+ call get_param(param_file, mdl, "SLIGHT_FIX_HALOCLINES", fix_haloclines, &
"If true, identify regions above the reference pressure\n"//&
"where the reference pressure systematically underestimates\n"//&
"the stratification and use this in the definition of the\n"//&
@@ -512,11 +518,11 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
nlay_ML_to_interior=nlay_sfc_int, fix_haloclines=fix_haloclines)
if (fix_haloclines) then
! Set additional parameters related to SLIGHT_FIX_HALOCLINES.
- call get_param(param_file, mod, "HALOCLINE_FILTER_LENGTH", filt_len, &
+ call get_param(param_file, mdl, "HALOCLINE_FILTER_LENGTH", filt_len, &
"A length scale over which to smooth the temperature and\n"//&
"salinity before identifying erroneously unstable haloclines.", &
units="m", default=2.0)
- call get_param(param_file, mod, "HALOCLINE_STRAT_TOL", strat_tol, &
+ call get_param(param_file, mdl, "HALOCLINE_STRAT_TOL", strat_tol, &
"A tolerance for the ratio of the stratification of the\n"//&
"apparent coordinate stratification to the actual value\n"//&
"that is used to identify erroneously unstable haloclines.\n"//&
@@ -529,20 +535,20 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
endif
if (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then
- call get_param(param_file, mod, "ADAPT_TIME_RATIO", adaptTimeRatio, &
+ call get_param(param_file, mdl, "ADAPT_TIME_RATIO", adaptTimeRatio, &
"Ratio of ALE timestep to grid timescale.", units="s", default=1e-1) !### Should the units be "nondim"?
- call get_param(param_file, mod, "ADAPT_ZOOM_DEPTH", adaptZoom, &
+ call get_param(param_file, mdl, "ADAPT_ZOOM_DEPTH", adaptZoom, &
"Depth of near-surface zooming region.", units="m", default=200.0)
- call get_param(param_file, mod, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, &
+ call get_param(param_file, mdl, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, &
"Coefficient of near-surface zooming diffusivity.", &
units="nondim", default=0.2)
- call get_param(param_file, mod, "ADAPT_BUOY_COEFF", adaptBuoyCoeff, &
+ call get_param(param_file, mdl, "ADAPT_BUOY_COEFF", adaptBuoyCoeff, &
"Coefficient of buoyancy diffusivity.", &
units="nondim", default=0.8)
- call get_param(param_file, mod, "ADAPT_ALPHA", adaptAlpha, &
+ call get_param(param_file, mdl, "ADAPT_ALPHA", adaptAlpha, &
"Scaling on optimization tendency.", &
units="nondim", default=1.0)
- call get_param(param_file, mod, "ADAPT_DO_MIN_DEPTH", tmpLogical, &
+ call get_param(param_file, mdl, "ADAPT_DO_MIN_DEPTH", tmpLogical, &
"If true, make a HyCOM-like mixed layer by preventing interfaces\n"//&
"from being shallower than the depths specified by the regridding coordinate.", &
default=.false.)
@@ -553,7 +559,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
endif
if (main_parameters .and. coord_is_state_dependent) then
- call get_param(param_file, mod, "MAXIMUM_INT_DEPTH_CONFIG", string, &
+ call get_param(param_file, mdl, "MAXIMUM_INT_DEPTH_CONFIG", string, &
"Determines how to specify the maximum interface depths.\n"//&
"Valid options are:\n"//&
" NONE - there are no maximum interface depths\n"//&
@@ -569,7 +575,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
if ( trim(string) == "NONE") then
! Do nothing.
elseif ( trim(string) == "PARAM") then
- call get_param(param_file, mod, "MAXIMUM_INTERFACE_DEPTHS", z_max, &
+ call get_param(param_file, mdl, "MAXIMUM_INTERFACE_DEPTHS", z_max, &
trim(message), units="m", fail_if_missing=.true.)
call set_regrid_max_depths(CS, z_max, GV%m_to_H)
elseif (index(trim(string),'FILE:')==1) then
@@ -580,18 +586,18 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
! Otherwise assume we should look for the file in INPUTDIR
fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) )
endif
- if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")")
do_sum = .false.
varName = trim( extractWord(trim(string(6:)), 2) )
- if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")")
if (len_trim(varName)==0) then
if (field_exists(fileName,'z_max')) then; varName = 'z_max'
elseif (field_exists(fileName,'dz')) then; varName = 'dz' ; do_sum = .true.
elseif (field_exists(fileName,'dz_max')) then; varName = 'dz_max' ; do_sum = .true.
- else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"MAXIMUM_INT_DEPTHS variable not specified and none could be guessed.")
endif
endif
@@ -601,7 +607,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
else
call MOM_read_data(trim(fileName), trim(varName), z_max)
endif
- call log_param(param_file, mod, "!MAXIMUM_INT_DEPTHS", z_max, &
+ call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, &
trim(message), units=coordinateUnits(coord_mode))
call set_regrid_max_depths(CS, z_max, GV%m_to_H)
elseif (index(trim(string),'FNC1:')==1) then
@@ -611,11 +617,11 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
do k=1,nz_fixed_sfc ; dz_max(k) = dz_fixed_sfc ; enddo
endif
z_max(1) = 0.0 ; do K=1,ke ; z_max(K+1) = z_max(K) + dz_max(K) ; enddo
- call log_param(param_file, mod, "!MAXIMUM_INT_DEPTHS", z_max, &
+ call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, &
trim(message), units=coordinateUnits(coord_mode))
call set_regrid_max_depths(CS, z_max, GV%m_to_H)
else
- call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"Unrecognized MAXIMUM_INT_DEPTH_CONFIG "//trim(string))
endif
deallocate(z_max)
@@ -623,7 +629,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
! Optionally specify maximum thicknesses for each layer, enforced by moving
! the interface below a layer downward.
- call get_param(param_file, mod, "MAX_LAYER_THICKNESS_CONFIG", string, &
+ call get_param(param_file, mdl, "MAX_LAYER_THICKNESS_CONFIG", string, &
"Determines how to specify the maximum layer thicknesses.\n"//&
"Valid options are:\n"//&
" NONE - there are no maximum layer thicknesses\n"//&
@@ -638,7 +644,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
if ( trim(string) == "NONE") then
! Do nothing.
elseif ( trim(string) == "PARAM") then
- call get_param(param_file, mod, "MAX_LAYER_THICKNESS", h_max, &
+ call get_param(param_file, mdl, "MAX_LAYER_THICKNESS", h_max, &
trim(message), units="m", fail_if_missing=.true.)
call set_regrid_max_thickness(CS, h_max, GV%m_to_H)
elseif (index(trim(string),'FILE:')==1) then
@@ -649,30 +655,30 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode,
! Otherwise assume we should look for the file in INPUTDIR
fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) )
endif
- if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")")
varName = trim( extractWord(trim(string(6:)), 2) )
- if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")")
if (len_trim(varName)==0) then
if (field_exists(fileName,'h_max')) then; varName = 'h_max'
elseif (field_exists(fileName,'dz_max')) then; varName = 'dz_max'
- else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"MAXIMUM_INT_DEPTHS variable not specified and none could be guessed.")
endif
endif
call MOM_read_data(trim(fileName), trim(varName), h_max)
- call log_param(param_file, mod, "!MAX_LAYER_THICKNESS", h_max, &
+ call log_param(param_file, mdl, "!MAX_LAYER_THICKNESS", h_max, &
trim(message), units=coordinateUnits(coord_mode))
call set_regrid_max_thickness(CS, h_max, GV%m_to_H)
elseif (index(trim(string),'FNC1:')==1) then
call dz_function1( trim(string(6:)), h_max )
- call log_param(param_file, mod, "!MAX_LAYER_THICKNESS", h_max, &
+ call log_param(param_file, mdl, "!MAX_LAYER_THICKNESS", h_max, &
trim(message), units=coordinateUnits(coord_mode))
call set_regrid_max_thickness(CS, h_max, GV%m_to_H)
else
- call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// &
+ call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// &
"Unrecognized MAX_LAYER_THICKNESS_CONFIG "//trim(string))
endif
deallocate(h_max)
@@ -898,7 +904,7 @@ subroutine check_remapping_grid( G, GV, h, dzInterface, msg )
!$OMP parallel do default(shared)
do j = G%jsc-1,G%jec+1
do i = G%isc-1,G%iec+1
- if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg )
+ if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, G%Zd_to_m*G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg )
enddo
enddo
@@ -1141,7 +1147,7 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h)
endif
! Local depth (G%bathyT is positive)
- nominalDepth = G%bathyT(i,j)*GV%m_to_H
+ nominalDepth = G%bathyT(i,j)*GV%Z_to_H
! Determine water column thickness
totalThickness = 0.0
@@ -1230,7 +1236,7 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface )
endif
! The rest of the model defines grids integrating up from the bottom
- nominalDepth = G%bathyT(i,j)*GV%m_to_H
+ nominalDepth = G%bathyT(i,j)*GV%Z_to_H
! Determine water column height
totalThickness = 0.0
@@ -1334,7 +1340,7 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS )
! Local depth (G%bathyT is positive)
- nominalDepth = G%bathyT(i,j)*GV%m_to_H
+ nominalDepth = G%bathyT(i,j)*GV%Z_to_H
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, &
@@ -1439,7 +1445,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS )
do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1
if (G%mask2dT(i,j)>0.) then
- depth = G%bathyT(i,j) * GV%m_to_H
+ depth = G%bathyT(i,j) * GV%Z_to_H
z_col(1) = 0. ! Work downward rather than bottom up
do K = 1, GV%ke
@@ -1570,7 +1576,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS)
do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1
if (G%mask2dT(i,j)>0.) then
- depth = G%bathyT(i,j) * GV%m_to_H
+ depth = G%bathyT(i,j) * GV%Z_to_H
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) ! Work in units of h (m or Pa)
@@ -1671,7 +1677,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS )
! Arguments
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
- real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original ayer thicknesses, in H
+ real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original layer thicknesses, in H
real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth in H
real, intent(inout) :: h_new !< New layer thicknesses, in H
type(regridding_CS), intent(in) :: CS !< Regridding control structure
@@ -1691,14 +1697,14 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS )
nz = GV%ke
- max_depth = G%max_depth
- min_thickness = CS%min_thickness
+ max_depth = G%max_depth*GV%Z_to_H
+ min_thickness = CS%min_thickness !### May need *GV%m_to_H ?
do j = G%jsc-1,G%jec+1
do i = G%isc-1,G%iec+1
! Local depth
- local_depth = G%bathyT(i,j)*GV%m_to_H
+ local_depth = G%bathyT(i,j)*GV%Z_to_H
! Determine water column height
total_height = 0.0
@@ -1992,7 +1998,7 @@ subroutine set_regrid_max_depths( CS, max_depths, units_to_H )
if (.not.allocated(CS%max_interface_depths)) allocate(CS%max_interface_depths(1:CS%nk+1))
- val_to_H = 1.0 ; if (present( units_to_H)) val_to_H = units_to_H
+ val_to_H = 1.0 ; if (present(units_to_H)) val_to_H = units_to_H
if (max_depths(CS%nk+1) < max_depths(1)) val_to_H = -1.0*val_to_H
! Check for sign reversals in the depths.
diff --git a/src/ALE/P1M_functions.F90 b/src/ALE/P1M_functions.F90
index 75490bee9f..0a0d842581 100644
--- a/src/ALE/P1M_functions.F90
+++ b/src/ALE/P1M_functions.F90
@@ -1,61 +1,30 @@
+!> Linear interpolation functions
module P1M_functions
! This file is part of MOM6. See LICENSE.md for the license.
-!==============================================================================
-!
-! Date of creation: 2008.06.09
-! L. White
-!
-! This module contains p1m (linear) interpolation routines.
-!
-! p1m interpolation is performed by estimating the edge values and
-! linearly interpolating between them.
-
-! Once the edge values are estimated, the limiting process takes care of
-! ensuring that (1) edge values are bounded by neighoring cell averages
-! and (2) discontinuous edge values are averaged in order to provide a
-! fully continuous interpolant throughout the domain. This last step is
-! essential for the regridding problem to yield a unique solution.
-! Also, a routine is provided that takes care of linear extrapolation
-! within the boundary cells.
-!
-! The module contains the following routines:
-!
-! P1M_interpolation (public)
-! P1M_boundary_extrapolation (public)
-!
-!==============================================================================
use regrid_edge_values, only : bound_edge_values, average_discontinuous_edge_values
implicit none ; private
-! -----------------------------------------------------------------------------
! The following routines are visible to the outside world
-! -----------------------------------------------------------------------------
public P1M_interpolation, P1M_boundary_extrapolation
contains
-
-!------------------------------------------------------------------------------
!> Linearly interpolate between edge values
+!!
+!! The resulting piecewise interpolant is stored in 'ppoly'.
+!! See 'ppoly.F90' for a definition of this structure.
+!!
+!! The edge values MUST have been estimated prior to calling this routine.
+!!
+!! The estimated edge values must be limited to ensure monotonicity of the
+!! interpolant. We also make sure that edge values are NOT discontinuous.
+!!
+!! It is assumed that the size of the array 'u' is equal to the number of cells
+!! defining 'grid' and 'ppoly'. No consistency check is performed here.
subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coef, h_neglect )
-! ------------------------------------------------------------------------------
-! Linearly interpolate between edge values.
-! The resulting piecewise interpolant is stored in 'ppoly'.
-! See 'ppoly.F90' for a definition of this structure.
-!
-! The edge values MUST have been estimated prior to calling this routine.
-!
-! The estimated edge values must be limited to ensure monotonicity of the
-! interpolant. We also make sure that edge values are NOT discontinuous.
-!
-! It is assumed that the size of the array 'u' is equal to the number of cells
-! defining 'grid' and 'ppoly'. No consistency check is performed here.
-! ------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
real, dimension(:), intent(in) :: u !< cell average properties (size N)
@@ -66,7 +35,6 @@ subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coef, h_neglect )
!! with the same units as u.
real, optional, intent(in) :: h_neglect !< A negligibly small width
!! in the same units as h.
-
! Local variables
integer :: k ! loop index
real :: u0_l, u0_r ! edge values (left and right)
@@ -91,25 +59,14 @@ subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coef, h_neglect )
end subroutine P1M_interpolation
-
-!------------------------------------------------------------------------------
!> Interpolation by linear polynomials within boundary cells
+!!
+!! The left and right edge values in the left and right boundary cells,
+!! respectively, are estimated using a linear extrapolation within the cells.
+!!
+!! It is assumed that the size of the array 'u' is equal to the number of cells
+!! defining 'grid' and 'ppoly'. No consistency check is performed here.
subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef )
-!------------------------------------------------------------------------------
-! Interpolation by linear polynomials within boundary cells.
-! The left and right edge values in the left and right boundary cells,
-! respectively, are estimated using a linear extrapolation within the cells.
-!
-! N: number of cells in grid
-! h: thicknesses of grid cells
-! u: cell averages to use in constructing piecewise polynomials
-! ppoly_E : edge values of piecewise polynomials
-! ppoly_coef : coefficients of piecewise polynomials
-!
-! It is assumed that the size of the array 'u' is equal to the number of cells
-! defining 'grid' and 'ppoly'. No consistency check is performed here.
-!------------------------------------------------------------------------------
-
! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
@@ -118,7 +75,6 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef )
!! with the same units as u.
real, dimension(:,:), intent(inout) :: ppoly_coef !< coefficients of piecewise polynomials, mainly
!! with the same units as u.
-
! Local variables
real :: u0, u1 ! cell averages
real :: h0, h1 ! corresponding cell widths
@@ -188,4 +144,22 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef )
end subroutine P1M_boundary_extrapolation
+!> \namespace p1m_functions
+!!
+!! Date of creation: 2008.06.09
+!! L. White
+!!
+!! This module contains p1m (linear) interpolation routines.
+!!
+!! p1m interpolation is performed by estimating the edge values and
+!! linearly interpolating between them.
+!
+!! Once the edge values are estimated, the limiting process takes care of
+!! ensuring that (1) edge values are bounded by neighoring cell averages
+!! and (2) discontinuous edge values are averaged in order to provide a
+!! fully continuous interpolant throughout the domain. This last step is
+!! essential for the regridding problem to yield a unique solution.
+!! Also, a routine is provided that takes care of linear extrapolation
+!! within the boundary cells.
+
end module P1M_functions
diff --git a/src/ALE/P3M_functions.F90 b/src/ALE/P3M_functions.F90
index 3034d2a8b4..1964cd25dd 100644
--- a/src/ALE/P3M_functions.F90
+++ b/src/ALE/P3M_functions.F90
@@ -1,20 +1,8 @@
+!> Cubic interpolation functions
module P3M_functions
! This file is part of MOM6. See LICENSE.md for the license.
-!==============================================================================
-!
-! Date of creation: 2008.06.09
-! L. White
-!
-! This module contains p3m interpolation routines.
-!
-! p3m interpolation is performed by estimating the edge values and slopes
-! and constructing a cubic polynomial. We then make sure that the edge values
-! are bounded and continuous and we then modify the slopes to get a monotonic
-! cubic curve.
-!
-!==============================================================================
use regrid_edge_values, only : bound_edge_values, average_discontinuous_edge_values
implicit none ; private
@@ -22,27 +10,23 @@ module P3M_functions
public P3M_interpolation
public P3M_boundary_extrapolation
-real, parameter :: hNeglect_dflt = 1.E-30
-real, parameter :: hNeglect_edge_dflt = 1.E-10
+real, parameter :: hNeglect_dflt = 1.E-30 !< Default value of a negligible cell thickness
+real, parameter :: hNeglect_edge_dflt = 1.E-10 !< Default value of a negligible edge thickness
contains
-!------------------------------------------------------------------------------
-!> Set up a piecewise cubic cubic interpolation from cell averages and estimated
+!> Set up a piecewise cubic interpolation from cell averages and estimated
!! edge slopes and values
+!!
+!! Cubic interpolation between edges.
+!!
+!! The edge values and slopes MUST have been estimated prior to calling
+!! this routine.
+!!
+!! It is assumed that the size of the array 'u' is equal to the number of cells
+!! defining 'grid' and 'ppoly'. No consistency check is performed here.
subroutine P3M_interpolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, &
h_neglect )
-!------------------------------------------------------------------------------
-! Cubic interpolation between edges.
-!
-! The edge values and slopes MUST have been estimated prior to calling
-! this routine.
-!
-! It is assumed that the size of the array 'u' is equal to the number of cells
-! defining 'grid' and 'ppoly'. No consistency check is performed here.
-!------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
real, dimension(:), intent(in) :: u !< cell averages (size N)
@@ -61,30 +45,24 @@ subroutine P3M_interpolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, &
! This routine could be called directly instead of having to call
! 'P3M_interpolation' first but we do that to provide an homogeneous
! interface.
-
call P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect )
end subroutine P3M_interpolation
-
-!------------------------------------------------------------------------------
!> Adust a piecewise cubic reconstruction with a limiter that adjusts the edge
!! values and slopes
+!!
+!! The p3m limiter operates as follows:
+!!
+!! 1. Edge values are bounded
+!! 2. Discontinuous edge values are systematically averaged
+!! 3. Loop on cells and do the following
+!! a. Build cubic curve
+!! b. Check if cubic curve is monotonic
+!! c. If not, monotonize cubic curve and rebuild it
+!!
+!! Step 3 of the monotonization process leaves all edge values unchanged.
subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect )
-!------------------------------------------------------------------------------
-! The p3m limiter operates as follows:
-!
-! (1) Edge values are bounded
-! (2) Discontinuous edge values are systematically averaged
-! (3) Loop on cells and do the following
-! (a) Build cubic curve
-! (b) Check if cubic curve is monotonic
-! (c) If not, monotonize cubic curve and rebuild it
-!
-! Step (3) of the monotonization process leaves all edge values unchanged.
-!------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
real, dimension(:), intent(in) :: u !< cell averages (size N)
@@ -96,7 +74,6 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect )
real, optional, intent(in) :: h_neglect !< A negligibly small width for
!! the purpose of cell reconstructions
!! in the same units as h.
-
! Local variables
integer :: k ! loop index
integer :: monotonic ! boolean indicating whether the cubic is monotonic
@@ -211,25 +188,21 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect )
end subroutine P3M_limiter
-!------------------------------------------------------------------------------
-!> calculate the edge values and slopes at boundary cells as part of building a
-!! piecewise peicewise cubic sub-grid scale profiles
+!> Calculate the edge values and slopes at boundary cells as part of building a
+!! piecewise cubic sub-grid scale profiles
+!!
+!! The following explanations apply to the left boundary cell. The same
+!! reasoning holds for the right boundary cell.
+!!
+!! A cubic needs to be built in the cell and requires four degrees of freedom,
+!! which are the edge values and slopes. The right edge values and slopes are
+!! taken to be that of the neighboring cell (i.e., the left edge value and slope
+!! of the neighboring cell). The left edge value and slope are determined by
+!! computing the parabola based on the cell average and the right edge value
+!! and slope. The resulting cubic is not necessarily monotonic and the slopes
+!! are subsequently modified to yield a monotonic cubic.
subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, &
h_neglect, h_neglect_edge )
-!------------------------------------------------------------------------------
-! The following explanations apply to the left boundary cell. The same
-! reasoning holds for the right boundary cell.
-!
-! A cubic needs to be built in the cell and requires four degrees of freedom,
-! which are the edge values and slopes. The right edge values and slopes are
-! taken to be that of the neighboring cell (i.e., the left edge value and slope
-! of the neighboring cell). The left edge value and slope are determined by
-! computing the parabola based on the cell average and the right edge value
-! and slope. The resulting cubic is not necessarily monotonic and the slopes
-! are subsequently modified to yield a monotonic cubic.
-!------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
real, dimension(:), intent(in) :: u !< cell averages (size N)
@@ -245,7 +218,6 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, &
real, optional, intent(in) :: h_neglect_edge !< A negligibly small width
!! for the purpose of finding edge values
!! in the same units as h.
-
! Local variables
integer :: i0, i1
integer :: monotonic
@@ -381,17 +353,13 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, &
end subroutine P3M_boundary_extrapolation
-!------------------------------------------------------------------------------
!> Build cubic interpolant in cell k
+!!
+!! Given edge values and edge slopes, compute coefficients of cubic in cell k.
+!!
+!! NOTE: edge values and slopes MUST have been properly calculated prior to
+!! calling this routine.
subroutine build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef )
-!------------------------------------------------------------------------------
-! Given edge values and edge slopes, compute coefficients of cubic in cell k.
-!
-! NOTE: edge values and slopes MUST have been properly calculated prior to
-! calling this routine.
-!------------------------------------------------------------------------------
-
- ! Arguments
real, dimension(:), intent(in) :: h !< cell widths (size N)
integer, intent(in) :: k !< The index of the cell to work on
real, dimension(:,:), intent(in) :: ppoly_E !< Edge value of polynomial,
@@ -400,7 +368,6 @@ subroutine build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef )
!! in the units of u over the units of h.
real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, mainly
!! with the same units as u.
-
! Local variables
real :: u0_l, u0_r ! edge values
real :: u1_l, u1_r ! edge slopes
@@ -428,22 +395,17 @@ subroutine build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef )
end subroutine build_cubic_interpolant
-!------------------------------------------------------------------------------
!> Check whether the cubic reconstruction in cell k is monotonic
+!!
+!! This function checks whether the cubic curve in cell k is monotonic.
+!! If so, returns 1. Otherwise, returns 0.
+!!
+!! The cubic is monotonic if the first derivative is single-signed in [0,1].
+!! Hence, we check whether the roots (if any) lie inside this interval. If there
+!! is no root or if both roots lie outside this interval, the cubic is monotonic.
integer function is_cubic_monotonic( ppoly_coef, k )
-!------------------------------------------------------------------------------
-! This function checks whether the cubic curve in cell k is monotonic.
-! If so, returns 1. Otherwise, returns 0.
-!
-! The cubic is monotonic if the first derivative is single-signed in [0,1].
-! Hence, we check whether the roots (if any) lie inside this interval. If there
-! is no root or if both roots lie outside this interval, the cubic is monotnic.
-!------------------------------------------------------------------------------
-
- ! Arguments
real, dimension(:,:), intent(in) :: ppoly_coef !< Coefficients of cubic polynomial
integer, intent(in) :: k !< The index of the cell to work on
-
! Local variables
integer :: monotonic ! boolean indicating if monotonic or not
real :: a0, a1, a2, a3 ! cubic coefficients
@@ -497,39 +459,34 @@ integer function is_cubic_monotonic( ppoly_coef, k )
end function is_cubic_monotonic
-
-!------------------------------------------------------------------------------
!> Monotonize a cubic curve by modifying the edge slopes.
-subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r )
-!------------------------------------------------------------------------------
-! This routine takes care of monotonizing a cubic on [0,1] by modifying the
-! edge slopes. The edge values are NOT modified. The cubic is entirely
-! determined by the four degrees of freedom u0_l, u0_r, u1_l and u1_r.
-!
-! u1_l and u1_r are the edge slopes expressed in the GLOBAL coordinate system.
-!
-! The monotonization occurs as follows.
-
-! 1. The edge slopes are set to 0 if they are inconsistent with the limited
-! PLM slope
-! 2. We check whether we can find an inflexion point in [0,1]. At most one
-! inflexion point may exist.
-! (a) If there is no inflexion point, the cubic is monotonic.
-! (b) If there is one inflexion point and it lies outside [0,1], the
-! cubic is monotonic.
-! (c) If there is one inflexion point and it lies in [0,1] and the slope
-! at the location of the inflexion point is consistent, the cubic
-! is monotonic.
-! (d) If the inflexion point lies in [0,1] but the slope is inconsistent,
-! we go to (3) to shift the location of the inflexion point to the left
-! or to the right. To the left when the 2nd-order left slope is smaller
-! than the 2nd order right slope.
-! 3. Edge slopes are modified to shift the inflexion point, either onto the left
-! edge or onto the right edge.
+!!
+!! This routine takes care of monotonizing a cubic on [0,1] by modifying the
+!! edge slopes. The edge values are NOT modified. The cubic is entirely
+!! determined by the four degrees of freedom u0_l, u0_r, u1_l and u1_r.
+!!
+!! u1_l and u1_r are the edge slopes expressed in the GLOBAL coordinate system.
+!!
+!! The monotonization occurs as follows.
!
-!------------------------------------------------------------------------------
+!! 1. The edge slopes are set to 0 if they are inconsistent with the limited
+!! PLM slope
+!! 2. We check whether we can find an inflexion point in [0,1]. At most one
+!! inflexion point may exist.
+!! a. If there is no inflexion point, the cubic is monotonic.
+!! b. If there is one inflexion point and it lies outside [0,1], the
+!! cubic is monotonic.
+!! c. If there is one inflexion point and it lies in [0,1] and the slope
+!! at the location of the inflexion point is consistent, the cubic
+!! is monotonic.
+!! d. If the inflexion point lies in [0,1] but the slope is inconsistent,
+!! we go to (3) to shift the location of the inflexion point to the left
+!! or to the right. To the left when the 2nd-order left slope is smaller
+!! than the 2nd order right slope.
+!! 3. Edge slopes are modified to shift the inflexion point, either onto the left
+!! edge or onto the right edge.
- ! Arguments
+subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r )
real, intent(in) :: h !< cell width
real, intent(in) :: u0_l !< left edge value
real, intent(in) :: u0_r !< right edge value
@@ -538,7 +495,6 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r
real, intent(in) :: slope !< limited PLM slope
real, intent(inout) :: u1_l !< left edge slopes
real, intent(inout) :: u1_r !< right edge slopes
-
! Local variables
integer :: found_ip
integer :: inflexion_l ! bool telling if inflex. pt must be on left
@@ -677,4 +633,16 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r
end subroutine monotonize_cubic
+!> \namespace p3m_functions
+!!
+!! Date of creation: 2008.06.09
+!! L. White
+!!
+!! This module contains p3m interpolation routines.
+!!
+!! p3m interpolation is performed by estimating the edge values and slopes
+!! and constructing a cubic polynomial. We then make sure that the edge values
+!! are bounded and continuous and we then modify the slopes to get a monotonic
+!! cubic curve.
+
end module P3M_functions
diff --git a/src/ALE/PCM_functions.F90 b/src/ALE/PCM_functions.F90
index 6d407b0cc5..135f53a8a1 100644
--- a/src/ALE/PCM_functions.F90
+++ b/src/ALE/PCM_functions.F90
@@ -1,44 +1,21 @@
+!> Piecewise constant reconstruction functions
module PCM_functions
! This file is part of MOM6. See LICENSE.md for the license.
-!==============================================================================
-!
-! Date of creation: 2008.06.06
-! L. White
-!
-! This module contains routines that handle one-dimensionnal finite volume
-! reconstruction using the piecewise constant method (PCM).
-!
-!==============================================================================
-
implicit none ; private
public PCM_reconstruction
contains
-!------------------------------------------------------------------------------
!> Reconstruction by constant polynomials within each cell. There is nothing to
!! do but this routine is provided to ensure a homogeneous interface
!! throughout the regridding toolbox.
+!!
+!! It is assumed that the dimension of 'u' is equal to the number of cells
+!! defining 'grid' and 'ppoly'. No consistency check is performed.
subroutine PCM_reconstruction( N, u, ppoly_E, ppoly_coef )
-!------------------------------------------------------------------------------
-! Reconstruction by constant polynomials within each cell. There is nothing to
-! do but this routine is provided to ensure a homogeneous interface
-! throughout the regridding toolbox.
-!
-! N: number of cells in grid
-! h: thicknesses of grid cells
-! u: cell averages to use in constructing piecewise polynomials
-! ppoly_E : edge values of piecewise polynomials
-! ppoly_coef : coefficients of piecewise polynomials
-!
-! It is assumed that the dimension of 'u' is equal to the number of cells
-! defining 'grid' and 'ppoly'. No consistency check is performed.
-!------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: u !< cell averages
real, dimension(:,:), intent(inout) :: ppoly_E !< Edge value of polynomial,
@@ -60,4 +37,12 @@ subroutine PCM_reconstruction( N, u, ppoly_E, ppoly_coef )
end subroutine PCM_reconstruction
+!> \namespace PCM_functions
+!!
+!! Date of creation: 2008.06.06
+!! L. White
+!!
+!! This module contains routines that handle one-dimensionnal finite volume
+!! reconstruction using the piecewise constant method (PCM).
+
end module PCM_functions
diff --git a/src/ALE/PLM_functions.F90 b/src/ALE/PLM_functions.F90
index 12cd558e60..ed82ad1e0b 100644
--- a/src/ALE/PLM_functions.F90
+++ b/src/ALE/PLM_functions.F90
@@ -1,42 +1,21 @@
+!> Piecewise linear reconstruction functions
module PLM_functions
! This file is part of MOM6. See LICENSE.md for the license.
-!==============================================================================
-!
-! Date of creation: 2008.06.06
-! L. White
-!
-! This module contains routines that handle one-dimensionnal finite volume
-! reconstruction using the piecewise linear method (PLM).
-!
-!==============================================================================
-
implicit none ; private
public PLM_reconstruction, PLM_boundary_extrapolation
-real, parameter :: hNeglect_dflt = 1.E-30
+real, parameter :: hNeglect_dflt = 1.E-30 !< Default negligible cell thickness
contains
-!------------------------------------------------------------------------------
!> Reconstruction by linear polynomials within each cell
+!!
+!! It is assumed that the size of the array 'u' is equal to the number of cells
+!! defining 'grid' and 'ppoly'. No consistency check is performed here.
subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coef, h_neglect )
-!------------------------------------------------------------------------------
-! Reconstruction by linear polynomials within each cell.
-!
-! N: number of cells in grid
-! h: thicknesses of grid cells
-! u: cell averages to use in constructing piecewise polynomials
-! ppoly_E : edge values of piecewise polynomials
-! ppoly_coef : coefficients of piecewise polynomials
-!
-! It is assumed that the size of the array 'u' is equal to the number of cells
-! defining 'grid' and 'ppoly'. No consistency check is performed here.
-!------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
real, dimension(:), intent(in) :: u !< cell averages (size N)
@@ -213,27 +192,17 @@ subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coef, h_neglect )
end subroutine PLM_reconstruction
-!------------------------------------------------------------------------------
!> Reconstruction by linear polynomials within boundary cells
+!!
+!! The left and right edge values in the left and right boundary cells,
+!! respectively, are estimated using a linear extrapolation within the cells.
+!!
+!! This extrapolation is EXACT when the underlying profile is linear.
+!!
+!! It is assumed that the size of the array 'u' is equal to the number of cells
+!! defining 'grid' and 'ppoly'. No consistency check is performed here.
+
subroutine PLM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef, h_neglect )
-!------------------------------------------------------------------------------
-! Reconstruction by linear polynomials within boundary cells.
-! The left and right edge values in the left and right boundary cells,
-! respectively, are estimated using a linear extrapolation within the cells.
-!
-! This extrapolation is EXACT when the underlying profile is linear.
-!
-! N: number of cells in grid
-! h: thicknesses of grid cells
-! u: cell averages to use in constructing piecewise polynomials
-! ppoly_E : edge values of piecewise polynomials
-! ppoly_coef : coefficients of piecewise polynomials
-!
-! It is assumed that the size of the array 'u' is equal to the number of cells
-! defining 'grid' and 'ppoly'. No consistency check is performed here.
-!------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
real, dimension(:), intent(in) :: u !< cell averages (size N)
@@ -299,4 +268,12 @@ subroutine PLM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef, h_neglect )
end subroutine PLM_boundary_extrapolation
+!> \namespace plm_functions
+!!
+!! Date of creation: 2008.06.06
+!! L. White
+!!
+!! This module contains routines that handle one-dimensionnal finite volume
+!! reconstruction using the piecewise linear method (PLM).
+
end module PLM_functions
diff --git a/src/ALE/PQM_functions.F90 b/src/ALE/PQM_functions.F90
index 3a4e517e57..4fed4a0c86 100644
--- a/src/ALE/PQM_functions.F90
+++ b/src/ALE/PQM_functions.F90
@@ -1,41 +1,23 @@
+!> Piecewise quartic reconstruction functions
module PQM_functions
! This file is part of MOM6. See LICENSE.md for the license.
-!==============================================================================
-!
-! Date of creation: 2008.06.06
-! L. White
-!
-! This module contains routines that handle one-dimensionnal finite volume
-! reconstruction using the piecewise quartic method (PQM).
-!
-!==============================================================================
use regrid_edge_values, only : bound_edge_values, check_discontinuous_edge_values
implicit none ; private
public PQM_reconstruction, PQM_boundary_extrapolation, PQM_boundary_extrapolation_v1
-real, parameter :: hNeglect_dflt = 1.E-30
+real, parameter :: hNeglect_dflt = 1.E-30 !< Default negligible cell thickness
contains
-!------------------------------------------------------------------------------
-!> PQM_reconstruction does reconstruction by quartic polynomials within each cell.
+!> Reconstruction by quartic polynomials within each cell.
+!!
+!! It is assumed that the dimension of 'u' is equal to the number of cells
+!! defining 'grid' and 'ppoly'. No consistency check is performed.
subroutine PQM_reconstruction( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect )
-!------------------------------------------------------------------------------
-! Reconstruction by quartic polynomials within each cell.
-!
-! grid: one-dimensional grid (see grid.F90)
-! ppoly: piecewise quartic polynomial to be reconstructed (see ppoly.F90)
-! u: cell averages
-!
-! It is assumed that the dimension of 'u' is equal to the number of cells
-! defining 'grid' and 'ppoly'. No consistency check is performed.
-!------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
real, dimension(:), intent(in) :: u !< cell averages (size N)
@@ -87,22 +69,13 @@ subroutine PQM_reconstruction( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect
end subroutine PQM_reconstruction
-
-!------------------------------------------------------------------------------
!> Limit the piecewise quartic method reconstruction
+!!
+!! Standard PQM limiter (White & Adcroft, JCP 2008).
+!!
+!! It is assumed that the dimension of 'u' is equal to the number of cells
+!! defining 'grid' and 'ppoly'. No consistency check is performed.
subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect )
-!------------------------------------------------------------------------------
-! Standard PQM limiter (White & Adcroft, JCP 2008).
-!
-! grid: one-dimensional grid (see grid.F90)
-! ppoly: piecewise quadratic polynomial to be reconstructed (see ppoly.F90)
-! u: cell averages
-!
-! It is assumed that the dimension of 'u' is equal to the number of cells
-! defining 'grid' and 'ppoly'. No consistency check is performed.
-!------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
real, dimension(:), intent(in) :: u !< cell average properties (size N)
@@ -113,7 +86,6 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect )
real, optional, intent(in) :: h_neglect !< A negligibly small width for
!! the purpose of cell reconstructions
!! in the same units as h
-
! Local variables
integer :: k ! loop index
integer :: inflexion_l
@@ -368,33 +340,22 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect )
end subroutine PQM_limiter
-
-!------------------------------------------------------------------------------
-!> piecewise quartic method boundary extrapolation
+!> Reconstruction by parabolas within boundary cells.
+!!
+!! The following explanations apply to the left boundary cell. The same
+!! reasoning holds for the right boundary cell.
+!!
+!! A parabola needs to be built in the cell and requires three degrees of
+!! freedom, which are the right edge value and slope and the cell average.
+!! The right edge values and slopes are taken to be that of the neighboring
+!! cell (i.e., the left edge value and slope of the neighboring cell).
+!! The resulting parabola is not necessarily monotonic and the traditional
+!! PPM limiter is used to modify one of the edge values in order to yield
+!! a monotonic parabola.
+!!
+!! It is assumed that the size of the array 'u' is equal to the number of cells
+!! defining 'grid' and 'ppoly'. No consistency check is performed here.
subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef )
-!------------------------------------------------------------------------------
-! Reconstruction by parabolas within boundary cells.
-!
-! The following explanations apply to the left boundary cell. The same
-! reasoning holds for the right boundary cell.
-!
-! A parabola needs to be built in the cell and requires three degrees of
-! freedom, which are the right edge value and slope and the cell average.
-! The right edge values and slopes are taken to be that of the neighboring
-! cell (i.e., the left edge value and slope of the neighboring cell).
-! The resulting parabola is not necessarily monotonic and the traditional
-! PPM limiter is used to modify one of the edge values in order to yield
-! a monotonic parabola.
-!
-! grid: one-dimensional grid (properly initialized)
-! ppoly: piecewise linear polynomial to be reconstructed (properly initialized)
-! u: cell averages
-!
-! It is assumed that the size of the array 'u' is equal to the number of cells
-! defining 'grid' and 'ppoly'. No consistency check is performed here.
-!------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
real, dimension(:), intent(in) :: u !< cell averages (size N)
@@ -402,7 +363,6 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef )
!! with the same units as u.
real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, mainly
!! with the same units as u.
-
! Local variables
integer :: i0, i1
real :: u0, u1
@@ -529,32 +489,22 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef )
end subroutine PQM_boundary_extrapolation
-!------------------------------------------------------------------------------
-!> pqm boundary extrapolation using a rational function
+!> Reconstruction by parabolas within boundary cells.
+!!
+!! The following explanations apply to the left boundary cell. The same
+!! reasoning holds for the right boundary cell.
+!!
+!! A parabola needs to be built in the cell and requires three degrees of
+!! freedom, which are the right edge value and slope and the cell average.
+!! The right edge values and slopes are taken to be that of the neighboring
+!! cell (i.e., the left edge value and slope of the neighboring cell).
+!! The resulting parabola is not necessarily monotonic and the traditional
+!! PPM limiter is used to modify one of the edge values in order to yield
+!! a monotonic parabola.
+!!
+!! It is assumed that the size of the array 'u' is equal to the number of cells
+!! defining 'grid' and 'ppoly'. No consistency check is performed here.
subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect )
-!------------------------------------------------------------------------------
-! Reconstruction by parabolas within boundary cells.
-!
-! The following explanations apply to the left boundary cell. The same
-! reasoning holds for the right boundary cell.
-!
-! A parabola needs to be built in the cell and requires three degrees of
-! freedom, which are the right edge value and slope and the cell average.
-! The right edge values and slopes are taken to be that of the neighboring
-! cell (i.e., the left edge value and slope of the neighboring cell).
-! The resulting parabola is not necessarily monotonic and the traditional
-! PPM limiter is used to modify one of the edge values in order to yield
-! a monotonic parabola.
-!
-! grid: one-dimensional grid (properly initialized)
-! ppoly: piecewise linear polynomial to be reconstructed (properly initialized)
-! u: cell averages
-!
-! It is assumed that the size of the array 'u' is equal to the number of cells
-! defining 'grid' and 'ppoly'. No consistency check is performed here.
-!------------------------------------------------------------------------------
-
- ! Arguments
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
real, dimension(:), intent(in) :: u !< cell averages (size N)
@@ -567,7 +517,6 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef,
real, optional, intent(in) :: h_neglect !< A negligibly small width for
!! the purpose of cell reconstructions
!! in the same units as h.
-
! Local variables
integer :: i0, i1
integer :: inflexion_l
@@ -889,4 +838,12 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef,
end subroutine PQM_boundary_extrapolation_v1
+!> \namespace pqm_functions
+!!
+!! Date of creation: 2008.06.06
+!! L. White
+!!
+!! This module contains routines that handle one-dimensionnal finite volume
+!! reconstruction using the piecewise quartic method (PQM).
+
end module PQM_functions
diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90
index b2ae0c6de4..91ba50fab7 100644
--- a/src/ALE/coord_adapt.F90
+++ b/src/ALE/coord_adapt.F90
@@ -12,6 +12,7 @@ module coord_adapt
#include
+!> Control structure for adaptive coordinates (coord_adapt).
type, public :: adapt_CS ; private
!> Number of layers/levels
@@ -77,15 +78,15 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom
type(adapt_CS), pointer :: CS !< The control structure for this module
real, optional, intent(in) :: adaptTimeRatio !< Ratio of optimisation and diffusion timescales
real, optional, intent(in) :: adaptAlpha !< Nondimensional coefficient determining
- !! how much optimisation to apply
+ !! how much optimisation to apply
real, optional, intent(in) :: adaptZoom !< Near-surface zooming depth, in m
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
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
+ !! preventing interfaces from becoming shallower than
+ !! the depths set by coordinateResolution
if (.not. associated(CS)) call MOM_error(FATAL, "set_adapt_params: CS not associated")
@@ -104,7 +105,8 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext)
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables
- integer, intent(in) :: i, j !< The indices of the column to work on
+ integer, intent(in) :: i !< The i-index of the column to work on
+ integer, intent(in) :: j !< The j-index of the column to work on
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt !< Interface heights, in H (m or kg m-2).
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures, in C
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities, in psu
@@ -124,7 +126,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext)
zNext(nz+1) = zInt(i,j,nz+1)
! local depth for scaling diffusivity
- depth = G%bathyT(i,j) * GV%m_to_H
+ depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H
! initialize del2sigma to zero
del2sigma(:) = 0.
diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90
index 84bb9e5518..ff539cb474 100644
--- a/src/ALE/coord_rho.F90
+++ b/src/ALE/coord_rho.F90
@@ -172,27 +172,27 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, &
end subroutine build_rho_column
+!> Iteratively build a rho coordinate column
+!!
+!! The algorithm operates as follows within each column:
+!!
+!! 1. Given T & S within each layer, the layer densities are computed.
+!! 2. Based on these layer densities, a global density profile is reconstructed
+!! (this profile is monotonically increasing and may be discontinuous)
+!! 3. The new grid interfaces are determined based on the target interface
+!! densities.
+!! 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, &
zInterface, h_neglect, h_neglect_edge)
- !< Iteratively build a rho coordinate column
- !!
- !! The algorithm operates as follows within each column:
- !!
- !! 1. Given T & S within each layer, the layer densities are computed.
- !! 2. Based on these layer densities, a global density profile is reconstructed
- !! (this profile is monotonically increasing and may be discontinuous)
- !! 3. The new grid interfaces are determined based on the target interface
- !! densities.
- !! 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.
-
type(rho_CS), intent(in) :: CS !< Regridding control structure
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 (positive in m)
real, dimension(nz), intent(in) :: h !< Layer thicknesses, in m
- real, dimension(nz), intent(in) :: T, S !< T and S for column
+ real, dimension(nz), intent(in) :: T !< T for column
+ real, dimension(nz), intent(in) :: S !< S for column
type(EOS_type), pointer :: eqn_of_state !< Equation of state structure
real, dimension(nz+1), intent(inout) :: zInterface !< Absolute positions of interfaces
real, optional, intent(in) :: h_neglect !< A negligibly small width for the
@@ -201,7 +201,6 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_
real, optional, intent(in) :: h_neglect_edge !< A negligibly small width
!! for the purpose of edge value calculations
!! in the same units as h
-
! Local variables
integer :: k, m
integer :: count_nonzero_layers
diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90
index ba0bdb0326..639ba8c0b5 100644
--- a/src/ALE/coord_slight.F90
+++ b/src/ALE/coord_slight.F90
@@ -173,7 +173,8 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, m_to_H, H_subroundoff,
real, intent(in) :: H_subroundoff !< GV%H_subroundoff
integer, intent(in) :: nz !< Number of levels
real, intent(in) :: depth !< Depth of ocean bottom (positive in m)
- real, dimension(nz), intent(in) :: T_col, S_col !< T and S for column
+ 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, in m
real, dimension(nz), intent(in) :: p_col !< Layer quantities
real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface in H units (m or kg m-2)
@@ -184,7 +185,6 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, m_to_H, H_subroundoff,
real, optional, intent(in) :: h_neglect_edge !< A negligibly small width
!! for the purpose of edge value calculations
!! in the same units as h_col.
-
! Local variables
real, dimension(nz) :: rho_col ! Layer quantities
real, dimension(nz) :: T_f, S_f ! Filtered ayer quantities
diff --git a/src/ALE/polynomial_functions.F90 b/src/ALE/polynomial_functions.F90
index 78c75f53a0..e5c90fe31d 100644
--- a/src/ALE/polynomial_functions.F90
+++ b/src/ALE/polynomial_functions.F90
@@ -1,43 +1,25 @@
+!> Polynomial functions
module polynomial_functions
! This file is part of MOM6. See LICENSE.md for the license.
-!==============================================================================
-!
-! Date of creation: 2008.06.12
-! L. White
-!
-! This module contains routines that handle polynomials.
-!
-!==============================================================================
-
implicit none ; private
public :: evaluation_polynomial, integration_polynomial, first_derivative_polynomial
-! -----------------------------------------------------------------------------
-! This module contains the following routines
-! -----------------------------------------------------------------------------
contains
-! -----------------------------------------------------------------------------
!> Pointwise evaluation of a polynomial at x
+!!
+!! The polynomial is defined by the coefficients contained in the
+!! array of the same name, as follows: C(1) + C(2)x + C(3)x^2 + C(4)x^3 + ...
+!! where C refers to the array 'coeff'.
+!! The number of coefficients is given by ncoef and x
+!! is the coordinate where the polynomial is to be evaluated.
real function evaluation_polynomial( coeff, ncoef, x )
real, dimension(:), intent(in) :: coeff !< The coefficients of the polynomial
integer, intent(in) :: ncoef !< The number of polynomial coefficients
real, intent(in) :: x !< The position at which to evaluate the polynomial
-! -----------------------------------------------------------------------------
-! The polynomial is defined by the coefficients contained in the
-! array of the same name, as follows: C(1) + C(2)x + C(3)x^2 + C(4)x^3 + ...
-! where C refers to the array 'coeff'.
-! The number of coefficients is given by ncoef and x
-! is the coordinate where the polynomial is to be evaluated.
-!
-! The function returns the value of the polynomial at x.
-! -----------------------------------------------------------------------------
-
- ! Arguments
-
! Local variables
integer :: k
real :: f ! value of polynomial at x
@@ -52,20 +34,16 @@ real function evaluation_polynomial( coeff, ncoef, x )
end function evaluation_polynomial
!> Calculates the first derivative of a polynomial evaluated at a point x
+!!
+!! The polynomial is defined by the coefficients contained in the
+!! array of the same name, as follows: C(1) + C(2)x + C(3)x^2 + C(4)x^3 + ...
+!! where C refers to the array 'coeff'.
+!! The number of coefficients is given by ncoef and x
+!! is the coordinate where the polynomial's derivative is to be evaluated.
real function first_derivative_polynomial( coeff, ncoef, x )
real, dimension(:), intent(in) :: coeff !< The coefficients of the polynomial
integer, intent(in) :: ncoef !< The number of polynomial coefficients
real, intent(in) :: x !< The position at which to evaluate the derivative
-! -----------------------------------------------------------------------------
-! The polynomial is defined by the coefficients contained in the
-! array of the same name, as follows: C(1) + C(2)x + C(3)x^2 + C(4)x^3 + ...
-! where C refers to the array 'coeff'.
-! The number of coefficients is given by ncoef and x
-! is the coordinate where the polynomial's derivative is to be evaluated.
-!
-! The function returns the first derivative of the polynomial at x.
-! -----------------------------------------------------------------------------
-
! Local variables
integer :: k
real :: f ! value of polynomial at x
@@ -79,18 +57,14 @@ real function first_derivative_polynomial( coeff, ncoef, x )
end function first_derivative_polynomial
-! -----------------------------------------------------------------------------
!> Exact integration of polynomial of degree npoly
+!!
+!! The array of coefficients (Coeff) must be of size npoly+1.
real function integration_polynomial( xi0, xi1, Coeff, npoly )
real, intent(in) :: xi0 !< The lower bound of the integral
real, intent(in) :: xi1 !< The lower bound of the integral
real, dimension(:), intent(in) :: Coeff !< The coefficients of the polynomial
integer, intent(in) :: npoly !< The degree of the polynomial
-! -----------------------------------------------------------------------------
-! Exact integration of a polynomial of degree npoly over the interval [xi0,xi1].
-! The array of coefficients (Coeff) must be of size npoly+1.
-! -----------------------------------------------------------------------------
-
! Local variables
integer :: k
real :: integral
@@ -125,4 +99,11 @@ real function integration_polynomial( xi0, xi1, Coeff, npoly )
end function integration_polynomial
+!> \namespace polynomial_functions
+!!
+!! Date of creation: 2008.06.12
+!! L. White
+!!
+!! This module contains routines that handle polynomials.
+
end module polynomial_functions
diff --git a/src/ALE/regrid_consts.F90 b/src/ALE/regrid_consts.F90
index cf5623c754..7e8edea344 100644
--- a/src/ALE/regrid_consts.F90
+++ b/src/ALE/regrid_consts.F90
@@ -8,20 +8,19 @@ module regrid_consts
implicit none ; public
-integer, parameter :: REGRIDDING_NUM_TYPES = 2
-
! List of regridding types. These should be consecutive and starting at 1.
! This allows them to be used as array indices.
-integer, parameter :: REGRIDDING_LAYER = 1 !< Layer mode
-integer, parameter :: REGRIDDING_ZSTAR = 2 !< z* coordinates
-integer, parameter :: REGRIDDING_RHO = 3 !< Target interface densities
-integer, parameter :: REGRIDDING_SIGMA = 4 !< Sigma coordinates
-integer, parameter :: REGRIDDING_ARBITRARY = 5 !< Arbitrary coordinates
+integer, parameter :: REGRIDDING_LAYER = 1 !< Layer mode identifier
+integer, parameter :: REGRIDDING_ZSTAR = 2 !< z* coordinates identifier
+integer, parameter :: REGRIDDING_RHO = 3 !< Density coordinates identifier
+integer, parameter :: REGRIDDING_SIGMA = 4 !< Sigma coordinates identifier
+integer, parameter :: REGRIDDING_ARBITRARY = 5 !< Arbitrary coordinates identifier
integer, parameter :: REGRIDDING_HYCOM1 = 6 !< Simple HyCOM coordinates without BBL
-integer, parameter :: REGRIDDING_SLIGHT = 7 !< Stretched coordinates in the
-integer, parameter :: REGRIDDING_SIGMA_SHELF_ZSTAR = 8 !< z* coordinates at the bottom, sigma-near the top
+integer, parameter :: REGRIDDING_SLIGHT = 7 !< Identifier for stretched coordinates in the
!! lightest water, isopycnal below
-integer, parameter :: REGRIDDING_ADAPTIVE = 9
+integer, parameter :: REGRIDDING_SIGMA_SHELF_ZSTAR = 8 !< Identifiered for z* coordinates at the bottom,
+ !! sigma-near the top
+integer, parameter :: REGRIDDING_ADAPTIVE = 9 !< Adaptive coordinate mode identifier
character(len=*), parameter :: REGRIDDING_LAYER_STRING = "LAYER" !< Layer string
character(len=*), parameter :: REGRIDDING_ZSTAR_STRING_OLD = "Z*" !< z* string (legacy name)
@@ -32,26 +31,16 @@ module regrid_consts
character(len=*), parameter :: REGRIDDING_HYCOM1_STRING = "HYCOM1" !< Hycom string
character(len=*), parameter :: REGRIDDING_SLIGHT_STRING = "SLIGHT" !< Hybrid S-rho string
character(len=*), parameter :: REGRIDDING_SIGMA_SHELF_ZSTAR_STRING = "SIGMA_SHELF_ZSTAR" !< Hybrid z*/sigma
-character(len=*), parameter :: REGRIDDING_ADAPTIVE_STRING = "ADAPTIVE"
+character(len=*), parameter :: REGRIDDING_ADAPTIVE_STRING = "ADAPTIVE" !< Adaptive coordinate string
character(len=*), parameter :: DEFAULT_COORDINATE_MODE = REGRIDDING_LAYER_STRING !< Default coordinate mode
-integer, dimension(REGRIDDING_NUM_TYPES), parameter :: vertical_coords = &
- (/ REGRIDDING_LAYER, REGRIDDING_ZSTAR /)
- !(/ REGRIDDING_LAYER, REGRIDDING_ZSTAR, REGRIDDING_RHO, &
- ! REGRIDDING_SIGMA, REGRIDDING_ARBITRARY, &
- ! REGRIDDING_HYCOM1, REGRIDDING_SLIGHT /)
-
-character(len=*), dimension(REGRIDDING_NUM_TYPES), parameter :: vertical_coord_strings = &
- (/ REGRIDDING_LAYER_STRING, REGRIDDING_ZSTAR_STRING /)
- !(/ REGRIDDING_LAYER_STRING, REGRIDDING_ZSTAR_STRING, REGRIDDING_RHO_STRING, &
- ! REGRIDDING_SIGMA_STRING, REGRIDDING_ARBITRARY_STRING, &
- ! REGRIDDING_HYCOM1_STRING, REGRIDDING_SLIGHT_STRING /)
-
+!> Returns a string with the coordinate units associated with the coordinate mode.
interface coordinateUnits
module procedure coordinateUnitsI
module procedure coordinateUnitsS
end interface
+!> Returns true if the coordinate is dependent on the state density, returns false otherwise.
interface state_dependent
module procedure state_dependent_char
module procedure state_dependent_int
diff --git a/src/ALE/regrid_edge_slopes.F90 b/src/ALE/regrid_edge_slopes.F90
index 59d36e3e0e..c22a524683 100644
--- a/src/ALE/regrid_edge_slopes.F90
+++ b/src/ALE/regrid_edge_slopes.F90
@@ -1,36 +1,51 @@
+!> Routines that estimate edge slopes to be used in
+!! high-order reconstruction schemes.
module regrid_edge_slopes
! This file is part of MOM6. See LICENSE.md for the license.
-!==============================================================================
-!
-! Date of creation: 2008.06.09
-! L. White
-!
-! This module contains routines that estimate edge slopes to be used in
-! high-order reconstruction schemes.
-!
-!==============================================================================
use regrid_solvers, only : solve_linear_system, solve_tridiagonal_system
use polynomial_functions, only : evaluation_polynomial
-
implicit none ; private
-! -----------------------------------------------------------------------------
-! The following routines are visible to the outside world
-! -----------------------------------------------------------------------------
public edge_slopes_implicit_h3
public edge_slopes_implicit_h5
-! Specifying a dimensional parameter value, as is done here, is a terrible idea.
-real, parameter :: hNeglect_dflt = 1.E-30
+! Specifying a dimensional parameter value, as is done here, is a terrible idea.
+real, parameter :: hNeglect_dflt = 1.E-30 !< Default negligible cell thickness
contains
-
!------------------------------------------------------------------------------
!> Compute ih4 edge slopes (implicit third order accurate)
+!! in the same units as h.
+!!
+!! Compute edge slopes based on third-order implicit estimates. Note that
+!! the estimates are fourth-order accurate on uniform grids
+!!
+!! Third-order implicit estimates of edge slopes are based on a two-cell
+!! stencil. A tridiagonal system is set up and is based on expressing the
+!! edge slopes in terms of neighboring cell averages. The generic
+!! relationship is
+!!
+!! \f[
+!! \alpha u'_{i-1/2} + u'_{i+1/2} + \beta u'_{i+3/2} =
+!! a \bar{u}_i + b \bar{u}_{i+1}
+!! \f]
+!!
+!! and the stencil looks like this
+!!
+!! i i+1
+!! ..--o------o------o--..
+!! i-1/2 i+1/2 i+3/2
+!!
+!! In this routine, the coefficients \f$\alpha\f$, \f$\beta\f$, a and b are computed,
+!! the tridiagonal system is built, boundary conditions are prescribed and
+!! the system is solved to yield edge-slope estimates.
+!!
+!! There are N+1 unknowns and we are able to write N-1 equations. The
+!! boundary conditions close the system.
subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect )
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
@@ -38,33 +53,6 @@ subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect )
real, dimension(:,:), intent(inout) :: edge_slopes !< Returned edge slopes, with the
!! same units as u divided by the units of h.
real, optional, intent(in) :: h_neglect !< A negligibly small width
- !! in the same units as h.
-! -----------------------------------------------------------------------------
-! Compute edge slopes based on third-order implicit estimates. Note that
-! the estimates are fourth-order accurate on uniform grids
-!
-! Third-order implicit estimates of edge slopes are based on a two-cell
-! stencil. A tridiagonal system is set up and is based on expressing the
-! edge slopes in terms of neighboring cell averages. The generic
-! relationship is
-!
-! \alpha u'_{i-1/2} + u'_{i+1/2} + \beta u'_{i+3/2} =
-! a \bar{u}_i + b \bar{u}_{i+1}
-!
-! and the stencil looks like this
-!
-! i i+1
-! ..--o------o------o--..
-! i-1/2 i+1/2 i+3/2
-!
-! In this routine, the coefficients \alpha, \beta, a and b are computed,
-! the tridiagonal system is built, boundary conditions are prescribed and
-! the system is solved to yield edge-slope estimates.
-!
-! There are N+1 unknowns and we are able to write N-1 equations. The
-! boundary conditions close the system.
-! -----------------------------------------------------------------------------
-
! Local variables
integer :: i, j ! loop indexes
real :: h0, h1 ! cell widths
diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90
index 5fe4700c38..d27d69153c 100644
--- a/src/ALE/regrid_edge_values.F90
+++ b/src/ALE/regrid_edge_values.F90
@@ -1,16 +1,8 @@
+!> Edge value estimation for high-order resconstruction
module regrid_edge_values
! This file is part of MOM6. See LICENSE.md for the license.
-!==============================================================================
-!
-! Date of creation: 2008.06.09
-! L. White
-!
-! This module contains routines that estimate edge values to be used in
-! high-order reconstruction schemes.
-!
-!==============================================================================
use regrid_solvers, only : solve_linear_system, solve_tridiagonal_system
use polynomial_functions, only : evaluation_polynomial
@@ -34,16 +26,24 @@ module regrid_edge_values
! to a small enough values such that the eigenvalues of the matrix can not
! be separated.
! Specifying a dimensional parameter value, as is done here, is a terrible idea.
-real, parameter :: hNeglect_edge_dflt = 1.e-10 ! The default value for cut-off minimum
- ! thickness for sum(h) in edge value inversions
-real, parameter :: hNeglect_dflt = 1.e-30 ! The default value for cut-off minimum
- ! thickness for sum(h) in other calculations
-real, parameter :: hMinFrac = 1.e-5 ! A minimum fraction for min(h)/sum(h)
+real, parameter :: hNeglect_edge_dflt = 1.e-10 !< The default value for cut-off minimum
+ !! thickness for sum(h) in edge value inversions
+real, parameter :: hNeglect_dflt = 1.e-30 !< The default value for cut-off minimum
+ !! thickness for sum(h) in other calculations
+real, parameter :: hMinFrac = 1.e-5 !< A minimum fraction for min(h)/sum(h)
contains
-!------------------------------------------------------------------------------
!> Bound edge values by neighboring cell averages
+!!
+!! In this routine, we loop on all cells to bound their left and right
+!! edge values by the cell averages. That is, the left edge value must lie
+!! between the left cell average and the central cell average. A similar
+!! reasoning applies to the right edge values.
+!!
+!! Both boundary edge values are set equal to the boundary cell averages.
+!! Any extrapolation scheme is applied after this routine has been called.
+!! Therefore, boundary cells are treated as if they were local extrama.
subroutine bound_edge_values( N, h, u, edge_val, h_neglect )
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
@@ -52,17 +52,6 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect )
!! with the same units as u.
real, optional, intent(in) :: h_neglect !< A negligibly small width
!! in the same units as h.
-! ------------------------------------------------------------------------------
-! In this routine, we loop on all cells to bound their left and right
-! edge values by the cell averages. That is, the left edge value must lie
-! between the left cell average and the central cell average. A similar
-! reasoning applies to the right edge values.
-!
-! Both boundary edge values are set equal to the boundary cell averages.
-! Any extrapolation scheme is applied after this routine has been called.
-! Therefore, boundary cells are treated as if they were local extrama.
-! ------------------------------------------------------------------------------
-
! Local variables
integer :: k ! loop index
integer :: k0, k1, k2
@@ -147,18 +136,14 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect )
end subroutine bound_edge_values
-
-!------------------------------------------------------------------------------
!> Replace discontinuous collocated edge values with their average
+!!
+!! For each interior edge, check whether the edge values are discontinuous.
+!! If so, compute the average and replace the edge values by the average.
subroutine average_discontinuous_edge_values( N, edge_val )
integer, intent(in) :: N !< Number of cells
real, dimension(:,:), intent(inout) :: edge_val !< Edge values that may be modified
!! the second index size is 2.
-! ------------------------------------------------------------------------------
-! For each interior edge, check whether the edge values are discontinuous.
-! If so, compute the average and replace the edge values by the average.
-! ------------------------------------------------------------------------------
-
! Local variables
integer :: k ! loop index
real :: u0_minus ! left value at given edge
@@ -184,18 +169,14 @@ subroutine average_discontinuous_edge_values( N, edge_val )
end subroutine average_discontinuous_edge_values
-
-!------------------------------------------------------------------------------
!> Check discontinuous edge values and replace them with their average if not monotonic
+!!
+!! For each interior edge, check whether the edge values are discontinuous.
+!! If so and if they are not monotonic, replace each edge value by their average.
subroutine check_discontinuous_edge_values( N, u, edge_val )
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: u !< cell averages (size N)
real, dimension(:,:), intent(inout) :: edge_val !< Cell edge values with the same units as u.
-! ------------------------------------------------------------------------------
-! For each interior edge, check whether the edge values are discontinuous.
-! If so and if they are not monotonic, replace each edge value by their average.
-! ------------------------------------------------------------------------------
-
! Local variables
integer :: k ! loop index
real :: u0_minus ! left value at given edge
@@ -231,8 +212,19 @@ subroutine check_discontinuous_edge_values( N, u, edge_val )
end subroutine check_discontinuous_edge_values
-!------------------------------------------------------------------------------
!> Compute h2 edge values (explicit second order accurate)
+!! in the same units as h.
+!
+!! Compute edge values based on second-order explicit estimates.
+!! These estimates are based on a straight line spanning two cells and evaluated
+!! at the location of the middle edge. An interpolant spanning cells
+!! k-1 and k is evaluated at edge k-1/2. The estimate for each edge is unique.
+!!
+!! k-1 k
+!! ..--o------o------o--..
+!! k-1/2
+!!
+!! Boundary edge values are set to be equal to the boundary cell averages.
subroutine edge_values_explicit_h2( N, h, u, edge_val, h_neglect )
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
@@ -240,20 +232,6 @@ subroutine edge_values_explicit_h2( N, h, u, edge_val, h_neglect )
real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the
!! same units as u; the second index size is 2.
real, optional, intent(in) :: h_neglect !< A negligibly small width
- !! in the same units as h.
-! ------------------------------------------------------------------------------
-! Compute edge values based on second-order explicit estimates.
-! These estimates are based on a straight line spanning two cells and evaluated
-! at the location of the middle edge. An interpolant spanning cells
-! k-1 and k is evaluated at edge k-1/2. The estimate for each edge is unique.
-!
-! k-1 k
-! ..--o------o------o--..
-! k-1/2
-!
-! Boundary edge values are set to be equal to the boundary cell averages.
-! ------------------------------------------------------------------------------
-
! Local variables
integer :: k ! loop index
real :: h0, h1 ! cell widths
@@ -292,9 +270,25 @@ subroutine edge_values_explicit_h2( N, h, u, edge_val, h_neglect )
end subroutine edge_values_explicit_h2
-
-!------------------------------------------------------------------------------
!> Compute h4 edge values (explicit fourth order accurate)
+!! in the same units as h.
+!!
+!! Compute edge values based on fourth-order explicit estimates.
+!! These estimates are based on a cubic interpolant spanning four cells
+!! and evaluated at the location of the middle edge. An interpolant spanning
+!! cells i-2, i-1, i and i+1 is evaluated at edge i-1/2. The estimate for
+!! each edge is unique.
+!!
+!! i-2 i-1 i i+1
+!! ..--o------o------o------o------o--..
+!! i-1/2
+!!
+!! The first two edge values are estimated by evaluating the first available
+!! cubic interpolant, i.e., the interpolant spanning cells 1, 2, 3 and 4.
+!! Similarly, the last two edge values are estimated by evaluating the last
+!! available interpolant.
+!!
+!! For this fourth-order scheme, at least four cells must exist.
subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect )
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
@@ -302,26 +296,6 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect )
real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the
!! same units as u; the second index size is 2.
real, optional, intent(in) :: h_neglect !< A negligibly small width
- !! in the same units as h.
-! -----------------------------------------------------------------------------
-! Compute edge values based on fourth-order explicit estimates.
-! These estimates are based on a cubic interpolant spanning four cells
-! and evaluated at the location of the middle edge. An interpolant spanning
-! cells i-2, i-1, i and i+1 is evaluated at edge i-1/2. The estimate for
-! each edge is unique.
-!
-! i-2 i-1 i i+1
-! ..--o------o------o------o------o--..
-! i-1/2
-!
-! The first two edge values are estimated by evaluating the first available
-! cubic interpolant, i.e., the interpolant spanning cells 1, 2, 3 and 4.
-! Similarly, the last two edge values are estimated by evaluating the last
-! available interpolant.
-!
-! For this fourth-order scheme, at least four cells must exist.
-! -----------------------------------------------------------------------------
-
! Local variables
integer :: i, j
real :: u0, u1, u2, u3
@@ -475,9 +449,32 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect )
end subroutine edge_values_explicit_h4
-
-!------------------------------------------------------------------------------
!> Compute ih4 edge values (implicit fourth order accurate)
+!! in the same units as h.
+!!
+!! Compute edge values based on fourth-order implicit estimates.
+!!
+!! Fourth-order implicit estimates of edge values are based on a two-cell
+!! stencil. A tridiagonal system is set up and is based on expressing the
+!! edge values in terms of neighboring cell averages. The generic
+!! relationship is
+!!
+!! \f[
+!! \alpha u_{i-1/2} + u_{i+1/2} + \beta u_{i+3/2} = a \bar{u}_i + b \bar{u}_{i+1}
+!! \f]
+!!
+!! and the stencil looks like this
+!!
+!! i i+1
+!! ..--o------o------o--..
+!! i-1/2 i+1/2 i+3/2
+!!
+!! In this routine, the coefficients \f$\alpha\f$, \f$\beta\f$, \f$a\f$ and \f$b\f$ are
+!! computed, the tridiagonal system is built, boundary conditions are prescribed and
+!! the system is solved to yield edge-value estimates.
+!!
+!! There are N+1 unknowns and we are able to write N-1 equations. The
+!! boundary conditions close the system.
subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect )
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
@@ -485,31 +482,6 @@ subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect )
real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the
!! same units as u; the second index size is 2.
real, optional, intent(in) :: h_neglect !< A negligibly small width
- !! in the same units as h.
-! -----------------------------------------------------------------------------
-! Compute edge values based on fourth-order implicit estimates.
-!
-! Fourth-order implicit estimates of edge values are based on a two-cell
-! stencil. A tridiagonal system is set up and is based on expressing the
-! edge values in terms of neighboring cell averages. The generic
-! relationship is
-!
-! \alpha u_{i-1/2} + u_{i+1/2} + \beta u_{i+3/2} = a \bar{u}_i + b \bar{u}_{i+1}
-!
-! and the stencil looks like this
-!
-! i i+1
-! ..--o------o------o--..
-! i-1/2 i+1/2 i+3/2
-!
-! In this routine, the coefficients \alpha, \beta, a and b are computed,
-! the tridiagonal system is built, boundary conditions are prescribed and
-! the system is solved to yield edge-value estimates.
-!
-! There are N+1 unknowns and we are able to write N-1 equations. The
-! boundary conditions close the system.
-! -----------------------------------------------------------------------------
-
! Local variables
integer :: i, j ! loop indexes
real :: h0, h1 ! cell widths
@@ -621,9 +593,41 @@ subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect )
end subroutine edge_values_implicit_h4
-
-!------------------------------------------------------------------------------
!> Compute ih6 edge values (implicit sixth order accurate)
+ !! in the same units as h.
+!!
+!! Sixth-order implicit estimates of edge values are based on a four-cell,
+!! three-edge stencil. A tridiagonal system is set up and is based on
+!! expressing the edge values in terms of neighboring cell averages.
+!!
+!! The generic relationship is
+!!
+!! \f[
+!! \alpha u_{i-1/2} + u_{i+1/2} + \beta u_{i+3/2} =
+!! a \bar{u}_{i-1} + b \bar{u}_i + c \bar{u}_{i+1} + d \bar{u}_{i+2}
+!! \f]
+!!
+!! and the stencil looks like this
+!!
+!! i-1 i i+1 i+2
+!! ..--o------o------o------o------o--..
+!! i-1/2 i+1/2 i+3/2
+!!
+!! In this routine, the coefficients \f$\alpha\f$, \f$\beta\f$, a, b, c and d are
+!! computed, the tridiagonal system is built, boundary conditions are
+!! prescribed and the system is solved to yield edge-value estimates.
+!!
+!! Note that the centered stencil only applies to edges 3 to N-1 (edges are
+!! numbered 1 to n+1), which yields N-3 equations for N+1 unknowns. Two other
+!! equations are written by using a right-biased stencil for edge 2 and a
+!! left-biased stencil for edge N. The prescription of boundary conditions
+!! (using sixth-order polynomials) closes the system.
+!!
+!! CAUTION: For each edge, in order to determine the coefficients of the
+!! implicit expression, a 6x6 linear system is solved. This may
+!! become computationally expensive if regridding is carried out
+!! often. Figuring out closed-form expressions for these coefficients
+!! on nonuniform meshes turned out to be intractable.
subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect )
integer, intent(in) :: N !< Number of cells
real, dimension(:), intent(in) :: h !< cell widths (size N)
@@ -631,40 +635,6 @@ subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect )
real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the
!! same units as u; the second index size is 2.
real, optional, intent(in) :: h_neglect !< A negligibly small width
- !! in the same units as h.
-! -----------------------------------------------------------------------------
-! Sixth-order implicit estimates of edge values are based on a four-cell,
-! three-edge stencil. A tridiagonal system is set up and is based on
-! expressing the edge values in terms of neighboring cell averages.
-!
-! The generic relationship is
-!
-! \alpha u_{i-1/2} + u_{i+1/2} + \beta u_{i+3/2} =
-! a \bar{u}_{i-1} + b \bar{u}_i + c \bar{u}_{i+1} + d \bar{u}_{i+2}
-!
-! and the stencil looks like this
-!
-! i-1 i i+1 i+2
-! ..--o------o------o------o------o--..
-! i-1/2 i+1/2 i+3/2
-!
-! In this routine, the coefficients \alpha, \beta, a, b, c and d are
-! computed, the tridiagonal system is built, boundary conditions are
-! prescribed and the system is solved to yield edge-value estimates.
-!
-! Note that the centered stencil only applies to edges 3 to N-1 (edges are
-! numbered 1 to n+1), which yields N-3 equations for N+1 unknowns. Two other
-! equations are written by using a right-biased stencil for edge 2 and a
-! left-biased stencil for edge N. The prescription of boundary conditions
-! (using sixth-order polynomials) closes the system.
-!
-! CAUTION: For each edge, in order to determine the coefficients of the
-! implicit expression, a 6x6 linear system is solved. This may
-! become computationally expensive if regridding is carried out
-! often. Figuring out closed-form expressions for these coefficients
-! on nonuniform meshes turned out to be intractable.
-! -----------------------------------------------------------------------------
-
! Local variables
integer :: i, j, k ! loop indexes
real :: h0, h1, h2, h3 ! cell widths
@@ -1116,5 +1086,4 @@ subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect )
end subroutine edge_values_implicit_h6
-
end module regrid_edge_values
diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90
index fd445e7318..9bc794a2ef 100644
--- a/src/ALE/regrid_interp.F90
+++ b/src/ALE/regrid_interp.F90
@@ -1,3 +1,4 @@
+!> Vertical interpolation for regridding
module regrid_interp
! This file is part of MOM6. See LICENSE.md for the license.
@@ -18,6 +19,7 @@ module regrid_interp
implicit none ; private
+!> Control structure for regrid_interp module
type, public :: interp_CS_type ; private
!> The following parameter is only relevant when used with the target
@@ -46,9 +48,10 @@ module regrid_interp
integer, parameter :: INTERPOLATION_PQM_IH4IH3 = 8 !< O(h^4)
integer, parameter :: INTERPOLATION_PQM_IH6IH5 = 9 !< O(h^5)
-!> List of interpolant degrees
+!>@{ Interpolant degrees
integer, parameter :: DEGREE_1 = 1, DEGREE_2 = 2, DEGREE_3 = 3, DEGREE_4 = 4
integer, public, parameter :: DEGREE_MAX = 5
+!!@}
!> When the N-R algorithm produces an estimate that lies outside [0,1], the
!! estimate is set to be equal to the boundary location, 0 or 1, plus or minus
@@ -63,8 +66,8 @@ module regrid_interp
contains
-!> Given the set of target values and cell densities, this routine
-!! builds an interpolated profile for the densities within each grid cell.
+!> Builds an interpolated profile for the densities within each grid cell.
+!!
!! It may happen that, given a high-order interpolator, the number of
!! available layers is insufficient (e.g., there are two available layers for
!! a third-order PPM ih4 scheme). In these cases, we resort to the simplest
@@ -85,7 +88,7 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, &
real, optional, intent(in) :: h_neglect_edge !< A negligibly small width
!! for the purpose of edge value calculations
!! in the same units as h0.
-
+ ! Local variables
logical :: extrapolate
! Reset piecewise polynomials
@@ -262,7 +265,6 @@ end subroutine regridding_set_ppolys
!! are determined by finding the corresponding target interface densities.
subroutine interpolate_grid( n0, h0, x0, ppoly0_E, ppoly0_coefs, &
target_values, degree, n1, h1, x1 )
- ! Arguments
integer, intent(in) :: n0 !< Number of points on source grid
real, dimension(:), intent(in) :: h0 !< Thicknesses of source grid cells
real, dimension(:), intent(in) :: x0 !< Source interface positions
@@ -273,7 +275,6 @@ subroutine interpolate_grid( n0, h0, x0, ppoly0_E, ppoly0_coefs, &
integer, intent(in) :: n1 !< Number of points on target grid
real, dimension(:), intent(inout) :: h1 !< Thicknesses of target grid cells
real, dimension(:), intent(inout) :: x1 !< Target interface positions
-
! Local variables
integer :: k ! loop index
real :: t ! current interface target density
@@ -293,6 +294,7 @@ subroutine interpolate_grid( n0, h0, x0, ppoly0_E, ppoly0_coefs, &
end subroutine interpolate_grid
+!> Build a grid by interpolating for target values
subroutine build_and_interpolate_grid(CS, densities, n0, h0, x0, target_values, &
n1, h1, x1, h_neglect, h_neglect_edge)
type(interp_CS_type), intent(in) :: CS !< A control structure for regrid_interp
@@ -337,8 +339,8 @@ end subroutine build_and_interpolate_grid
!!
!! It is assumed that the number of cells defining 'grid' and 'ppoly' are the
!! same.
-function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, &
- target_value, degree ) result ( x_tgt )
+function get_polynomial_coordinate( N, h, x_g, ppoly_E, ppoly_coefs, &
+ target_value, degree ) result ( x_tgt )
! Arguments
integer, intent(in) :: N !< Number of grid cells
real, dimension(:), intent(in) :: h !< Grid cell thicknesses
@@ -347,9 +349,7 @@ function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, &
real, dimension(:,:), intent(in) :: ppoly_coefs !< Coefficients of interpolating polynomials
real, intent(in) :: target_value !< Target value to find position for
integer, intent(in) :: degree !< Degree of the interpolating polynomials
-
real :: x_tgt !< The position of x_g at which target_value is found.
-
! Local variables
integer :: i, k ! loop indices
integer :: k_found ! index of target cell
diff --git a/src/ALE/regrid_solvers.F90 b/src/ALE/regrid_solvers.F90
index 18ef1e5e0b..8ee7ab29b2 100644
--- a/src/ALE/regrid_solvers.F90
+++ b/src/ALE/regrid_solvers.F90
@@ -1,42 +1,26 @@
+!> Solvers of linear systems.
module regrid_solvers
! This file is part of MOM6. See LICENSE.md for the license.
-!==============================================================================
-!
-! Date of creation: 2008.06.12
-! L. White
-!
-! This module contains solvers of linear systems.
-! These routines could (should ?) be replaced later by more efficient ones.
-!
-!
-!==============================================================================
-
use MOM_error_handler, only : MOM_error, FATAL
implicit none ; private
public :: solve_linear_system, solve_tridiagonal_system
-! -----------------------------------------------------------------------------
-! This module contains the following routines
-! -----------------------------------------------------------------------------
contains
-! -----------------------------------------------------------------------------
!> Solve the linear system AX = B by Gaussian elimination
+!!
+!! This routine uses Gauss's algorithm to transform the system's original
+!! matrix into an upper triangular matrix. Back substitution yields the answer.
+!! The matrix A must be square and its size must be that of the vectors B and X.
subroutine solve_linear_system( A, B, X, system_size )
real, dimension(:,:), intent(inout) :: A !< The matrix being inverted
real, dimension(:), intent(inout) :: B !< system right-hand side
real, dimension(:), intent(inout) :: X !< solution vector
integer, intent(in) :: system_size !< The size of the system
-! -----------------------------------------------------------------------------
-! This routine uses Gauss's algorithm to transform the system's original
-! matrix into an upper triangular matrix. Back substitution yields the answer.
-! The matrix A must be square and its size must be that of the vectors B and X.
-! -----------------------------------------------------------------------------
-
! Local variables
integer :: i, j, k
real, parameter :: eps = 0.0 ! Minimum pivot magnitude allowed
@@ -122,9 +106,10 @@ subroutine solve_linear_system( A, B, X, system_size )
end subroutine solve_linear_system
-
-! -----------------------------------------------------------------------------
!> Solve the tridiagonal system AX = B
+!!
+!! This routine uses Thomas's algorithm to solve the tridiagonal system AX = B.
+!! (A is made up of lower, middle and upper diagonals)
subroutine solve_tridiagonal_system( Al, Ad, Au, B, X, system_size )
real, dimension(:), intent(inout) :: Ad !< Maxtix center diagonal
real, dimension(:), intent(inout) :: Al !< Matrix lower diagonal
@@ -132,11 +117,6 @@ subroutine solve_tridiagonal_system( Al, Ad, Au, B, X, system_size )
real, dimension(:), intent(inout) :: B !< system right-hand side
real, dimension(:), intent(inout) :: X !< solution vector
integer, intent(in) :: system_size !< The size of the system
-! -----------------------------------------------------------------------------
-! This routine uses Thomas's algorithm to solve the tridiagonal system AX = B.
-! (A is made up of lower, middle and upper diagonals)
-! -----------------------------------------------------------------------------
-
! Local variables
integer :: k ! Loop index
integer :: N ! system size
@@ -162,4 +142,12 @@ subroutine solve_tridiagonal_system( Al, Ad, Au, B, X, system_size )
end subroutine solve_tridiagonal_system
+!> \namespace regrid_solvers
+!!
+!! Date of creation: 2008.06.12
+!! L. White
+!!
+!! This module contains solvers of linear systems.
+!! These routines could (should ?) be replaced later by more efficient ones.
+
end module regrid_solvers
diff --git a/src/core/MOM.F90 b/src/core/MOM.F90
index bdd1f159cf..1a590bb5b8 100644
--- a/src/core/MOM.F90
+++ b/src/core/MOM.F90
@@ -1,15 +1,16 @@
+!> The central module of the MOM6 ocean model
module MOM
! This file is part of MOM6. See LICENSE.md for the license.
! Infrastructure modules
use MOM_debugging, only : MOM_debugging_init, hchksum, uvchksum
+use MOM_debugging, only : check_redundant
use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum
use MOM_checksum_packages, only : MOM_accel_chksum, MOM_surface_chksum
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT
use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE
-use MOM_coord_initialization, only : MOM_initialize_coord
use MOM_diag_mediator, only : diag_mediator_init, enable_averaging
use MOM_diag_mediator, only : diag_mediator_infrastructure_init
use MOM_diag_mediator, only : diag_set_state_ptrs, diag_update_remap_grids
@@ -26,11 +27,10 @@ module MOM
use MOM_domains, only : To_All, Omit_corners, CGRID_NE, SCALAR_PAIR
use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type
use MOM_domains, only : start_group_pass, complete_group_pass, Omit_Corners
-use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe
+use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery
use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint
use MOM_file_parser, only : read_param, get_param, log_version, param_file_type
-use MOM_fixed_initialization, only : MOM_initialize_fixed
use MOM_forcing_type, only : forcing, mech_forcing
use MOM_forcing_type, only : MOM_forcing_chksum, MOM_mech_forcing_chksum
use MOM_get_input, only : Get_MOM_Input, directories
@@ -40,8 +40,7 @@ module MOM
use MOM_restart, only : register_restart_field, query_initialized, save_restart
use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS
use MOM_spatial_means, only : global_mass_integral
-use MOM_state_initialization, only : MOM_initialize_state
-use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+)
+use MOM_time_manager, only : time_type, real_to_time, time_type_to_real, operator(+)
use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/)
use MOM_time_manager, only : operator(>=), increment_date
use MOM_unit_tests, only : unit_tests
@@ -52,6 +51,7 @@ module MOM
use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile
use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags
use MOM_boundary_update, only : call_OBC_register, OBC_register_end, update_OBC_CS
+use MOM_coord_initialization, only : MOM_initialize_coord
use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS
use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end
use MOM_diabatic_driver, only : legacy_diabatic
@@ -72,10 +72,11 @@ 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
-use MOM_debugging, only : check_redundant
-use MOM_grid, only : ocean_grid_type, set_first_direction
-use MOM_grid, only : MOM_grid_init, MOM_grid_end
+use MOM_dyn_horgrid, only : rescale_dyn_horgrid_bathymetry
+use MOM_EOS, only : EOS_init, calculate_density, calculate_TFreeze
+use MOM_fixed_initialization, only : MOM_initialize_fixed
+use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end
+use MOM_grid, only : set_first_direction, rescale_grid_bathymetry
use MOM_hor_index, only : hor_index_type, hor_index_init
use MOM_interface_heights, only : find_eta
use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init
@@ -91,6 +92,7 @@ module MOM
use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_init
use MOM_set_visc, only : set_visc_register_restarts, set_visc_CS
use MOM_sponge, only : init_sponge_diags, sponge_CS
+use MOM_state_initialization, only : MOM_initialize_state
use MOM_sum_output, only : write_energy, accumulate_net_input
use MOM_sum_output, only : MOM_sum_output_init, sum_output_CS
use MOM_ALE_sponge, only : init_ALE_sponge_diags, ALE_sponge_CS
@@ -112,6 +114,7 @@ module MOM
use MOM_variables, only : thermo_var_ptrs, vertvisc_type
use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state
use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd
+use MOM_verticalGrid, only : fix_restart_scaling
use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units
use MOM_wave_interface, only : wave_parameters_CS, waves_end
use MOM_wave_interface, only : Update_Stokes_Drift
@@ -134,9 +137,9 @@ module MOM
!> A structure with diagnostic IDs of the state variables
type MOM_diag_IDs
- ! 3-d state fields
- integer :: id_u = -1, id_v = -1, id_h = -1
- ! 2-d state field
+ !>@{ 3-d state field diagnostic IDs
+ integer :: id_u = -1, id_v = -1, id_h = -1 !!@}
+ !> 2-d state field diagnotic ID
integer :: id_ssh_inst = -1
end type MOM_diag_IDs
@@ -155,11 +158,13 @@ module MOM
v, & !< meridional velocity (m/s)
vh, & !< vh = v * h * dx at v grid points (m3/s or kg/s)
vhtr !< accumulated meridional thickness fluxes to advect tracers (m3 or kg)
- real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: &
- ssh_rint, & !< A running time integral of the sea surface height, in s m.
- ave_ssh_ibc, & !< time-averaged (over a forcing time step) sea surface height
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint
+ !< A running time integral of the sea surface height, in s m.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc
+ !< time-averaged (over a forcing time step) sea surface height
!! with a correction for the inverse barometer (meter)
- eta_av_bc !< free surface height or column mass time averaged over the last
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_av_bc
+ !< free surface height or column mass time averaged over the last
!! baroclinic dynamics time step (m or kg/m2)
real, dimension(:,:), pointer :: &
Hml => NULL() !< active mixed layer depth, in m
@@ -171,47 +176,39 @@ module MOM
type(ocean_grid_type) :: G !< structure containing metrics and grid info
type(verticalGrid_type), pointer :: &
- GV => NULL() !< structure containing vertical grid info
- type(thermo_var_ptrs) :: tv !< structure containing pointers to available
- !! thermodynamic fields
- real :: t_dyn_rel_adv !< The time of the dynamics relative to tracer
- !! advection and lateral mixing (in seconds), or
- !! equivalently the elapsed time since advectively
- !! updating the tracers. t_dyn_rel_adv is invariably
- !! positive and may span multiple coupling timesteps.
- real :: t_dyn_rel_thermo !< The time of the dynamics relative to diabatic
- !! processes and remapping (in seconds). t_dyn_rel_thermo
- !! can be negative or positive depending on whether
- !! the diabatic processes are applied before or after
- !! the dynamics and may span multiple coupling timesteps.
- real :: t_dyn_rel_diag !< The time of the diagnostics relative to diabatic
- !! processes and remapping (in seconds). t_dyn_rel_diag
- !! is always positive, since the diagnostics must lag.
- integer :: ndyn_per_adv = 0 !< Number of calls to dynamics since the last call to advection
- !! Must be saved if thermo spans coupling?
+ GV => NULL() !< structure containing vertical grid info
+ type(thermo_var_ptrs) :: tv !< structure containing pointers to available thermodynamic fields
+ real :: t_dyn_rel_adv !< The time of the dynamics relative to tracer advection and lateral mixing
+ !! (in seconds), or equivalently the elapsed time since advectively updating the
+ !! tracers. t_dyn_rel_adv is invariably positive and may span multiple coupling timesteps.
+ real :: t_dyn_rel_thermo !< The time of the dynamics relative to diabatic processes and remapping
+ !! (in seconds). t_dyn_rel_thermo can be negative or positive depending on whether
+ !! the diabatic processes are applied before or after the dynamics and may span
+ !! multiple coupling timesteps.
+ real :: t_dyn_rel_diag !< The time of the diagnostics relative to diabatic processes and remapping
+ !! (in seconds). t_dyn_rel_diag is always positive, since the diagnostics must lag.
+ integer :: ndyn_per_adv = 0 !< Number of calls to dynamics since the last call to advection.
+ !### Must be saved if thermo spans coupling?
type(diag_ctrl) :: diag !< structure to regulate diagnostic output timing
type(vertvisc_type) :: visc !< structure containing vertical viscosities,
- !! bottom drag viscosities, and related fields
+ !! bottom drag viscosities, and related fields
type(MEKE_type), pointer :: MEKE => NULL() !< structure containing fields
- !! related to the Mesoscale Eddy Kinetic Energy
-
- logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls
- !! to routines to calculate or apply diapycnal fluxes.
- logical :: use_legacy_diabatic_driver!< If true (default), use the a legacy version of the
- !! diabatic subroutine. This is temporary and is needed
- !! to avoid change in answers.
- logical :: diabatic_first !< If true, apply diabatic and thermodynamic
- !! processes before time stepping the dynamics.
- logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered
- !! isopycnal/stacked shallow water mode. This logical is
- !! set by calling the function useRegridding() from the
- !! MOM_regridding module.
+ !! related to the Mesoscale Eddy Kinetic Energy
+ logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls
+ !! to routines to calculate or apply diapycnal fluxes.
+ logical :: use_legacy_diabatic_driver!< If true (default), use the a legacy version of the diabatic
+ !! subroutine. This is temporary and is needed to avoid change in answers.
+ logical :: diabatic_first !< If true, apply diabatic and thermodynamic processes before time
+ !! stepping the dynamics.
+ logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered
+ !! isopycnal/stacked shallow water mode. This logical is set by calling the
+ !! function useRegridding() from the MOM_regridding module.
logical :: offline_tracer_mode = .false.
- !< If true, step_offline() is called instead of step_MOM().
- !! This is intended for running MOM6 in offline tracer mode
+ !< If true, step_offline() is called instead of step_MOM().
+ !! This is intended for running MOM6 in offline tracer mode
- type(time_type), pointer :: Time !< pointer to ocean clock
+ type(time_type), pointer :: Time !< pointer to the ocean clock
real :: dt !< (baroclinic) dynamics time step (seconds)
real :: dt_therm !< thermodynamics time step (seconds)
logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time
@@ -277,11 +274,15 @@ module MOM
! These elements are used to control the calculation and error checking of the surface state
real :: Hmix !< Diagnostic mixed layer thickness over which to
- !! average surface tracer properties (in meter) when
+ !! average surface tracer properties (in depth units, Z) when
!! bulk mixed layer is not used, or a negative value
!! if a bulk mixed layer is being used.
+ real :: HFrz !< If HFrz > 0, melt potential will be computed.
+ !! The actual depth over which melt potential is computed will
+ !! min(HFrz, OBLD), where OBLD is the boundary layer depth.
+ !! If HFrz <= 0 (default), melt potential will not be computed.
real :: Hmix_UV !< Depth scale over which to average surface flow to
- !! feedback to the coupler/driver (m) when
+ !! feedback to the coupler/driver (in depth units, Z) when
!! bulk mixed layer is not used, or a negative value
!! if a bulk mixed layer is being used.
logical :: check_bad_sfc_vals !< If true, scan surface state for ridiculous values.
@@ -291,49 +292,70 @@ module MOM
real :: bad_val_sss_max !< Maximum SSS before triggering bad value message
real :: bad_vol_col_thick !< Minimum column thickness before triggering bad value message
- ! Structures and handles used for diagnostics.
- type(MOM_diag_IDs) :: IDs
- type(transport_diag_IDs) :: transport_IDs
- type(surface_diag_IDs) :: sfc_IDs
- type(diag_grid_storage) :: diag_pre_sync, diag_pre_dyn
+ type(MOM_diag_IDs) :: IDs !< Handles used for diagnostics.
+ type(transport_diag_IDs) :: transport_IDs !< Handles used for transport diagnostics.
+ type(surface_diag_IDs) :: sfc_IDs !< Handles used for surface diagnostics.
+ type(diag_grid_storage) :: diag_pre_sync !< The grid (thicknesses) before remapping
+ type(diag_grid_storage) :: diag_pre_dyn !< The grid (thicknesses) before dynamics
! The remainder of this type provides pointers to child module control structures.
- ! These are used for the dynamics updates
- type(MOM_dyn_unsplit_CS), pointer :: dyn_unsplit_CSp => NULL()
- type(MOM_dyn_unsplit_RK2_CS), pointer :: dyn_unsplit_RK2_CSp => NULL()
- type(MOM_dyn_split_RK2_CS), pointer :: dyn_split_RK2_CSp => NULL()
- type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL()
+ type(MOM_dyn_unsplit_CS), pointer :: dyn_unsplit_CSp => NULL()
+ !< Pointer to the control structure used for the unsplit dynamics
+ type(MOM_dyn_unsplit_RK2_CS), pointer :: dyn_unsplit_RK2_CSp => NULL()
+ !< Pointer to the control structure used for the unsplit RK2 dynamics
+ type(MOM_dyn_split_RK2_CS), pointer :: dyn_split_RK2_CSp => NULL()
+ !< Pointer to the control structure used for the mode-split RK2 dynamics
+ type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL()
+ !< Pointer to the control structure used for the isopycnal height diffusive transport.
+ !! This is also common referred to as Gent-McWilliams diffusion
type(mixedlayer_restrat_CS), pointer :: mixedlayer_restrat_CSp => NULL()
-
- type(set_visc_CS), pointer :: set_visc_CSp => NULL()
- type(diabatic_CS), pointer :: diabatic_CSp => NULL()
- type(MEKE_CS), pointer :: MEKE_CSp => NULL()
- type(VarMix_CS), pointer :: VarMix => NULL()
-
- ! These are used for tracer advection, diffusion, and remapping
- type(tracer_registry_type), pointer :: tracer_Reg => NULL()
- type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL()
- type(tracer_hor_diff_CS), pointer :: tracer_diff_CSp => NULL()
- type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL()
- ! This might not be needed outside of initialization?
- type(update_OBC_CS), pointer :: update_OBC_CSp => NULL()
- type(ocean_OBC_type), pointer :: OBC => NULL()
- type(sponge_CS), pointer :: sponge_CSp => NULL()
- type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL()
- type(ALE_CS), pointer :: ALE_CSp => NULL()
-
- type(sum_output_CS), pointer :: sum_output_CSp => NULL()
- type(diagnostics_CS), pointer :: diagnostics_CSp => NULL()
- type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL()
- type(offline_transport_CS), pointer :: offline_CSp => NULL()
-
- logical :: ensemble_ocean !< if true, this run is part of a
- !! larger ensemble for the purpose of data assimilation
- !! or statistical analysis.
- type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling
- !! ensemble model state vectors and data assimilation
- !! increments and priors
+ !< Pointer to the control structure used for the mixed layer restratification
+ type(set_visc_CS), pointer :: set_visc_CSp => NULL()
+ !< Pointer to the control structure used to set viscosities
+ type(diabatic_CS), pointer :: diabatic_CSp => NULL()
+ !< Pointer to the control structure for the diabatic driver
+ type(MEKE_CS), pointer :: MEKE_CSp => NULL()
+ !< Pointer to the control structure for the MEKE updates
+ type(VarMix_CS), pointer :: VarMix => NULL()
+ !< Pointer to the control structure for the variable mixing module
+
+ type(tracer_registry_type), pointer :: tracer_Reg => NULL()
+ !< Pointer to the MOM tracer registry
+ type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL()
+ !< Pointer to the MOM tracer advection control structure
+ type(tracer_hor_diff_CS), pointer :: tracer_diff_CSp => NULL()
+ !< Pointer to the MOM along-isopycnal tracer diffusion control structure
+ type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL()
+ !< Pointer to the control structure that orchestrates the calling of tracer packages
+ !### update_OBC_CS might not be needed outside of initialization?
+ type(update_OBC_CS), pointer :: update_OBC_CSp => NULL()
+ !< Pointer to the control structure for updating open boundary condition properties
+ type(ocean_OBC_type), pointer :: OBC => NULL()
+ !< Pointer to the MOM open boundary condition type
+ type(sponge_CS), pointer :: sponge_CSp => NULL()
+ !< Pointer to the layered-mode sponge control structure
+ type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL()
+ !< Pointer to the ALE-mode sponge control structure
+ type(ALE_CS), pointer :: ALE_CSp => NULL()
+ !< Pointer to the Arbitrary Lagrangian Eulerian (ALE) vertical coordinate control structure
+
+ ! Pointers to control structures used for diagnostics
+ type(sum_output_CS), pointer :: sum_output_CSp => NULL()
+ !< Pointer to the globally summed output control structure
+ type(diagnostics_CS), pointer :: diagnostics_CSp => NULL()
+ !< Pointer to the MOM diagnostics control structure
+ type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL()
+ !< Pointer to the MOM Z-space diagnostics control structure
+ type(offline_transport_CS), pointer :: offline_CSp => NULL()
+ !< Pointer to the offline tracer transport control structure
+
+ logical :: ensemble_ocean !< if true, this run is part of a
+ !! larger ensemble for the purpose of data assimilation
+ !! or statistical analysis.
+ type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling
+ !! ensemble model state vectors and data assimilation
+ !! increments and priors
end type MOM_control_struct
public initialize_MOM, finish_MOM_initialization, MOM_end
@@ -342,6 +364,7 @@ module MOM
public get_MOM_state_elements, MOM_state_is_synchronized
public allocate_surface_state, deallocate_surface_state
+!>@{ CPU time clock IDs
integer :: id_clock_ocean
integer :: id_clock_dynamics
integer :: id_clock_thermo
@@ -360,6 +383,7 @@ module MOM
integer :: id_clock_ALE
integer :: id_clock_other
integer :: id_clock_offline_tracer
+!!@}
contains
@@ -379,7 +403,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
real, intent(in) :: time_interval !< time interval covered by this run segment, in s.
type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM
type(Wave_parameters_CS), &
- optional, pointer :: Waves !< An optional pointer to a wave proptery CS
+ optional, pointer :: Waves !< An optional pointer to a wave property CS
logical, optional, intent(in) :: do_dynamics !< Present and false, do not do updates due
!! to the dynamics.
logical, optional, intent(in) :: do_thermodynamics !< Present and false, do not do updates due
@@ -537,7 +561,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo
if (associated(CS%VarMix)) then
- call enable_averaging(cycle_time, Time_start+set_time(int(cycle_time)), &
+ call enable_averaging(cycle_time, Time_start + real_to_time(cycle_time), &
CS%diag)
call calc_resoln_function(h, CS%tv, G, GV, CS%VarMix)
call disable_averaging(CS%diag)
@@ -563,7 +587,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
if (CS%UseWaves) then
! Update wave information, which is presently kept static over each call to step_mom
- call enable_averaging(time_interval, Time_start + set_time(int(floor(time_interval+0.5))), CS%diag)
+ call enable_averaging(time_interval, Time_start + real_to_time(time_interval), CS%diag)
call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar)
call disable_averaging(CS%diag)
endif
@@ -585,9 +609,9 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
do n=1,n_max
rel_time = rel_time + dt ! The relative time at the end of the step.
! Set the universally visible time to the middle of the time step.
- CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt)))
+ CS%Time = Time_start + real_to_time(rel_time - 0.5*dt)
! Set the local time to the end of the time step.
- Time_local = Time_start + set_time(int(floor(rel_time+0.5)))
+ Time_local = Time_start + real_to_time(rel_time)
if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n)
@@ -614,10 +638,10 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
if (dtdia > dt) then
! If necessary, temporarily reset CS%Time to the center of the period covered
! by the call to step_MOM_thermo, noting that they begin at the same time.
- CS%Time = CS%Time + set_time(int(floor(0.5*(dtdia-dt) + 0.5)))
+ CS%Time = CS%Time + real_to_time(0.5*(dtdia-dt))
! The end-time of the diagnostic interval needs to be set ahead if there
! are multiple dynamic time steps worth of thermodynamics applied here.
- end_time_thermo = Time_local + set_time(int(floor(dtdia-dt+0.5)))
+ end_time_thermo = Time_local + real_to_time(dtdia-dt)
endif
! Apply diabatic forcing, do mixing, and regrid.
@@ -630,7 +654,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)")
if (dtdia > dt) & ! Reset CS%Time to its previous value.
- CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt)))
+ CS%Time = Time_start + real_to_time(rel_time - 0.5*dt)
endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))"
if (do_dyn) then
@@ -712,7 +736,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
! If necessary, temporarily reset CS%Time to the center of the period covered
! by the call to step_MOM_thermo, noting that they end at the same time.
- if (dtdia > dt) CS%Time = CS%Time - set_time(int(floor(0.5*(dtdia-dt) + 0.5)))
+ if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt))
! Apply diabatic forcing, do mixing, and regrid.
call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, &
@@ -721,7 +745,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
CS%t_dyn_rel_thermo = 0.0
if (dtdia > dt) & ! Reset CS%Time to its previous value.
- CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt)))
+ CS%Time = Time_start + real_to_time(rel_time - 0.5*dt)
endif
if (do_dyn) then
@@ -729,7 +753,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
! Determining the time-average sea surface height is part of the algorithm.
! This may be eta_av if Boussinesq, or need to be diagnosed if not.
CS%time_in_cycle = CS%time_in_cycle + dt
- call find_eta(h, CS%tv, GV%g_Earth, G, GV, ssh, CS%eta_av_bc)
+ call find_eta(h, CS%tv, G, GV, ssh, CS%eta_av_bc, eta_to_m=1.0)
do j=js,je ; do i=is,ie
CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j)
enddo ; enddo
@@ -755,7 +779,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
CS%t_dyn_rel_diag = 0.0
call cpu_clock_begin(id_clock_Z_diag)
- if (Time_local + set_time(int(0.5*dt_therm)) > CS%Z_diag_time) then
+ if (Time_local + real_to_time(0.5*dt_therm) > CS%Z_diag_time) then
call enable_averaging(real(time_type_to_real(CS%Z_diag_interval)), &
CS%Z_diag_time, CS%diag)
!### This is the one place where fluxes might used if do_thermo=.false. Is this correct?
@@ -833,7 +857,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
if (MOM_state_is_synchronized(CS)) &
call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, &
G, GV, CS%sum_output_CSp, CS%tracer_flow_CSp, &
- dt_forcing=set_time(int(floor(time_interval+0.5))) )
+ dt_forcing=real_to_time(time_interval) )
call cpu_clock_end(id_clock_other)
@@ -842,6 +866,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
end subroutine step_MOM
+!> Time step the ocean dynamics, including the momentum and continuity equations
subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
bbl_time_int, CS, Time_local, Waves)
type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
@@ -892,7 +917,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then
- call enable_averaging(dt_thermo, Time_local+set_time(int(floor(dt_thermo-dt+0.5))), CS%diag)
+ call enable_averaging(dt_thermo, Time_local+real_to_time(dt_thermo-dt), CS%diag)
call cpu_clock_begin(id_clock_thick_diff)
if (associated(CS%VarMix)) &
call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix)
@@ -911,7 +936,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
! The bottom boundary layer properties need to be recalculated.
if (bbl_time_int > 0.0) then
call enable_averaging(bbl_time_int, &
- Time_local + set_time(int(bbl_time_int-dt+0.5)), CS%diag)
+ Time_local + real_to_time(bbl_time_int-dt), CS%diag)
! Calculate the BBL properties and store them inside visc (u,h).
call cpu_clock_begin(id_clock_BBL_visc)
call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, &
@@ -1349,7 +1374,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS
! If this is the first iteration in the offline timestep, then we need to read in fields and
! perform the main advection.
if (first_iter) then
- if (is_root_pe()) print *, "Reading in new offline fields"
+ call MOM_mesg("Reading in new offline fields")
! Read in new transport and other fields
! call update_transport_from_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, &
! CS%tv%T, CS%tv%S, fluxes, CS%use_ALE_algorithm)
@@ -1403,7 +1428,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS
endif
endif
- if (is_root_pe()) print *, "Last iteration of offline interval"
+ call MOM_mesg("Last iteration of offline interval")
! Apply freshwater fluxes out of the ocean
call offline_fw_fluxes_out_ocean(G, GV, CS%offline_CSp, fluxes, CS%h)
@@ -1460,7 +1485,8 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS
end subroutine step_offline
-!> This subroutine initializes MOM.
+!> Initialize MOM, including memory allocation, setting up parameters and diagnostics,
+!! initializing the ocean state variables, and initializing subsidiary modules
subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
Time_in, offline_tracer_mode, input_restart_file, diag_ptr, &
count_calls, tracer_flow_CSp)
@@ -1550,7 +1576,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
integer :: nkml, nkbl, verbosity, write_geom
integer :: dynamics_stencil ! The computational stencil for the calculations
! in the dynamic core.
- real :: conv2watt, conv2salt, H_convert
+ real :: conv2watt, conv2salt
character(len=48) :: flux_units, S_flux_units
type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables.
@@ -1729,13 +1755,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
"If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth \n"//&
"over which to average to find surface properties like \n"//&
"SST and SSS or density (but not surface velocities).", &
- units="m", default=1.0)
+ units="m", default=1.0) !, scale=GV%m_to_Z)
call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", CS%Hmix_UV, &
"If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth\n"//&
"over which to average to find surface flow properties,\n"//&
"SSU, SSV. A non-positive value indicates no averaging.", &
- units="m", default=0.)
+ units="m", default=0.) !, scale=GV%m_to_Z)
endif
+ call get_param(param_file, "MOM", "HFREEZE", CS%HFrz, &
+ "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//&
+ "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//&
+ "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//&
+ "melt potential will not be computed.", units="m", default=-1.0)
call get_param(param_file, "MOM", "MIN_Z_DIAG_INTERVAL", Z_diag_int, &
"The minimum amount of time in seconds between \n"//&
"calculations of depth-space diagnostics. Making this \n"//&
@@ -1921,7 +1952,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call verticalGridInit( param_file, CS%GV )
GV => CS%GV
-! dG%g_Earth = GV%g_Earth
+! dG%g_Earth = (GV%g_Earth*GV%m_to_Z)
+ !### These should be merged with the get_param calls, but must follow verticalGridInit.
+ if (.not.bulkmixedlayer) then
+ CS%Hmix = CS%Hmix * GV%m_to_Z
+ CS%Hmix_UV = CS%Hmix_UV * GV%m_to_Z
+ endif
! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes.
if (CS%debug .or. dG%symmetric) &
@@ -1935,6 +1971,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
! Allocate initialize time-invariant MOM variables.
call MOM_initialize_fixed(dG, CS%OBC, param_file, write_geom_files, dirs%output_directory)
call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)")
+ ! This could replace a later call to rescale_grid_bathymetry.
+ if (dG%Zd_to_m /= GV%Z_to_m) call rescale_dyn_horgrid_bathymetry(dG, GV%Z_to_m)
+
if (associated(CS%OBC)) call call_OBC_register(param_file, CS%update_OBC_CSp, CS%OBC)
call tracer_registry_init(param_file, CS%tracer_Reg)
@@ -1945,7 +1984,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
IsdB = dG%IsdB ; IedB = dG%IedB ; JsdB = dG%JsdB ; JedB = dG%JedB
ALLOC_(CS%u(IsdB:IedB,jsd:jed,nz)) ; CS%u(:,:,:) = 0.0
ALLOC_(CS%v(isd:ied,JsdB:JedB,nz)) ; CS%v(:,:,:) = 0.0
- ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom
+ ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom_H
ALLOC_(CS%uh(IsdB:IedB,jsd:jed,nz)) ; CS%uh(:,:,:) = 0.0
ALLOC_(CS%vh(isd:ied,JsdB:JedB,nz)) ; CS%vh(:,:,:) = 0.0
if (use_temperature) then
@@ -1976,10 +2015,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
conv2watt = GV%H_to_kg_m2 * CS%tv%C_p
if (GV%Boussinesq) then
conv2salt = GV%H_to_m ! Could change to GV%H_to_kg_m2 * 0.001?
- H_convert = GV%H_to_m
else
conv2salt = GV%H_to_kg_m2
- H_convert = GV%H_to_kg_m2
endif
call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, dG%HI, GV, &
tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', &
@@ -2095,11 +2132,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
! Initialize dynamically evolving fields, perhaps from restart files.
call cpu_clock_begin(id_clock_MOM_init)
call MOM_initialize_coord(GV, param_file, write_geom_files, &
- dirs%output_directory, CS%tv, dG%max_depth)
+ dirs%output_directory, CS%tv, dG%max_depth*dG%Zd_to_m)
call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)")
if (CS%use_ALE_algorithm) then
- call ALE_init(param_file, GV, dG%max_depth, CS%ALE_CSp)
+ call ALE_init(param_file, GV, dG%max_depth*dG%Zd_to_m, CS%ALE_CSp)
call callTree_waypoint("returned from ALE_init() (initialize_MOM)")
endif
@@ -2111,14 +2148,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call copy_dyngrid_to_MOM_grid(dG, G)
call destroy_dyn_horgrid(dG)
+ ! This could replace an earlier call to rescale_dyn_horgrid_bathymetry just after MOM_initialize_fixed.
+ ! if (G%Zd_to_m /= GV%Z_to_m) call rescale_grid_bathymetry(G, GV%Z_to_m)
+
! Set a few remaining fields that are specific to the ocean grid type.
call set_first_direction(G, first_direction)
! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes.
- if (CS%debug .or. G%symmetric) &
+ if (CS%debug .or. G%symmetric) then
call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.)
+ else ; G%Domain_aux => G%Domain ; endif
! Copy common variables from the vertical grid to the horizontal grid.
! Consider removing this later?
- G%ke = GV%ke ; G%g_Earth = GV%g_Earth
+ G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*GV%m_to_Z)
call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, param_file, &
dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, &
@@ -2144,9 +2185,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call MOM_grid_end(G) ; deallocate(G)
G => CS%G
- if (CS%debug .or. CS%G%symmetric) &
+ if (CS%debug .or. CS%G%symmetric) then
call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.)
- G%ke = GV%ke ; G%g_Earth = GV%g_Earth
+ else ; CS%G%Domain_aux => CS%G%Domain ;endif
+ G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*GV%m_to_Z)
endif
@@ -2255,8 +2297,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
CS%useMEKE = MEKE_init(Time, G, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp)
- call VarMix_init(Time, G, param_file, diag, CS%VarMix)
- call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, CS%OBC)
+ call VarMix_init(Time, G, GV, param_file, diag, CS%VarMix)
+ call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC)
if (CS%split) then
allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0
call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, &
@@ -2265,7 +2307,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, &
CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt)
if (CS%dtbt_reset_period > 0.0) then
- CS%dtbt_reset_interval = set_time(int(floor(CS%dtbt_reset_period)))
+ CS%dtbt_reset_interval = real_to_time(CS%dtbt_reset_period)
! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval.
CS%dtbt_reset_time = Time_init + CS%dtbt_reset_interval * &
((Time - Time_init) / CS%dtbt_reset_interval)
@@ -2291,7 +2333,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call thickness_diffuse_init(Time, G, GV, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp)
CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, param_file, diag, &
- CS%mixedlayer_restrat_CSp)
+ CS%mixedlayer_restrat_CSp, restart_CSp)
if (CS%mixedlayer_restrat) then
if (.not.(bulkmixedlayer .or. CS%use_ALE_algorithm)) &
call MOM_error(FATAL, "MOM: MIXEDLAYER_RESTRAT true requires a boundary layer scheme.")
@@ -2304,11 +2346,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
param_file, diag, CS%diagnostics_CSp, CS%tv)
call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag)
- CS%Z_diag_interval = set_time(int((CS%dt_therm) * &
- max(1,floor(0.01 + Z_diag_int/(CS%dt_therm)))))
+ CS%Z_diag_interval = real_to_time(CS%dt_therm * max(1,floor(0.01 + Z_diag_int/CS%dt_therm)))
call MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS%diag_to_Z_CSp)
CS%Z_diag_time = Start_time + CS%Z_diag_interval * (1 + &
- ((Time + set_time(int(CS%dt_therm))) - Start_time) / CS%Z_diag_interval)
+ ((Time + real_to_time(CS%dt_therm)) - Start_time) / CS%Z_diag_interval)
if (associated(CS%sponge_CSp)) &
call init_sponge_diags(Time, G, diag, CS%sponge_CSp)
@@ -2399,9 +2440,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then
if (CS%split) then
- call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, CS%ave_ssh_ibc, eta)
+ call find_eta(CS%h, CS%tv, G, GV, CS%ave_ssh_ibc, eta, eta_to_m=1.0)
else
- call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, CS%ave_ssh_ibc)
+ call find_eta(CS%h, CS%tv, G, GV, CS%ave_ssh_ibc, eta_to_m=1.0)
endif
endif
if (CS%split) deallocate(eta)
@@ -2416,17 +2457,19 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
.not.((dirs%input_filename(1:1) == 'r') .and. &
(LEN_TRIM(dirs%input_filename) == 1))
-
if (CS%ensemble_ocean) then
- call init_oda(Time, G, GV, CS%odaCS)
+ call init_oda(Time, G, GV, CS%odaCS)
endif
+ !### This could perhaps go here instead of in finish_MOM_initialization?
+ ! call fix_restart_scaling(GV)
+
call callTree_leave("initialize_MOM()")
call cpu_clock_end(id_clock_init)
end subroutine initialize_MOM
-!> This subroutine finishes initializing MOM and writes out the initial conditions.
+!> Finishes initializing MOM and writes out the initial conditions.
subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp)
type(time_type), intent(in) :: Time !< model time, used in this routine
type(directories), intent(in) :: dirs !< structure with directory paths
@@ -2438,7 +2481,6 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp)
type(verticalGrid_type), pointer :: GV => NULL()
type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL()
real, allocatable :: z_interface(:,:,:) ! Interface heights (meter)
- real, allocatable :: eta(:,:) ! Interface heights (meter)
type(vardesc) :: vd
call cpu_clock_begin(id_clock_init)
@@ -2447,12 +2489,15 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp)
! Pointers for convenience
G => CS%G ; GV => CS%GV
+ !### Move to initialize_MOM?
+ call fix_restart_scaling(GV)
+
! Write initial conditions
if (CS%write_IC) then
allocate(restart_CSp_tmp)
restart_CSp_tmp = restart_CSp
allocate(z_interface(SZI_(G),SZJ_(G),SZK_(G)+1))
- call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, z_interface)
+ call find_eta(CS%h, CS%tv, G, GV, z_interface, eta_to_m=1.0)
call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, &
"Interface heights", "meter", z_grid='i')
@@ -2500,7 +2545,7 @@ subroutine register_diags(Time, G, GV, IDs, diag)
Time, 'Instantaneous Sea Surface Height', 'm')
end subroutine register_diags
-!> This subroutine sets up clock IDs for timing various subroutines.
+!> Set up CPU clock IDs for timing various subroutines.
subroutine MOM_timing_init(CS)
type(MOM_control_struct), intent(in) :: CS !< control structure set up by initialize_MOM.
@@ -2585,13 +2630,19 @@ subroutine set_restart_fields(GV, param_file, CS, restart_CSp)
call get_param(param_file, '', "ICE_SHELF", use_ice_shelf, default=.false., &
do_not_log=.true.)
if (use_ice_shelf .and. associated(CS%Hml)) then
- call register_restart_field(CS%Hml, "hML", .false., restart_CSp, &
- "Mixed layer thickness", "meter")
+ call register_restart_field(CS%Hml, "hML", .false., restart_CSp, &
+ "Mixed layer thickness", "meter")
endif
+ ! Register scalar unit conversion factors.
+ call register_restart_field(GV%m_to_Z_restart, "m_to_Z", .false., restart_CSp, &
+ "Height unit conversion factor", "Z meter-1")
+ call register_restart_field(GV%m_to_H_restart, "m_to_H", .false., restart_CSp, &
+ "Thickness unit conversion factor", "Z meter-1")
+
end subroutine set_restart_fields
-!> This subroutine applies a correction to the sea surface height to compensate
+!> Apply a correction to the sea surface height to compensate
!! for the atmospheric pressure (the inverse barometer).
subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS)
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
@@ -2621,15 +2672,15 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS)
else
Rho_conv=GV%Rho0
endif
- IgR0 = 1.0 / (Rho_conv * GV%g_Earth)
+ IgR0 = 1.0 / (Rho_conv * (GV%g_Earth*GV%m_to_Z))
ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0
enddo ; enddo
endif ; endif
end subroutine adjust_ssh_for_p_atm
-!> This subroutine sets the surface (return) properties of the ocean
-!! model by setting the appropriate fields in sfc_state. Unused fields
+!> Set the surface (return) properties of the ocean model by
+!! setting the appropriate fields in sfc_state. Unused fields
!! are set to NULL or are unallocated.
subroutine extract_surface_state(CS, sfc_state)
type(MOM_control_struct), pointer :: CS !< Master MOM control structure
@@ -2639,20 +2690,22 @@ subroutine extract_surface_state(CS, sfc_state)
! local
real :: hu, hv
- type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing
- ! metrics and related information
+ type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing
+ !! metrics and related information
type(verticalGrid_type), pointer :: GV => NULL()
real, dimension(:,:,:), pointer :: &
- u => NULL(), & ! u : zonal velocity component (m/s)
- v => NULL(), & ! v : meridional velocity component (m/s)
- h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss))
- real :: depth(SZI_(CS%G)) ! distance from the surface (meter)
- real :: depth_ml ! depth over which to average to
- ! determine mixed layer properties (meter)
- real :: dh ! thickness of a layer within mixed layer (meter)
- real :: mass ! mass per unit area of a layer (kg/m2)
-
- logical :: use_temperature ! If true, temp and saln used as state variables.
+ u => NULL(), & !< u : zonal velocity component (m/s)
+ v => NULL(), & !< v : meridional velocity component (m/s)
+ h => NULL() !< h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss))
+ real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units (Z)
+ real :: depth_ml !< Depth over which to average to determine mixed
+ !! layer properties (Z)
+ real :: dh !< Thickness of a layer within the mixed layer (Z)
+ real :: mass !< Mass per unit area of a layer (kg/m2)
+ real :: bathy_m !< The depth of bathymetry in m (not Z), used for error checking.
+ real :: T_freeze !< freezing temperature (oC)
+ real :: delT(SZI_(CS%G)) !< T-T_freeze (oC)
+ logical :: use_temperature !< If true, temp and saln used as state variables.
integer :: i, j, k, is, ie, js, je, nz, numberOfErrors
integer :: isd, ied, jsd, jed
integer :: iscB, iecB, jscB, jecB, isdB, iedB, jsdB, jedB
@@ -2686,6 +2739,13 @@ subroutine extract_surface_state(CS, sfc_state)
sfc_state%sea_lev(i,j) = CS%ave_ssh_ibc(i,j)
enddo ; enddo
+ ! copy Hml into sfc_state, so that caps can access it
+ if (associated(CS%Hml)) then
+ do j=js,je ; do i=is,ie
+ sfc_state%Hml(i,j) = CS%Hml(i,j)
+ enddo ; enddo
+ endif
+
if (CS%Hmix < 0.0) then ! A bulk mixed layer is in use, so layer 1 has the properties
if (use_temperature) then ; do j=js,je ; do i=is,ie
sfc_state%SST(i,j) = CS%tv%T(i,j,1)
@@ -2698,11 +2758,9 @@ subroutine extract_surface_state(CS, sfc_state)
sfc_state%v(i,J) = v(i,J,1)
enddo ; enddo
- if (associated(CS%Hml)) then ; do j=js,je ; do i=is,ie
- sfc_state%Hml(i,j) = CS%Hml(i,j)
- enddo ; enddo ; endif
else ! (CS%Hmix >= 0.0)
-
+ !### This calculation should work in thickness (H) units instead of Z, but that
+ !### would change answers at roundoff in non-Boussinesq cases.
depth_ml = CS%Hmix
! Determine the mean tracer properties of the uppermost depth_ml fluid.
!$OMP parallel do default(shared) private(depth,dh)
@@ -2717,8 +2775,8 @@ subroutine extract_surface_state(CS, sfc_state)
enddo
do k=1,nz ; do i=is,ie
- if (depth(i) + h(i,j,k)*GV%H_to_m < depth_ml) then
- dh = h(i,j,k)*GV%H_to_m
+ if (depth(i) + h(i,j,k)*GV%H_to_Z < depth_ml) then
+ dh = h(i,j,k)*GV%H_to_Z
elseif (depth(i) < depth_ml) then
dh = depth_ml - depth(i)
else
@@ -2734,20 +2792,23 @@ subroutine extract_surface_state(CS, sfc_state)
enddo ; enddo
! Calculate the average properties of the mixed layer depth.
do i=is,ie
- if (depth(i) < GV%H_subroundoff*GV%H_to_m) &
- depth(i) = GV%H_subroundoff*GV%H_to_m
+ if (depth(i) < GV%H_subroundoff*GV%H_to_Z) &
+ depth(i) = GV%H_subroundoff*GV%H_to_Z
if (use_temperature) then
sfc_state%SST(i,j) = sfc_state%SST(i,j) / depth(i)
sfc_state%SSS(i,j) = sfc_state%SSS(i,j) / depth(i)
else
sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) / depth(i)
endif
- sfc_state%Hml(i,j) = depth(i)
+ !### Verify that this is no longer needed.
+ ! sfc_state%Hml(i,j) = GV%Z_to_m * depth(i)
enddo
enddo ! end of j loop
! Determine the mean velocities in the uppermost depth_ml fluid.
if (CS%Hmix_UV>0.) then
+ !### This calculation should work in thickness (H) units instead of Z, but that
+ !### would change answers at roundoff in non-Boussinesq cases.
depth_ml = CS%Hmix_UV
!$OMP parallel do default(shared) private(depth,dh,hv)
do J=jscB,jecB
@@ -2756,7 +2817,7 @@ subroutine extract_surface_state(CS, sfc_state)
sfc_state%v(i,J) = 0.0
enddo
do k=1,nz ; do i=is,ie
- hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * GV%H_to_m
+ hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * GV%H_to_Z
if (depth(i) + hv < depth_ml) then
dh = hv
elseif (depth(i) < depth_ml) then
@@ -2769,8 +2830,8 @@ subroutine extract_surface_state(CS, sfc_state)
enddo ; enddo
! Calculate the average properties of the mixed layer depth.
do i=is,ie
- if (depth(i) < GV%H_subroundoff*GV%H_to_m) &
- depth(i) = GV%H_subroundoff*GV%H_to_m
+ if (depth(i) < GV%H_subroundoff*GV%H_to_Z) &
+ depth(i) = GV%H_subroundoff*GV%H_to_Z
sfc_state%v(i,J) = sfc_state%v(i,J) / depth(i)
enddo
enddo ! end of j loop
@@ -2782,7 +2843,7 @@ subroutine extract_surface_state(CS, sfc_state)
sfc_state%u(I,j) = 0.0
enddo
do k=1,nz ; do I=iscB,iecB
- hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * GV%H_to_m
+ hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * GV%H_to_Z
if (depth(i) + hu < depth_ml) then
dh = hu
elseif (depth(I) < depth_ml) then
@@ -2795,8 +2856,8 @@ subroutine extract_surface_state(CS, sfc_state)
enddo ; enddo
! Calculate the average properties of the mixed layer depth.
do I=iscB,iecB
- if (depth(I) < GV%H_subroundoff*GV%H_to_m) &
- depth(I) = GV%H_subroundoff*GV%H_to_m
+ if (depth(I) < GV%H_subroundoff*GV%H_to_Z) &
+ depth(I) = GV%H_subroundoff*GV%H_to_Z
sfc_state%u(I,j) = sfc_state%u(I,j) / depth(I)
enddo
enddo ! end of j loop
@@ -2810,6 +2871,43 @@ subroutine extract_surface_state(CS, sfc_state)
endif
endif ! (CS%Hmix >= 0.0)
+
+ if (allocated(sfc_state%melt_potential)) then
+ !$OMP parallel do default(shared)
+ do j=js,je
+ do i=is,ie
+ depth(i) = 0.0
+ delT(i) = 0.0
+ enddo
+
+ do k=1,nz ; do i=is,ie
+ depth_ml = min(CS%HFrz,CS%visc%MLD(i,j))
+ if (depth(i) + h(i,j,k)*GV%H_to_m < depth_ml) then
+ dh = h(i,j,k)*GV%H_to_m
+ elseif (depth(i) < depth_ml) then
+ dh = depth_ml - depth(i)
+ else
+ dh = 0.0
+ endif
+
+ ! p=0 OK, HFrz ~ 10 to 20m
+ call calculate_TFreeze(CS%tv%S(i,j,k), 0.0, T_freeze, CS%tv%eqn_of_state)
+ depth(i) = depth(i) + dh
+ delT(i) = delT(i) + dh * (CS%tv%T(i,j,k) - T_freeze)
+ enddo ; enddo
+
+ do i=is,ie
+ ! set melt_potential to zero to avoid passing previous values
+ sfc_state%melt_potential(i,j) = 0.0
+
+ if (G%mask2dT(i,j)>0.) then
+ ! instantaneous melt_potential, in J/m^2
+ sfc_state%melt_potential(i,j) = CS%tv%C_p * CS%GV%Rho0 * delT(i)
+ endif
+ enddo
+ enddo ! end of j loop
+ endif ! melt_potential
+
if (allocated(sfc_state%salt_deficit) .and. associated(CS%tv%salt_deficit)) then
!$OMP parallel do default(shared)
do j=js,je ; do i=is,ie
@@ -2871,10 +2969,11 @@ subroutine extract_surface_state(CS, sfc_state)
numberOfErrors=0 ! count number of errors
do j=js,je; do i=is,ie
if (G%mask2dT(i,j)>0.) then
- localError = sfc_state%sea_lev(i,j)<=-G%bathyT(i,j) &
+ bathy_m = G%Zd_to_m*G%bathyT(i,j)
+ localError = sfc_state%sea_lev(i,j)<=-bathy_m &
.or. sfc_state%sea_lev(i,j)>= CS%bad_val_ssh_max &
.or. sfc_state%sea_lev(i,j)<=-CS%bad_val_ssh_max &
- .or. sfc_state%sea_lev(i,j)+G%bathyT(i,j) < CS%bad_vol_col_thick
+ .or. sfc_state%sea_lev(i,j) + bathy_m < CS%bad_vol_col_thick
if (use_temperature) localError = localError &
.or. sfc_state%SSS(i,j)<0. &
.or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max &
@@ -2887,7 +2986,7 @@ subroutine extract_surface_state(CS, sfc_state)
write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),8(a,es11.4,x))') &
'Extreme surface sfc_state detected: i=',i,'j=',j, &
'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), &
- 'D=',G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), &
+ 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), &
'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), &
'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), &
'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J)
@@ -2895,7 +2994,7 @@ subroutine extract_surface_state(CS, sfc_state)
write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),6(a,es11.4))') &
'Extreme surface sfc_state detected: i=',i,'j=',j, &
'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), &
- 'D=',G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), &
+ 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), &
'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), &
'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J)
endif
@@ -2973,7 +3072,7 @@ subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only)
end subroutine get_ocean_stocks
-!> End of model
+!> End of ocean model, including memory deallocation
subroutine MOM_end(CS)
type(MOM_control_struct), pointer :: CS !< MOM control structure
diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90
index 51a1f1f04e..948901ac63 100644
--- a/src/core/MOM_CoriolisAdv.F90
+++ b/src/core/MOM_CoriolisAdv.F90
@@ -70,11 +70,12 @@ module MOM_CoriolisAdv
!! SADOURNY75_ENERGY.
type(time_type), pointer :: Time !< A pointer to the ocean model's clock.
type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the timing of diagnostic output.
+ !>@{ Diagnostic IDs
integer :: id_rv = -1, id_PV = -1, id_gKEu = -1, id_gKEv = -1
- integer :: id_rvxu = -1, id_rvxv = -1
+ integer :: id_rvxu = -1, id_rvxv = -1 !!@}
end type CoriolisAdv_CS
-! Enumeration values for Coriolis_Scheme
+!>@{ Enumeration values for Coriolis_Scheme
integer, parameter :: SADOURNY75_ENERGY = 1
integer, parameter :: ARAKAWA_HSU90 = 2
integer, parameter :: ROBUST_ENSTRO = 3
@@ -87,18 +88,21 @@ module MOM_CoriolisAdv
character*(20), parameter :: SADOURNY75_ENSTRO_STRING = "SADOURNY75_ENSTRO"
character*(20), parameter :: ARAKAWA_LAMB_STRING = "ARAKAWA_LAMB81"
character*(20), parameter :: AL_BLEND_STRING = "ARAKAWA_LAMB_BLEND"
-! Enumeration values for KE_Scheme
+!!@}
+!>@{ Enumeration values for KE_Scheme
integer, parameter :: KE_ARAKAWA = 10
integer, parameter :: KE_SIMPLE_GUDONOV = 11
integer, parameter :: KE_GUDONOV = 12
character*(20), parameter :: KE_ARAKAWA_STRING = "KE_ARAKAWA"
character*(20), parameter :: KE_SIMPLE_GUDONOV_STRING = "KE_SIMPLE_GUDONOV"
character*(20), parameter :: KE_GUDONOV_STRING = "KE_GUDONOV"
-! Enumeration values for PV_Adv_Scheme
+!!@}
+!>@{ Enumeration values for PV_Adv_Scheme
integer, parameter :: PV_ADV_CENTERED = 21
integer, parameter :: PV_ADV_UPWIND1 = 22
character*(20), parameter :: PV_ADV_CENTERED_STRING = "PV_ADV_CENTERED"
character*(20), parameter :: PV_ADV_UPWIND1_STRING = "PV_ADV_UPWIND1"
+!!@}
contains
@@ -218,7 +222,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS)
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke
h_neglect = GV%H_subroundoff
- h_tiny = GV%Angstrom ! Perhaps this should be set to h_neglect instead.
+ h_tiny = GV%Angstrom_H ! Perhaps this should be set to h_neglect instead.
!$OMP parallel do default(private) shared(Isq,Ieq,Jsq,Jeq,G,Area_h)
do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+2
diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90
index 62bd140255..ebefd38bcf 100644
--- a/src/core/MOM_PressureForce.F90
+++ b/src/core/MOM_PressureForce.F90
@@ -16,7 +16,7 @@ module MOM_PressureForce
use MOM_PressureForce_Mont, only : PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss
use MOM_PressureForce_Mont, only : PressureForce_Mont_init, PressureForce_Mont_end
use MOM_PressureForce_Mont, only : PressureForce_Mont_CS
-use MOM_tidal_forcing, only : calc_tidal_forcing, tidal_forcing_CS
+use MOM_tidal_forcing, only : tidal_forcing_CS
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
use MOM_ALE, only: ALE_CS
@@ -26,7 +26,7 @@ module MOM_PressureForce
public PressureForce, PressureForce_init, PressureForce_end
-! Pressure force control structure
+!> Pressure force control structure
type, public :: PressureForce_CS ; private
logical :: Analytic_FV_PGF !< If true, use the analytic finite volume form
!! (Adcroft et al., Ocean Mod. 2008) of the PGF.
diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90
index a30f8e9974..4f295600cd 100644
--- a/src/core/MOM_PressureForce_Montgomery.F90
+++ b/src/core/MOM_PressureForce_Montgomery.F90
@@ -37,8 +37,10 @@ module MOM_PressureForce_Mont
real, pointer :: PFu_bc(:,:,:) => NULL() !< Accelerations due to pressure
real, pointer :: PFv_bc(:,:,:) => NULL() !< gradients deriving from density
!! gradients within layers, m s-2.
+ !>@{ Diagnostic IDs
integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_tidal = -1
- type(tidal_forcing_CS), pointer :: tides_CSp => NULL()
+ !!@}
+ type(tidal_forcing_CS), pointer :: tides_CSp => NULL() !< The tidal forcing control structure
end type PressureForce_Mont_CS
contains
@@ -94,11 +96,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
! enable the use of a reduced gravity form of the equations,
! in m2 s-2.
dp_star, & ! Layer thickness after compensation for compressibility, in Pa.
+ SSH, & ! The sea surface height anomaly, in depth units (Z).
e_tidal, & ! Bottom geopotential anomaly due to tidal forces from
- ! astronomical sources and self-attraction and loading, in m.
- geopot_bot, & ! Bottom geopotential relative to time-mean sea level,
+ ! astronomical sources and self-attraction and loading, in Z.
+ geopot_bot ! Bottom geopotential relative to time-mean sea level,
! including any tidal contributions, in units of m2 s-2.
- SSH ! Sea surface height anomalies, in m.
real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate
! density, in Pa (usually 2e7 Pa = 2000 dbar).
real :: rho_in_situ(SZI_(G)) !In-situ density of a layer, in kg m-3.
@@ -114,7 +116,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
! barotropic and baroclinic pieces.
type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S.
- real :: I_gEarth
+ real :: I_gEarth ! The inverse of g_Earth, in s2 Z m-2
real :: dalpha
real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H).
real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer, in kg m-3.
@@ -141,36 +143,30 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
I_gEarth = 1.0 / GV%g_Earth
dp_neglect = GV%H_to_Pa * GV%H_subroundoff
-!$OMP parallel default(none) shared(nz,alpha_Lay,GV,dalpha_int)
-!$OMP do
do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo
-!$OMP do
do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo
-!$OMP end parallel
-!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,p,p_atm,GV,h,use_p_atm)
if (use_p_atm) then
-!$OMP do
+ !$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
else
-!$OMP do
+ !$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 do
+ !$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)
enddo ; enddo ; enddo
-!$OMP end parallel
if (present(eta)) then
Pa_to_H = 1.0 / GV%H_to_Pa
if (use_p_atm) then
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,eta,p,p_atm,Pa_to_H)
+ !$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.
enddo ; enddo
else
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,eta,p,Pa_to_H)
+ !$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.
enddo ; enddo
@@ -180,37 +176,34 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
if (CS%tides) then
! Determine the sea surface height anomalies, to enable the calculation
! of self-attraction and loading.
-!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,SSH,G,GV,use_EOS,tv,p,dz_geo, &
-!$OMP I_gEarth,h,alpha_Lay)
-!$OMP do
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
SSH(i,j) = -G%bathyT(i,j)
enddo ; enddo
if (use_EOS) then
-!$OMP do
+ !$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)
enddo
-!$OMP do
+ !$OMP parallel do default(shared)
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
-!$OMP do
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1
- SSH(i,j) = SSH(i,j) + GV%H_to_kg_m2*h(i,j,k)*alpha_Lay(k)
+ SSH(i,j) = SSH(i,j) + (GV%m_to_Z*GV%H_to_kg_m2)*h(i,j,k)*alpha_Lay(k)
enddo ; enddo ; enddo
endif
-!$OMP end parallel
- call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp)
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV,e_tidal)
+ call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j))
enddo ; enddo
else
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j)
enddo ; enddo
@@ -227,8 +220,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
tv_tmp%T => T_tmp ; tv_tmp%S => S_tmp
tv_tmp%eqn_of_state => tv%eqn_of_state
do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,nkmb,tv_tmp,tv,p_ref,GV) &
-!$OMP private(Rho_cv_BL)
+ !$OMP parallel do default(shared) private(Rho_cv_BL)
do j=Jsq,Jeq+1
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)
@@ -248,8 +240,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
tv_tmp%eqn_of_state => tv%eqn_of_state
do i=Isq,Ieq+1 ; p_ref(i) = 0 ; enddo
endif
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv_tmp,p_ref,tv,alpha_star) &
-!$OMP private(rho_in_situ)
+ !$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)
@@ -258,7 +249,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
endif ! use_EOS
if (use_EOS) then
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,geopot_bot,p,alpha_star)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_star(i,j,nz)
@@ -268,8 +259,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
enddo ; enddo
enddo
else ! not use_EOS
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,geopot_bot,p,&
-!$OMP alpha_Lay,dalpha_int)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_Lay(nz)
@@ -282,11 +272,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
if (CS%GFS_scale < 1.0) then
! Adjust the Montgomery potential to make this a reduced gravity model.
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,dM,CS,M)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
dM(i,j) = (CS%GFS_scale - 1.0) * M(i,j,1)
enddo ; enddo
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,dM,M)
+ !$OMP parallel do default(shared)
do k=1,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
M(i,j,k) = M(i,j,k) + dM(i,j)
enddo ; enddo ; enddo
@@ -310,16 +300,13 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
! Note that ddM/dPb = alpha_star(i,j,1)
if (present(pbce)) then
- call Set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce, &
- alpha_star)
+ call Set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce, alpha_star)
endif
! Calculate the pressure force. On a Cartesian grid,
! PFu = - dM/dx and PFv = - dM/dy.
if (use_EOS) then
-!$OMP parallel do default(none) shared(is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,p,dp_neglect, &
-!$OMP alpha_star,G,PFu,PFv,M,CS) &
-!$OMP private(dp_star,PFu_bc,PFv_bc)
+ !$OMP parallel do default(shared) private(dp_star,PFu_bc,PFv_bc)
do k=1,nz
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
dp_star(i,j) = (p(i,j,K+1) - p(i,j,K)) + dp_neglect
@@ -341,7 +328,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce,
enddo ; enddo
enddo ! k-loop
else ! .not. use_EOS
-!$OMP parallel do default(none) shared(is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,PFu,PFv,M,G)
+ !$OMP parallel do default(shared)
do k=1,nz
do j=js,je ; do I=Isq,Ieq
PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j)
@@ -403,11 +390,11 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta
! for compressibility, in m.
real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal
! forces from astronomical sources and self-
- ! attraction and loading, in m.
+ ! attraction and loading, in depth units (Z).
real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate
! density, in Pa (usually 2e7 Pa = 2000 dbar).
- real :: I_Rho0 ! 1/Rho0.
- real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1.
+ real :: I_Rho0 ! 1/Rho0, in m3 kg-1.
+ real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1.
real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer
! compensated density gradients, in m s-2.
real :: dr ! Temporary variables.
@@ -440,7 +427,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta
"can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.")
endif
- h_neglect = GV%H_subroundoff * GV%H_to_m
+ h_neglect = GV%H_subroundoff * GV%H_to_Z
I_Rho0 = 1.0/CS%Rho0
G_Rho0 = GV%g_Earth/GV%Rho0
@@ -449,36 +436,34 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta
! and loading. This should really be based on bottom pressure anomalies,
! but that is not yet implemented, and the current form is correct for
! barotropic tides.
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h,G,GV)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1
- do i=Isq,Ieq+1 ; e(i,j,1) = -1.0*G%bathyT(i,j) ; enddo
+ do i=Isq,Ieq+1 ; e(i,j,1) = -G%bathyT(i,j) ; enddo
do k=1,nz ; do i=Isq,Ieq+1
- e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m
+ e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z
enddo ; enddo
enddo
- call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp)
+ call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z)
endif
! Here layer interface heights, e, are calculated.
-!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h,G,GV,e_tidal,CS)
if (CS%tides) then
-!$OMP do
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j)
+ e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j))
enddo ; enddo
else
-!$OMP do
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- e(i,j,nz+1) = -1.0*G%bathyT(i,j)
+ e(i,j,nz+1) = -G%bathyT(i,j)
enddo ; enddo
endif
-!$OMP do
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do k=nz,1,-1 ; do i=Isq,Ieq+1
- e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m
+ e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z
enddo ; enddo ; enddo
-!$OMP end parallel
- if (use_EOS) then
+ if (use_EOS) then
! Calculate in-situ densities (rho_star).
! With a bulk mixed layer, replace the T & S of any layers that are
@@ -491,8 +476,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta
tv_tmp%eqn_of_state => tv%eqn_of_state
do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,nkmb,tv_tmp,tv,p_ref,GV) &
-!$OMP private(Rho_cv_BL)
+ !$OMP parallel do default(shared) private(Rho_cv_BL)
do j=Jsq,Jeq+1
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)
@@ -516,7 +500,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta
! This no longer includes any pressure dependency, since this routine
! will come down with a fatal error if there is any compressibility.
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv_tmp,p_ref,rho_star,tv,G_Rho0)
+ !$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)
@@ -526,8 +510,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta
! Here the layer Montgomery potentials, M, are calculated.
if (use_EOS) then
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,CS,rho_star,e,use_p_atm, &
-!$OMP p_atm,I_Rho0)
+ !$OMP parallel do default(shared)
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))
@@ -538,7 +521,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta
enddo ; enddo
enddo
else ! not use_EOS
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,GV,e,use_p_atm,p_atm,I_Rho0)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
M(i,j,1) = GV%g_prime(1) * e(i,j,1)
@@ -551,16 +534,13 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta
endif ! use_EOS
if (present(pbce)) then
- call Set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, &
- rho_star)
+ call Set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce, rho_star)
endif
! Calculate the pressure force. On a Cartesian grid,
! PFu = - dM/dx and PFv = - dM/dy.
if (use_EOS) then
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,js,je,is,ie,nz,e,h_neglect, &
-!$OMP rho_star,G,PFu,CS,PFv,M) &
-!$OMP private(h_star,PFu_bc,PFv_bc)
+ !$OMP parallel do default(shared) private(h_star,PFu_bc,PFv_bc)
do k=1,nz
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
h_star(i,j) = (e(i,j,K) - e(i,j,K+1)) + h_neglect
@@ -581,7 +561,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta
enddo ; enddo
enddo ! k-loop
else ! .not. use_EOS
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,is,ie,js,je,nz,PFu,PFv,M,G)
+ !$OMP parallel do default(shared)
do k=1,nz
do j=js,je ; do I=Isq,Ieq
PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j)
@@ -597,14 +577,14 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta
! 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(none) shared(Isq,Ieq,Jsq,Jeq,eta,e,e_tidal,GV)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%m_to_H
+ 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(none) shared(Isq,Ieq,Jsq,Jeq,eta,e,GV)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta(i,j) = e(i,j,1)*GV%m_to_H
+ eta(i,j) = e(i,j,1)*GV%Z_to_H
enddo ; enddo
endif
endif
@@ -617,12 +597,11 @@ end subroutine PressureForce_Mont_Bouss
!> Determines the partial derivative of the acceleration due
!! to pressure forces with the free surface height.
-subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star)
+subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_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) :: e !< Interface height, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z.
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables
- real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2.
real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3.
real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface
!! and the gravitational acceleration of the planet.
@@ -631,41 +610,39 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star
intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due
!! to free surface height anomalies, in m2 H-1 s-2.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- optional, intent(in) :: rho_star !< The layer densities (maybe compressibility
- !! compensated), times g/rho_0, in m s-2.
+ optional, intent(in) :: rho_star !< The layer densities (maybe compressibility
+ !! compensated), times g/rho_0, in m2 Z-1 s-2.
+
! Local variables
- real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer
- ! thicknesses, in m-1.
+ real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses, in H-1.
real :: press(SZI_(G)) ! Interface pressure, in Pa.
real :: T_int(SZI_(G)) ! Interface temperature in C.
real :: S_int(SZI_(G)) ! Interface salinity in PSU.
real :: dR_dT(SZI_(G)) ! Partial derivatives of density with temperature
real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1.
real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer.
- real :: G_Rho0 ! g_Earth / Rho0 in m4 s-2 kg-1.
- real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-2.
+ real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1.
+ real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1.
logical :: use_EOS ! If true, density is calculated from T & S using
! an equation of state.
- real :: h_neglect ! A thickness that is so small it is usually lost
- ! in roundoff and can be neglected, in m.
+ real :: z_neglect ! A thickness that is so small it is usually lost
+ ! in roundoff and can be neglected, in Z.
integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke
- Rho0xG = Rho0*g_Earth
- G_Rho0 = g_Earth/Rho0
+ Rho0xG = Rho0*GV%g_Earth
+ G_Rho0 = GV%g_Earth / GV%Rho0
use_EOS = associated(tv%eqn_of_state)
- h_neglect = GV%H_subroundoff*GV%H_to_m
+ z_neglect = GV%H_subroundoff*GV%H_to_Z
if (use_EOS) then
if (present(rho_star)) then
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h_neglect,pbce,rho_star,&
-!$OMP GFS_scale,GV) &
-!$OMP private(Ihtot)
+ !$OMP parallel do default(shared) private(Ihtot)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
- Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H)
- pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_m
+ Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect)
+ pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_Z
enddo
do k=2,nz ; do i=Isq,Ieq+1
pbce(i,j,k) = pbce(i,j,k-1) + (rho_star(i,j,k)-rho_star(i,j,k-1)) * &
@@ -673,18 +650,16 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star
enddo ; enddo
enddo ! end of j loop
else
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,tv,h_neglect,G_Rho0,Rho0xG,&
-!$OMP pbce,GFS_scale,GV) &
-!$OMP private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS)
+ !$OMP parallel do default(shared) private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
- Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H)
+ 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)
do i=Isq,Ieq+1
- pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_m
+ pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z
enddo
do k=2,nz
do i=Isq,Ieq+1
@@ -704,15 +679,15 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star
enddo ! end of j loop
endif
else ! not use_EOS
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,GV,h_neglect,pbce) private(Ihtot)
+ !$OMP parallel do default(shared) private(Ihtot)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
- Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H)
- pbce(i,j,1) = GV%g_prime(1) * GV%H_to_m
+ Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect)
+ pbce(i,j,1) = GV%g_prime(1) * GV%H_to_Z
enddo
do k=2,nz ; do i=Isq,Ieq+1
pbce(i,j,k) = pbce(i,j,k-1) + &
- GV%g_prime(K) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i))
+ (GV%g_prime(K)*GV%H_to_Z) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i))
enddo ; enddo
enddo ! end of j loop
endif ! use_EOS
@@ -721,12 +696,11 @@ end subroutine Set_pbce_Bouss
!> Determines the partial derivative of the acceleration due
!! to pressure forces with the column mass.
-subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star)
+subroutine Set_pbce_nonBouss(p, tv, G, GV, 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, in Pa.
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables
- real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2.
real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface
!! and the gravitational acceleration of the planet.
!! Usually this ratio is 1.
@@ -759,7 +733,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star)
use_EOS = associated(tv%eqn_of_state)
- dP_dH = g_Earth * GV%H_to_kg_m2
+ dP_dH = GV%H_to_Pa
dp_neglect = dP_dH * GV%H_subroundoff
do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo
@@ -767,8 +741,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star)
if (use_EOS) then
if (present(alpha_star)) then
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,C_htot,dP_dH,p,dp_neglect, &
-!$OMP pbce,alpha_star)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
C_htot(i,j) = dP_dH / ((p(i,j,nz+1)-p(i,j,1)) + dp_neglect)
@@ -780,9 +753,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star)
enddo ; enddo
enddo
else
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv,p,C_htot, &
-!$OMP dP_dH,dp_neglect,pbce) &
-!$OMP private(T_int,S_int,dR_dT,dR_dS,rho_in_situ)
+ !$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)
@@ -808,8 +779,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star)
enddo
endif
else ! not use_EOS
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,C_htot,dP_dH,p,dp_neglect, &
-!$OMP pbce,alpha_Lay,dalpha_int)
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
C_htot(i,j) = dP_dH / ((p(i,j,nz+1)-p(i,j,1)) + dp_neglect)
@@ -824,16 +794,14 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star)
if (GFS_scale < 1.0) then
! Adjust the Montgomery potential to make this a reduced gravity model.
-!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,dpbce,GFS_scale,pbce,nz)
-!$OMP do
+ !$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
dpbce(i,j) = (GFS_scale - 1.0) * pbce(i,j,1)
enddo ; enddo
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
pbce(i,j,k) = pbce(i,j,k) + dpbce(i,j)
enddo ; enddo ; enddo
-!$OMP end parallel
endif
end subroutine Set_pbce_nonBouss
@@ -894,7 +862,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp)
if (CS%tides) then
CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, &
- Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter')
+ Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m)
endif
CS%GFS_scale = 1.0
diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90
index 672651ffb0..a27f72cae2 100644
--- a/src/core/MOM_PressureForce_analytic_FV.F90
+++ b/src/core/MOM_PressureForce_analytic_FV.F90
@@ -127,9 +127,9 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm
! the pressure anomaly at the top of the layer, in Pa m2 s-2.
real, dimension(SZI_(G),SZJ_(G)) :: &
dp, & ! The (positive) change in pressure across a layer, in Pa.
- SSH, & ! The sea surface height anomaly, in m.
+ SSH, & ! The sea surface height anomaly, in depth units (Z).
e_tidal, & ! The bottom geopotential anomaly due to tidal forces from
- ! astronomical sources and self-attraction and loading, in m.
+ ! astronomical sources and self-attraction and loading, in Z.
dM, & ! The barotropic adjustment to the Montgomery potential to
! account for a reduced gravity model, in m2 s-2.
za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the
@@ -152,6 +152,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm
real :: dp_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected, in Pa.
+ real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2.
+ real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2
real :: alpha_anom ! The in-situ specific volume, averaged over a
! layer, less alpha_ref, in m3 kg-1.
logical :: use_p_atm ! If true, use the atmospheric pressure.
@@ -165,7 +167,6 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm
real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3.
real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H).
! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2)
- real :: I_gEarth
real, parameter :: C1_6 = 1.0/6.0
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb
integer :: i, j, k
@@ -185,6 +186,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm
dp_neglect = GV%H_to_Pa * GV%H_subroundoff
alpha_ref = 1.0/CS%Rho0
+ g_Earth_z = GV%g_Earth
+ I_gEarth = 1.0 / g_Earth_z
if (use_p_atm) then
!$OMP parallel do default(shared)
@@ -202,8 +205,6 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm
p(i,j,K) = p(i,j,K-1) + GV%H_to_Pa * h(i,j,k-1)
enddo ; enddo ; enddo
- I_gEarth = 1.0 / GV%g_Earth
-
if (use_EOS) then
! With a bulk mixed layer, replace the T & S of any layers that are
! lighter than the the buffer layer with the properties of the buffer
@@ -302,7 +303,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, 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) - GV%g_Earth*G%bathyT(i,j)
+ za(i,j) = alpha_ref*p(i,j,nz+1) - g_Earth_z*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)
@@ -315,10 +316,10 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth
enddo ; enddo
- call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp)
+ call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z)
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j)
+ za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j)
enddo ; enddo
endif
@@ -402,7 +403,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm
enddo
if (present(pbce)) then
- call set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce)
+ call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce)
endif
if (present(eta)) then
@@ -451,10 +452,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p
!! calculate PFu and PFv, in H, with any tidal
!! contributions or compressibility compensation.
! Local variables
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z).
real, dimension(SZI_(G),SZJ_(G)) :: &
e_tidal, & ! The bottom geopotential anomaly due to tidal forces from
- ! astronomical sources and self-attraction and loading, in m.
+ ! astronomical sources and self-attraction and loading, in Z.
dM ! The barotropic adjustment to the Montgomery potential to
! account for a reduced gravity model, in m2 s-2.
real, dimension(SZI_(G)) :: &
@@ -488,17 +489,17 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p
real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3.
real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate
! density, in Pa (usually 2e7 Pa = 2000 dbar).
- real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa.
+ real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa.
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected, in m.
+ real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2.
real :: I_Rho0 ! 1/Rho0.
- real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1.
+ real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1.
real :: Rho_ref ! The reference density in kg m-3.
- real :: dz_neglect ! A minimal thickness in m, like e.
+ real :: dz_neglect ! A minimal thickness in Z, like e.
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, parameter :: C1_6 = 1.0/6.0
@@ -520,9 +521,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p
if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS
h_neglect = GV%H_subroundoff
- dz_neglect = GV%H_subroundoff * GV%H_to_m
+ dz_neglect = GV%H_subroundoff * GV%H_to_Z
I_Rho0 = 1.0/GV%Rho0
- G_Rho0 = GV%g_Earth/GV%Rho0
+ g_Earth_z = GV%g_Earth
+ G_Rho0 = g_Earth_z/GV%Rho0
rho_ref = CS%Rho0
if (CS%tides) then
@@ -533,33 +535,32 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
- e(i,j,1) = -1.0*G%bathyT(i,j)
+ e(i,j,1) = -G%bathyT(i,j)
enddo
do k=1,nz ; do i=Isq,Ieq+1
- e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m
+ e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z
enddo ; enddo
enddo
- call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp)
+ call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z)
endif
! Here layer interface heights, e, are calculated.
if (CS%tides) then
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j)
+ e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j))
enddo ; enddo
else
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- e(i,j,nz+1) = -1.0*G%bathyT(i,j)
+ e(i,j,nz+1) = -G%bathyT(i,j)
enddo ; enddo
endif
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1; do k=nz,1,-1 ; do i=Isq,Ieq+1
- e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m
+ e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z
enddo ; enddo ; enddo
-
if (use_EOS) then
! With a bulk mixed layer, replace the T & S of any layers that are
! lighter than the the buffer layer with the properties of the buffer
@@ -636,12 +637,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p
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) + p_atm(i,j)
+ pa(i,j) = (rho_ref*g_Earth_z)*e(i,j,1) + p_atm(i,j)
enddo ; enddo
else
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1)
+ pa(i,j) = (rho_ref*g_Earth_z)*e(i,j,1)
enddo ; enddo
endif
!$OMP parallel do default(shared)
@@ -667,32 +668,31 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p
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, &
+ rho_ref, CS%Rho0, g_Earth_z, &
dz_neglect, G%bathyT, G%HI, G%HI, &
tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, &
useMassWghtInterp = CS%useMassWghtInterp)
elseif ( CS%Recon_Scheme == 2 ) then
call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), &
tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), &
- rho_ref, CS%Rho0, GV%g_Earth, &
- G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, &
+ rho_ref, CS%Rho0, g_Earth_z, &
+ G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, &
intx_dpa, inty_dpa)
endif
else
- call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), &
- e(:,:,K), e(:,:,K+1), &
- rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, &
+ call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), &
+ rho_ref, CS%Rho0, g_Earth_z, G%HI, G%HI, tv%eqn_of_state, &
dpa, intz_dpa, intx_dpa, inty_dpa, &
G%bathyT, dz_neglect, CS%useMassWghtInterp)
endif
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- intz_dpa(i,j) = intz_dpa(i,j)*GV%m_to_H
+ intz_dpa(i,j) = intz_dpa(i,j)*GV%Z_to_H
enddo ; enddo
else
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- dz(i,j) = GV%g_Earth*GV%H_to_m*h(i,j,k)
+ dz(i,j) = g_Earth_z * GV%H_to_Z*h(i,j,k)
dpa(i,j) = (GV%Rlay(k) - rho_ref)*dz(i,j)
intz_dpa(i,j) = 0.5*(GV%Rlay(k) - rho_ref)*dz(i,j)*h(i,j,k)
enddo ; enddo
@@ -712,7 +712,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p
PFu(I,j,k) = (((pa(i,j)*h(i,j,k) + intz_dpa(i,j)) - &
(pa(i+1,j)*h(i+1,j,k) + intz_dpa(i+1,j))) + &
((h(i+1,j,k) - h(i,j,k)) * intx_pa(I,j) - &
- (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%m_to_H)) * &
+ (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%Z_to_H)) * &
((2.0*I_Rho0*G%IdxCu(I,j)) / &
((h(i,j,k) + h(i+1,j,k)) + h_neglect))
intx_pa(I,j) = intx_pa(I,j) + intx_dpa(I,j)
@@ -723,7 +723,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p
PFv(i,J,k) = (((pa(i,j)*h(i,j,k) + intz_dpa(i,j)) - &
(pa(i,j+1)*h(i,j+1,k) + intz_dpa(i,j+1))) + &
((h(i,j+1,k) - h(i,j,k)) * inty_pa(i,J) - &
- (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%m_to_H)) * &
+ (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%Z_to_H)) * &
((2.0*I_Rho0*G%IdyCv(i,J)) / &
((h(i,j,k) + h(i,j+1,k)) + h_neglect))
inty_pa(i,J) = inty_pa(i,J) + inty_dpa(i,J)
@@ -748,7 +748,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p
endif
if (present(pbce)) then
- call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce)
+ call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce)
endif
if (present(eta)) then
@@ -758,12 +758,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p
! 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%m_to_H + e_tidal(i,j)*GV%m_to_H
+ 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)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta(i,j) = e(i,j,1)*GV%m_to_H
+ eta(i,j) = e(i,j,1)*GV%Z_to_H
enddo ; enddo
endif
endif
@@ -834,7 +834,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp)
if (CS%tides) then
CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, &
- Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter')
+ Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m)
endif
CS%GFS_scale = 1.0
@@ -846,7 +846,8 @@ end subroutine PressureForce_AFV_init
!> Deallocates the finite volume pressure gradient control structure
subroutine PressureForce_AFV_end(CS)
- type(PressureForce_AFV_CS), pointer :: CS
+ type(PressureForce_AFV_CS), pointer :: CS !< Finite volume pressure control structure that
+ !! will be deallocated in this subroutine.
if (associated(CS)) deallocate(CS)
end subroutine PressureForce_AFV_end
diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90
index 1cad7d38c9..cd5961c23d 100644
--- a/src/core/MOM_PressureForce_blocked_AFV.F90
+++ b/src/core/MOM_PressureForce_blocked_AFV.F90
@@ -123,9 +123,9 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc
! the pressure anomaly at the top of the layer, in Pa m2 s-2.
real, dimension(SZI_(G),SZJ_(G)) :: &
dp, & ! The (positive) change in pressure across a layer, in Pa.
- SSH, & ! The sea surface height anomaly, in m.
+ SSH, & ! The sea surface height anomaly, in depth units (Z).
e_tidal, & ! The bottom geopotential anomaly due to tidal forces from
- ! astronomical sources and self-attraction and loading, in m.
+ ! astronomical sources and self-attraction and loading, in Z.
dM, & ! The barotropic adjustment to the Montgomery potential to
! account for a reduced gravity model, in m2 s-2.
za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the
@@ -152,6 +152,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc
real :: dp_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected, in Pa.
+ real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2.
+ real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2
real :: alpha_anom ! The in-situ specific volume, averaged over a
! layer, less alpha_ref, in m3 kg-1.
logical :: use_p_atm ! If true, use the atmospheric pressure.
@@ -164,7 +166,6 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc
real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3.
real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H).
! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2)
- real :: I_gEarth
real, parameter :: C1_6 = 1.0/6.0
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
@@ -183,6 +184,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc
dp_neglect = GV%H_to_Pa * GV%H_subroundoff
alpha_ref = 1.0/CS%Rho0
+ g_Earth_z = GV%g_Earth
+ I_gEarth = 1.0 / g_Earth_z
if (use_p_atm) then
!$OMP parallel do default(shared)
@@ -200,8 +203,6 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc
p(i,j,K) = p(i,j,K-1) + GV%H_to_Pa * h(i,j,k-1)
enddo ; enddo ; enddo
- I_gEarth = 1.0 / GV%g_Earth
-
if (use_EOS) then
! With a bulk mixed layer, replace the T & S of any layers that are
! lighter than the the buffer layer with the properties of the buffer
@@ -269,7 +270,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc
!$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) - GV%g_Earth*G%bathyT(i,j)
+ za(i,j) = alpha_ref*p(i,j,nz+1) - g_Earth_z*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)
@@ -282,10 +283,10 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth
enddo ; enddo
- call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp)
+ call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z)
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j)
+ za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j)
enddo ; enddo
endif
@@ -384,7 +385,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc
enddo
if (present(pbce)) then
- call set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce)
+ call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce)
endif
if (present(eta)) then
@@ -419,7 +420,7 @@ end subroutine PressureForce_blk_AFV_nonBouss
subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta)
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)), intent(in) :: h !< Layer thickness (kg/m2)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2)
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2)
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2)
@@ -434,10 +435,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
!! calculate PFu and PFv, in H, with any tidal
!! contributions or compressibility compensation.
! Local variables
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z).
real, dimension(SZI_(G),SZJ_(G)) :: &
e_tidal, & ! The bottom geopotential anomaly due to tidal forces from
- ! astronomical sources and self-attraction and loading, in m.
+ ! astronomical sources and self-attraction and loading, in depth units (Z).
dM ! The barotropic adjustment to the Montgomery potential to
! account for a reduced gravity model, in m2 s-2.
real, dimension(SZI_(G)) :: &
@@ -473,11 +474,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
! density, in Pa (usually 2e7 Pa = 2000 dbar).
real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa.
real :: h_neglect ! A thickness that is so small it is usually lost
- ! in roundoff and can be neglected, in m.
+ ! in roundoff and can be neglected, in H.
real :: I_Rho0 ! 1/Rho0.
- real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1.
+ real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2.
+ real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1.
real :: Rho_ref ! The reference density in kg m-3.
- real :: dz_neglect ! A minimal thickness in m, like e.
+ real :: dz_neglect ! A minimal thickness in Z, like e.
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
@@ -505,9 +507,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS
h_neglect = GV%H_subroundoff
- dz_neglect = GV%H_subroundoff * GV%H_to_m
+ dz_neglect = GV%H_subroundoff * GV%H_to_Z
I_Rho0 = 1.0/GV%Rho0
- G_Rho0 = GV%g_Earth/GV%Rho0
+ g_Earth_z = GV%g_Earth
+ G_Rho0 = g_Earth_z / GV%Rho0
rho_ref = CS%Rho0
if (CS%tides) then
@@ -518,33 +521,32 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
- e(i,j,1) = -1.0*G%bathyT(i,j)
+ e(i,j,1) = -G%bathyT(i,j)
enddo
do k=1,nz ; do i=Isq,Ieq+1
- e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m
+ e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z
enddo ; enddo
enddo
- call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp)
+ call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z)
endif
! Here layer interface heights, e, are calculated.
if (CS%tides) then
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j)
+ e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j))
enddo ; enddo
else
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- e(i,j,nz+1) = -1.0*G%bathyT(i,j)
+ e(i,j,nz+1) = -G%bathyT(i,j)
enddo ; enddo
endif
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1; do k=nz,1,-1 ; do i=Isq,Ieq+1
- e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m
+ e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z
enddo ; enddo ; enddo
-
if (use_EOS) then
! With a bulk mixed layer, replace the T & S of any layers that are
! lighter than the the buffer layer with the properties of the buffer
@@ -616,7 +618,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
endif
!$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 use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp,g_Earth_z, &
!$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, &
@@ -636,12 +638,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
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) + p_atm(i,j)
+ pa_bk(ib,jb) = (rho_ref*g_Earth_z)*e(i,j,1) + p_atm(i,j)
enddo ; enddo
else
do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1
i = ib+ioff_bk ; j = jb+joff_bk
- pa_bk(ib,jb) = (rho_ref*GV%g_Earth)*e(i,j,1)
+ pa_bk(ib,jb) = (rho_ref*g_Earth_z)*e(i,j,1)
enddo ; enddo
endif
do jb=js_bk,je_bk ; do Ib=Isq_bk,Ieq_bk
@@ -665,31 +667,30 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
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, &
+ rho_ref, CS%Rho0, g_Earth_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)
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, &
+ rho_ref, CS%Rho0, g_Earth_z, &
G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, &
intx_dpa_bk, inty_dpa_bk)
endif
else
- call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), &
- e(:,:,K), e(:,:,K+1), &
- rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, &
+ call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), &
+ rho_ref, CS%Rho0, g_Earth_z, G%HI, G%Block(n), tv%eqn_of_state, &
dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, &
G%bathyT, dz_neglect, CS%useMassWghtInterp)
endif
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%m_to_H
+ intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%Z_to_H
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
- dz_bk(ib,jb) = GV%g_Earth*GV%H_to_m*h(i,j,k)
+ dz_bk(ib,jb) = g_Earth_z*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
@@ -707,7 +708,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
PFu(I,j,k) = (((pa_bk(ib,jb)*h(i,j,k) + intz_dpa_bk(ib,jb)) - &
(pa_bk(ib+1,jb)*h(i+1,j,k) + intz_dpa_bk(ib+1,jb))) + &
((h(i+1,j,k) - h(i,j,k)) * intx_pa_bk(Ib,jb) - &
- (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%m_to_H)) * &
+ (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%Z_to_H)) * &
((2.0*I_Rho0*G%IdxCu(I,j)) / &
((h(i,j,k) + h(i+1,j,k)) + h_neglect))
intx_pa_bk(Ib,jb) = intx_pa_bk(Ib,jb) + intx_dpa_bk(Ib,jb)
@@ -718,7 +719,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
PFv(i,J,k) = (((pa_bk(ib,jb)*h(i,j,k) + intz_dpa_bk(ib,jb)) - &
(pa_bk(ib,jb+1)*h(i,j+1,k) + intz_dpa_bk(ib,jb+1))) + &
((h(i,j+1,k) - h(i,j,k)) * inty_pa_bk(ib,Jb) - &
- (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%m_to_H)) * &
+ (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%Z_to_H)) * &
((2.0*I_Rho0*G%IdyCv(i,J)) / &
((h(i,j,k) + h(i,j+1,k)) + h_neglect))
inty_pa_bk(ib,Jb) = inty_pa_bk(ib,Jb) + inty_dpa_bk(ib,Jb)
@@ -741,7 +742,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
enddo
if (present(pbce)) then
- call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce)
+ call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce)
endif
if (present(eta)) then
@@ -751,12 +752,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at
! 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%m_to_H + e_tidal(i,j)*GV%m_to_H
+ 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)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta(i,j) = e(i,j,1)*GV%m_to_H
+ eta(i,j) = e(i,j,1)*GV%Z_to_H
enddo ; enddo
endif
endif
@@ -827,7 +828,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, CS, tides_C
if (CS%tides) then
CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, &
- Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter')
+ Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m)
endif
CS%GFS_scale = 1.0
@@ -839,7 +840,8 @@ end subroutine PressureForce_blk_AFV_init
!> Deallocates the finite volume pressure gradient control structure
subroutine PressureForce_blk_AFV_end(CS)
- type(PressureForce_blk_AFV_CS), pointer :: CS
+ type(PressureForce_blk_AFV_CS), pointer :: CS !< Blocked AFV pressure control structure that
+ !! will be deallocated in this subroutine.
if (associated(CS)) deallocate(CS)
end subroutine PressureForce_blk_AFV_end
diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90
index 4c91ef2edb..17d0779ef1 100644
--- a/src/core/MOM_barotropic.F90
+++ b/src/core/MOM_barotropic.F90
@@ -1,79 +1,8 @@
+!> Baropotric solver
module MOM_barotropic
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, April 1994 - January 2007 *
-!* *
-!* This program contains the subroutines that time steps the *
-!* linearized barotropic equations. btstep is used to actually *
-!* time step the barotropic equations, and contains most of the *
-!* substance of this module. *
-!* *
-!* btstep uses a forwards-backwards based scheme to time step *
-!* the barotropic equations, returning the layers' accelerations due *
-!* to the barotropic changes in the ocean state, the final free *
-!* surface height (or column mass), and the volume (or mass) fluxes *
-!* summed through the layers and averaged over the baroclinic time *
-!* step. As input, btstep takes the initial 3-D velocities, the *
-!* inital free surface height, the 3-D accelerations of the layers, *
-!* and the external forcing. Everything in btstep is cast in terms *
-!* of anomalies, so if everything is in balance, there is explicitly *
-!* no acceleration due to btstep. *
-!* *
-!* The spatial discretization of the continuity equation is second *
-!* order accurate. A flux conservative form is used to guarantee *
-!* global conservation of volume. The spatial discretization of the *
-!* momentum equation is second order accurate. The Coriolis force *
-!* is written in a form which does not contribute to the energy *
-!* tendency and which conserves linearized potential vorticity, f/D. *
-!* These terms are exactly removed from the baroclinic momentum *
-!* equations, so the linearization of vorticity advection will not *
-!* degrade the overall solution. *
-!* *
-!* btcalc calculates the fractional thickness of each layer at the *
-!* velocity points, for later use in calculating the barotropic *
-!* velocities and the averaged accelerations. Harmonic mean *
-!* thicknesses (i.e. 2*h_L*h_R/(h_L + h_R)) are used to avoid overly *
-!* strong weighting of overly thin layers. This may later be relaxed *
-!* to use thicknesses determined from the continuity equations. *
-!* *
-!* bt_mass_source determines the real mass sources for the *
-!* barotropic solver, along with the corrective pseudo-fluxes that *
-!* keep the barotropic and baroclinic estimates of the free surface *
-!* height close to each other. Given the layer thicknesses and the *
-!* free surface height that correspond to each other, it calculates *
-!* a corrective mass source that is added to the barotropic continuity*
-!* equation, and optionally adjusts a slowly varying correction rate. *
-!* Newer algorithmic changes have deemphasized the need for this, but *
-!* it is still here to add net water sources to the barotropic solver.*
-!* *
-!* barotropic_init allocates and initializes any barotropic arrays *
-!* that have not been read from a restart file, reads parameters from *
-!* the inputfile, and sets up diagnostic fields. *
-!* *
-!* barotropic_end deallocates anything allocated in barotropic_init *
-!* or register_barotropic_restarts. *
-!* *
-!* register_barotropic_restarts is used to indicate any fields that *
-!* are private to the barotropic solver that need to be included in *
-!* the restart files, and to ensure that they are read. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q, CoriolisBu *
-!* j+1 > o > o > At ^: v_in, vbt, accel_layer_v, vbtav *
-!* j x ^ x ^ x At >: u_in, ubt, accel_layer_u, ubtav, amer *
-!* j > o > o > At o: eta, h, bathyT, pbce *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 *
-!* i i+1 *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_debugging, only : hchksum, uvchksum
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field
@@ -93,7 +22,7 @@ module MOM_barotropic
use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_segment_type
use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS
use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS
-use MOM_time_manager, only : time_type, set_time, operator(+), operator(-)
+use MOM_time_manager, only : time_type, real_to_time, operator(+), operator(-)
use MOM_variables, only : BT_cont_type, alloc_bt_cont_type
use MOM_verticalGrid, only : verticalGrid_type
@@ -128,93 +57,98 @@ module MOM_barotropic
public btcalc, bt_mass_source, btstep, barotropic_init, barotropic_end
public register_barotropic_restarts, set_dtbt
+!> The barotropic stepping open boundary condition type
type, private :: BT_OBC_type
- real, dimension(:,:), pointer :: &
- Cg_u => NULL(), & ! The external wave speed at u-points, in m s-1.
- Cg_v => NULL(), & ! The external wave speed at u-points, in m s-1.
- H_u => NULL(), & ! The total thickness at the u-points, in m or kg m-2.
- H_v => NULL(), & ! The total thickness at the v-points, in m or kg m-2.
- uhbt => NULL(), & ! The zonal and meridional barotropic thickness fluxes
- vhbt => NULL(), & ! specified for open boundary conditions (if any),
- ! in units of m3 s-1.
- ubt_outer => NULL(), & ! The zonal and meridional velocities just outside
- vbt_outer => NULL(), & ! the domain, as set by the open boundary conditions,
- ! in units of m s-1.
- eta_outer_u => NULL(), & ! The surface height outside of the domain at a
- eta_outer_v => NULL() ! u- or v- point with an open boundary condition,
- ! in units of m or kg m-2.
+ real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points, in m s-1.
+ real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points, in m s-1.
+ real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points, in m or kg m-2.
+ real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points, in m or kg m-2.
+ real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified
+ !! for open boundary conditions (if any), in units of m3 s-1.
+ real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified
+ !! for open boundary conditions (if any), in units of m3 s-1.
+ real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain,
+ !! as set by the open boundary conditions, in units of m s-1.
+ real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain,
+ !! as set by the open boundary conditions, in units of m s-1.
+ real, dimension(:,:), pointer :: eta_outer_u => NULL() !< The surface height outside of the domain
+ !! at a u-point with an open boundary condition, in units of m or kg m-2.
+ real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain
+ !! at a v-point with an open boundary condition, in units of m or kg m-2.
logical :: apply_u_OBCs !< True if this PE has an open boundary at a u-point.
logical :: apply_v_OBCs !< True if this PE has an open boundary at a v-point.
+ !>@{ Index ranges for the open boundary conditions
integer :: is_u_obc, ie_u_obc, js_u_obc, je_u_obc
integer :: is_v_obc, ie_v_obc, js_v_obc, je_v_obc
+ !!@}
logical :: is_alloced = .false. !< True if BT_OBC is in use and has been allocated
- ! for group halo pass
- type(group_pass_type) :: pass_uv
- type(group_pass_type) :: pass_uhvh
- type(group_pass_type) :: pass_h
- type(group_pass_type) :: pass_cg
- type(group_pass_type) :: pass_eta_outer
+
+ type(group_pass_type) :: pass_uv !< Structure for group halo pass
+ type(group_pass_type) :: pass_uhvh !< Structure for group halo pass
+ type(group_pass_type) :: pass_h !< Structure for group halo pass
+ type(group_pass_type) :: pass_cg !< Structure for group halo pass
+ type(group_pass_type) :: pass_eta_outer !< Structure for group halo pass
end type BT_OBC_type
+!> The barotropic stepping control stucture
type, public :: barotropic_CS ; private
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: frhatu
+ !< The fraction of the total column thickness interpolated to u grid points in each layer, nondim.
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv
- ! frhatu and frhatv are the fraction of the total column thickness
- ! interpolated to u or v grid points in each layer, nondimensional.
- real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: &
- IDatu, & !< Inverse of the basin depth at u grid points, in m-1.
- lin_drag_u, & !< A spatially varying linear drag coefficient acting
- !! on the zonal barotropic flow, in H s-1.
- uhbt_IC, & !< The barotropic solver's estimate of the zonal
- !! transport as the initial condition for the next call
- !! to btstep, in H m2 s-1.
- ubt_IC, & !< The barotropic solver's estimate of the zonal velocity
- !! that will be the initial condition for the next call
- !! to btstep, in m s-1.
- ubtav !< The barotropic zonal velocity averaged over the
- !! baroclinic time step, m s-1.
- real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: &
- IDatv, & !< Inverse of the basin depth at v grid points, in m-1.
- lin_drag_v, & !< A spatially varying linear drag coefficient acting
- !! on the zonal barotropic flow, in H s-1.
- vhbt_IC, & !< The barotropic solver's estimate of the zonal
- !! transport as the initla condition for the next call
- !! to btstep, in H m2 s-1.
- vbt_IC, & !< The barotropic solver's estimate of the zonal velocity
- !! that will be the initial condition for the next call
- !! to btstep, in m s-1.
- vbtav !< The barotropic meridional velocity averaged over the
- !! baroclinic time step, m s-1.
- real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: &
- eta_cor, & !< The difference between the free surface height from
- !! the barotropic calculation and the sum of the layer
- !! thicknesses. This difference is imposed as a forcing
- !! term in the barotropic calculation over a baroclinic
- !! timestep, in H (m or kg m-2).
- eta_cor_bound !< A limit on the rate at which eta_cor can be applied
- !! while avoiding instability, in units of H s-1. This
- !! is only used if CS%bound_BT_corr is true.
+ !< The fraction of the total column thickness interpolated to v grid points in each layer, nondim.
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu
+ !< Inverse of the basin depth at u grid points, in Z-1.
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u
+ !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1.
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_IC
+ !< The barotropic solvers estimate of the zonal transport as the initial condition for
+ !! the next call to btstep, in H m2 s-1.
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubt_IC
+ !< The barotropic solvers estimate of the zonal velocity that will be the initial
+ !! condition for the next call to btstep, in m s-1.
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav
+ !< The barotropic zonal velocity averaged over the baroclinic time step, m s-1.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv
+ !< Inverse of the basin depth at v grid points, in Z-1.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v
+ !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_IC
+ !< The barotropic solvers estimate of the zonal transport as the initial condition for
+ !! the next call to btstep, in H m2 s-1.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbt_IC
+ !< The barotropic solvers estimate of the zonal velocity that will be the initial
+ !! condition for the next call to btstep, in m s-1.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbtav
+ !< The barotropic meridional velocity averaged over the baroclinic time step, m s-1.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor
+ !< The difference between the free surface height from the barotropic calculation and the sum
+ !! of the layer thicknesses. This difference is imposed as a forcing term in the barotropic
+ !! calculation over a baroclinic timestep, in H (m or kg m-2).
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor_bound
+ !< A limit on the rate at which eta_cor can be applied while avoiding instability, in units of H s-1.
+ !! This is only used if CS%bound_BT_corr is true.
real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: &
ua_polarity, & !< Test vector components for checking grid polarity.
va_polarity, & !< Test vector components for checking grid polarity.
- bathyT !< A copy of bathyT (ocean bottom depth) with wide halos.
- real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: &
- IareaT !< This is a copy of G%IareaT with wide halos, but will
+ bathyT !< A copy of bathyT (ocean bottom depth) with wide halos, in depth units
+ real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT
+ !< This is a copy of G%IareaT with wide halos, but will
!! still utilize the macro IareaT when referenced, m-2.
real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: &
- D_u_Cor, & !< A simply averaged depth at u points, in m.
+ D_u_Cor, & !< A simply averaged depth at u points, in Z.
dy_Cu, & !< A copy of G%dy_Cu with wide halos, in m.
IdxCu !< A copy of G%IdxCu with wide halos, in m-1.
real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: &
- D_v_Cor, & !< A simply averaged depth at v points, in m.
+ D_v_Cor, & !< A simply averaged depth at v points, in Z.
dx_Cv, & !< A copy of G%dx_Cv with wide halos, in m.
IdyCv !< A copy of G%IdyCv with wide halos, in m-1.
real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: &
- q_D !< f / D at PV points, in m-1 s-1.
+ q_D !< f / D at PV points, in Z-1 s-1.
- real, dimension(:,:,:), pointer :: frhatu1 => NULL(), frhatv1 => NULL() ! Predictor values.
+ real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics.
+ real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics.
- type(BT_OBC_type) :: BT_OBC !< A structure with all of this module's fields
+ type(BT_OBC_type) :: BT_OBC !< A structure with all of this modules fields
!! for applying open boundary conditions.
real :: Rho0 !< The density used in the Boussinesq
@@ -323,7 +257,7 @@ module MOM_barotropic
logical :: use_old_coriolis_bracket_bug !< If True, use an order of operations
!! that is not bitwise rotationally symmetric in the
!! meridional Coriolis term of the barotropic solver.
- type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean models clock.
type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate
!! the timing of diagnostic output.
type(MOM_domain_type), pointer :: BT_Domain => NULL()
@@ -331,15 +265,24 @@ module MOM_barotropic
type(tidal_forcing_CS), pointer :: tides_CSp => NULL()
logical :: module_is_initialized = .false.
- integer :: isdw, iedw, jsdw, jedw ! The memory limits of the wide halo arrays.
-
- !--- for group halo pass
- type(group_pass_type) :: pass_q_DCor, pass_gtot
- type(group_pass_type) :: pass_tmp_uv, pass_eta_bt_rem
- type(group_pass_type) :: pass_force_hbt0_Cor_ref, pass_Dat_uv
- type(group_pass_type) :: pass_eta_ubt, pass_etaav, pass_ubt_Cor
- type(group_pass_type) :: pass_ubta_uhbta, pass_e_anom
-
+ integer :: isdw !< The lower i-memory limit for the wide halo arrays.
+ integer :: iedw !< The upper i-memory limit for the wide halo arrays.
+ integer :: jsdw !< The lower j-memory limit for the wide halo arrays.
+ integer :: jedw !< The upper j-memory limit for the wide halo arrays.
+
+ type(group_pass_type) :: pass_q_DCor !< Handle for a group halo pass
+ type(group_pass_type) :: pass_gtot !< Handle for a group halo pass
+ type(group_pass_type) :: pass_tmp_uv !< Handle for a group halo pass
+ type(group_pass_type) :: pass_eta_bt_rem !< Handle for a group halo pass
+ type(group_pass_type) :: pass_force_hbt0_Cor_ref !< Handle for a group halo pass
+ type(group_pass_type) :: pass_Dat_uv !< Handle for a group halo pass
+ type(group_pass_type) :: pass_eta_ubt !< Handle for a group halo pass
+ type(group_pass_type) :: pass_etaav !< Handle for a group halo pass
+ type(group_pass_type) :: pass_ubt_Cor !< Handle for a group halo pass
+ type(group_pass_type) :: pass_ubta_uhbta !< Handle for a group halo pass
+ type(group_pass_type) :: pass_e_anom !< Handle for a group halo pass
+
+ !>@{ Diagnostic IDs
integer :: id_PFu_bt = -1, id_PFv_bt = -1, id_Coru_bt = -1, id_Corv_bt = -1
integer :: id_ubtforce = -1, id_vbtforce = -1, id_uaccel = -1, id_vaccel = -1
integer :: id_visc_rem_u = -1, id_visc_rem_v = -1, id_eta_cor = -1
@@ -356,31 +299,63 @@ module MOM_barotropic
integer :: id_BTC_FA_v_NN = -1, id_BTC_FA_v_N0 = -1, id_BTC_FA_v_S0 = -1, id_BTC_FA_v_SS = -1
integer :: id_BTC_vbt_NN = -1, id_BTC_vbt_SS = -1
integer :: id_uhbt0 = -1, id_vhbt0 = -1
+ !!@}
end type barotropic_CS
+!> A desciption of the functional dependence of transport at a u-point
type, private :: local_BT_cont_u_type
- real :: FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW
- real :: ubt_EE, ubt_WW
- real :: uh_crvE, uh_crvW
- real :: uh_EE, uh_WW
+ real :: FA_u_EE !< The effective open face area for zonal barotropic transport
+ !! drawing from locations far to the east, in H m.
+ real :: FA_u_E0 !< The effective open face area for zonal barotropic transport
+ !! drawing from nearby to the east, in H m.
+ real :: FA_u_W0 !< The effective open face area for zonal barotropic transport
+ !! drawing from nearby to the west, in H m.
+ real :: FA_u_WW !< The effective open face area for zonal barotropic transport
+ !! drawing from locations far to the west, in H m.
+ real :: uBT_WW !< uBT_WW is the barotropic velocity, in m s-1, beyond which the marginal
+ !! open face area is FA_u_WW. uBT_WW must be non-negative.
+ real :: uBT_EE !< uBT_EE is a barotropic velocity, in m s-1, beyond which the marginal
+ !! open face area is FA_u_EE. uBT_EE must be non-positive.
+ real :: uh_crvW !< The curvature of face area with velocity for flow from the west, in H s2 m-1.
+ real :: uh_crvE !< The curvature of face area with velocity for flow from the east, in H s2 m-1.
+ real :: uh_WW !< The zonal transport when ubt=ubt_WW, in H m2 s-1.
+ real :: uh_EE !< The zonal transport when ubt=ubt_EE, in H m2 s-1.
end type local_BT_cont_u_type
+!> A desciption of the functional dependence of transport at a v-point
type, private :: local_BT_cont_v_type
- real :: FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS
- real :: vbt_NN, vbt_SS
- real :: vh_crvN, vh_crvS
- real :: vh_NN, vh_SS
+ real :: FA_v_NN !< The effective open face area for meridional barotropic transport
+ !! drawing from locations far to the north, in H m.
+ real :: FA_v_N0 !< The effective open face area for meridional barotropic transport
+ !! drawing from nearby to the north, in H m.
+ real :: FA_v_S0 !< The effective open face area for meridional barotropic transport
+ !! drawing from nearby to the south, in H m.
+ real :: FA_v_SS !< The effective open face area for meridional barotropic transport
+ !! drawing from locations far to the south, in H m.
+ real :: vBT_SS !< vBT_SS is the barotropic velocity, in m s-1, beyond which the marginal
+ !! open face area is FA_v_SS. vBT_SS must be non-negative.
+ real :: vBT_NN !< vBT_NN is the barotropic velocity, in m s-1, beyond which the marginal
+ !! open face area is FA_v_NN. vBT_NN must be non-positive.
+ real :: vh_crvS !< The curvature of face area with velocity for flow from the south, in H s2 m-1.
+ real :: vh_crvn !< The curvature of face area with velocity for flow from the north, in H s2 m-1.
+ real :: vh_SS !< The meridional transport when vbt=vbt_SS, in H m2 s-1.
+ real :: vh_NN !< The meridional transport when vbt=vbt_NN, in H m2 s-1.
end type local_BT_cont_v_type
+!> A container for passing around active tracer point memory limits
type, private :: memory_size_type
+ !>@{ Currently active memory limits
integer :: isdw, iedw, jsdw, jedw ! The memory limits of the wide halo arrays.
+ !!@}
end type memory_size_type
+!>@{ CPU time clock IDs
integer :: id_clock_sync=-1, id_clock_calc=-1
integer :: id_clock_calc_pre=-1, id_clock_calc_post=-1
integer :: id_clock_pass_step=-1, id_clock_pass_pre=-1, id_clock_pass_post=-1
+!!@}
-! Enumeration values for various schemes
+!>@{ Enumeration values for various schemes
integer, parameter :: HARMONIC = 1
integer, parameter :: ARITHMETIC = 2
integer, parameter :: HYBRID = 3
@@ -390,6 +365,7 @@ module MOM_barotropic
character*(20), parameter :: HARMONIC_STRING = "HARMONIC"
character*(20), parameter :: ARITHMETIC_STRING = "ARITHMETIC"
character*(20), parameter :: BT_CONT_STRING = "FROM_BT_CONT"
+!!@}
contains
@@ -520,7 +496,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points, in s-1.
PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force, in m s-2.
Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration, in m s-2.
- DCor_u, & ! A simply averaged depth at u points, in m.
+ DCor_u, & ! A simply averaged depth at u points, in Z.
Datu ! Basin depth at u-velocity grid points times the y-grid
! spacing, in H m.
real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
@@ -551,7 +527,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
! in m s-2.
Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration,
! in m s-2.
- DCor_v, & ! A simply averaged depth at v points, in m.
+ DCor_v, & ! A simply averaged depth at v points, in Z.
Datv ! Basin depth at v-velocity grid points times the x-grid
! spacing, in H m.
real, target, dimension(SZIW_(CS),SZJW_(CS)) :: &
@@ -592,7 +568,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC
- real :: I_Rho0 ! The inverse of the mean density (Rho0), in m3 kg-1.
+ real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0), in m3 kg-1.
real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim.
real :: vel_prev ! The previous velocity in m s-1.
real :: dtbt ! The barotropic time step in s.
@@ -732,7 +708,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
dtbt = dt * Instep
bebt = CS%bebt
be_proj = CS%bebt
- I_Rho0 = 1.0/GV%Rho0
+ mass_to_Z = GV%m_to_Z / GV%Rho0
!--- setup the weight when computing vbt_trans and ubt_trans
if (project_velocity) then
@@ -747,7 +723,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
(CS%id_uhbt_hifreq > 0) .or. (CS%id_vhbt_hifreq > 0)) then
do_hifreq_output = query_averaging_enabled(CS%diag, time_int_in, time_end_in)
if (do_hifreq_output) &
- time_bt_start = time_end_in - set_time(int(floor(dt+0.5)))
+ time_bt_start = time_end_in - real_to_time(dt)
endif
!--- begin setup for group halo update
@@ -839,7 +815,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
q(I,J) = 0.25 * G%CoriolisBu(I,J) * &
((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / &
((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + &
- (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))
+ (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) )
enddo ; enddo
! With very wide halos, q and D need to be calculated on the available data
@@ -996,24 +972,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
! ### IDatu here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous).
! ### although with BT_cont_types IDatu should be replaced by
! ### CS%dy_Cu(I,j) / (d(uhbt)/du) (with appropriate bounds).
- BT_force_u(I,j) = forces%taux(I,j) * I_rho0*CS%IDatu(I,j)*visc_rem_u(I,j,1)
+ BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z *CS%IDatu(I,j)*visc_rem_u(I,j,1)
enddo ; enddo
!$OMP parallel do default(shared)
do J=js-1,je ; do i=is,ie
! ### IDatv here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous).
! ### although with BT_cont_types IDatv should be replaced by
! ### CS%dx_Cv(I,j) / (d(vhbt)/dv) (with appropriate bounds).
- BT_force_v(i,J) = forces%tauy(i,J) * I_rho0*CS%IDatv(i,J)*visc_rem_v(i,J,1)
+ BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z *CS%IDatv(i,J)*visc_rem_v(i,J,1)
enddo ; enddo
if (present(taux_bot) .and. present(tauy_bot)) then
if (associated(taux_bot) .and. associated(tauy_bot)) then
!$OMP parallel do default(shared)
do j=js,je ; do I=is-1,ie
- BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * I_rho0 * CS%IDatu(I,j)
+ BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j)
enddo ; enddo
!$OMP parallel do default(shared)
do J=js-1,je ; do i=is,ie
- BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * I_rho0 * CS%IDatv(i,J)
+ BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * mass_to_Z * CS%IDatv(i,J)
enddo ; enddo
endif
endif
@@ -1315,7 +1291,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
do j=js,je ; do I=is-1,ie ; if (CS%lin_drag_u(I,j) > 0.0) then
Htot = 0.5 * (eta(i,j) + eta(i+1,j))
if (GV%Boussinesq) &
- Htot = Htot + 0.5*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j))
+ Htot = Htot + 0.5*GV%Z_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j))
bt_rem_u(I,j) = bt_rem_u(I,j) * (Htot / (Htot + CS%lin_drag_u(I,j) * dtbt))
Rayleigh_u(I,j) = CS%lin_drag_u(I,j) / Htot
@@ -1324,7 +1300,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
do J=js-1,je ; do i=is,ie ; if (CS%lin_drag_v(i,J) > 0.0) then
Htot = 0.5 * (eta(i,j) + eta(i,j+1))
if (GV%Boussinesq) &
- Htot = Htot + 0.5*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1))
+ Htot = Htot + 0.5*GV%Z_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1))
bt_rem_v(i,J) = bt_rem_v(i,J) * (Htot / (Htot + CS%lin_drag_v(i,J) * dtbt))
Rayleigh_v(i,J) = CS%lin_drag_v(i,J) / Htot
@@ -1377,7 +1353,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
! Limit the sink (inward) correction to the amount of mass that is already
! inside the cell.
Htot = eta(i,j)
- if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%m_to_H + eta(i,j)
+ if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j)
CS%eta_cor(i,j) = max(CS%eta_cor(i,j), -max(0.0,Htot))
endif
@@ -1483,7 +1459,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, 0, .true., .true.)
call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, &
G%HI, haloshift=0)
- call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0)
+ call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, scale=GV%m_to_Z)
call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, &
G%HI, haloshift=1)
endif
@@ -2032,7 +2008,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
enddo ; enddo
if (do_hifreq_output) then
- time_step_end = time_bt_start + set_time(int(floor(n*dtbt+0.5)))
+ time_step_end = time_bt_start + real_to_time(n*dtbt)
call enable_averaging(dtbt, time_step_end, CS%diag)
if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag)
if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag)
@@ -2284,21 +2260,19 @@ subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(barotropic_CS), pointer :: CS !< Barotropic control structure.
- real, dimension(SZI_(G),SZJ_(G)), &
- optional, intent(in) :: eta !< The barotropic free surface height
- !! anomaly or column mass anomaly, in H.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each
- !! layer due to free surface height
- !! anomalies, in m2 H-1 s-2.
+ real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta !< The barotropic free surface
+ !! height anomaly or column mass anomaly, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce !< The baroclinic pressure
+ !! anomaly in each layer due to free surface
+ !! height anomalies, in m2 H-1 s-2.
type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe
- !! the effective open face areas as a
- !! function of barotropic flow.
+ !! the effective open face areas as a
+ !! function of barotropic flow.
real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational
- !! acceleration, in m s-2.
+ !! acceleration, in m s-2.
real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to
- !! provide a margin of error when
- !! calculating the external wave speed, in m.
+ !! provide a margin of error when
+ !! calculating the external wave speed, in m.
! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
@@ -2349,7 +2323,7 @@ subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
elseif (CS%Nonlinear_continuity .and. present(eta)) then
call find_face_areas(Datu, Datv, G, GV, CS, MS, eta=eta, halo=0)
else
- call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH)
+ call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH*GV%m_to_Z)
endif
det_de = 0.0
@@ -2473,34 +2447,12 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
if (OBC%segment(OBC%segnum_u(I,j))%Flather) then
cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1
- ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external
h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal
H_u = BT_OBC%H_u(I,j)
vel_prev = ubt(I,j)
ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
(BT_OBC%Cg_u(I,j)/H_u) * (h_in-BT_OBC%eta_outer_u(I,j)))
vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
- elseif (OBC%segment(OBC%segnum_u(I,j))%oblique) then
- grad(I,J) = (ubt_old(I,j+1) - ubt_old(I,j)) * G%mask2dBu(I,J)
- grad(I,J-1) = (ubt_old(I,j) - ubt_old(I,j-1)) * G%mask2dBu(I,J-1)
- grad(I-1,J) = (ubt(I-1,j+1) - ubt(I-1,j)) * G%mask2dBu(I-1,J)
- grad(I-1,J-1) = (ubt(I-1,j) - ubt(I-1,j-1)) * G%mask2dBu(I-1,J-1)
- dhdt = ubt_old(I-1,j)-ubt(I-1,j) !old-new
- dhdx = ubt(I-1,j)-ubt(I-2,j) !in new time backward sasha for I-1
- if (dhdt*(grad(I-1,J) + grad(I-1,J-1)) > 0.0) then
- dhdy = grad(I-1,J-1)
- elseif (dhdt*(grad(I-1,J) + grad(I-1,J-1)) == 0.0) then
- dhdy = 0.0
- else
- dhdy = grad(I-1,J)
- endif
- if (dhdt*dhdx < 0.0) dhdt = 0.0
- Cx = min(dhdt*dhdx,rx_max) ! default to normal flow only
- cff = max(dhdx*dhdx + dhdy*dhdy, eps)
- Cy = min(cff, max(dhdt*dhdy, -cff))
- ubt(I,j) = ((cff*ubt_old(I,j) + Cx*ubt(I-1,j)) - &
- (max(Cy,0.0)*grad(I,J-1) + min(Cy,0.0)*grad(I,J))) / (cff + Cx)
- vel_trans = ubt(I,j)
elseif (OBC%segment(OBC%segnum_u(I,j))%gradient) then
ubt(I,j) = ubt(I-1,j)
vel_trans = ubt(I,j)
@@ -2509,7 +2461,6 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
if (OBC%segment(OBC%segnum_u(I,j))%Flather) then
cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1
-! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external
h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! external
H_u = BT_OBC%H_u(I,j)
@@ -2518,28 +2469,6 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
(BT_OBC%Cg_u(I,j)/H_u) * (BT_OBC%eta_outer_u(I,j)-h_in))
vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
- elseif (OBC%segment(OBC%segnum_u(I,j))%oblique) then
- grad(I,J) = (ubt_old(I,j+1) - ubt_old(I,j)) * G%mask2dBu(I,J)
- grad(I,J-1) = (ubt_old(I,j) - ubt_old(I,j-1)) * G%mask2dBu(I,J-1)
- grad(I+1,J) = (ubt(I+1,j+1) - ubt(I+1,j)) * G%mask2dBu(I+1,J)
- grad(I+1,J-1) = (ubt(I+1,j) - ubt(I+1,j-1)) * G%mask2dBu(I+1,J-1)
- dhdt = ubt_old(I+1,j)-ubt(I+1,j) !old-new
- dhdx = ubt(I+1,j)-ubt(I+2,j) !in new time backward sasha for I+1
- if (dhdt*(grad(I+1,J) + grad(I+1,J-1)) > 0.0) then
- dhdy = grad(I+1,J-1)
- elseif (dhdt*(grad(I+1,J) + grad(I+1,J-1)) == 0.0) then
- dhdy = 0.0
- else
- dhdy = grad(I+1,J)
- endif
- if (dhdt*dhdx < 0.0) dhdt = 0.0
- Cx = min(dhdt*dhdx,rx_max) ! default to normal flow only
- cff = max(dhdx*dhdx + dhdy*dhdy, eps)
- Cy = min(cff,max(dhdt*dhdy,-cff))
- ubt(I,j) = ((cff*ubt_old(I,j) + Cx*ubt(I+1,j)) - &
- (max(Cy,0.0)*grad(I,J-1) + min(Cy,0.0)*grad(I,J))) / (cff + Cx)
-! vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
- vel_trans = ubt(I,j)
elseif (OBC%segment(OBC%segnum_u(I,j))%gradient) then
ubt(I,j) = ubt(I+1,j)
vel_trans = ubt(I,j)
@@ -2568,7 +2497,6 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
if (OBC%segment(OBC%segnum_v(i,J))%Flather) then
cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL
v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1
- ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external
h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal
H_v = BT_OBC%H_v(i,J)
@@ -2577,28 +2505,6 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
(BT_OBC%Cg_v(i,J)/H_v) * (h_in-BT_OBC%eta_outer_v(i,J)))
vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
- elseif (OBC%segment(OBC%segnum_v(i,J))%oblique) then
- grad(I,J) = (vbt_old(i+1,J) - vbt_old(i,J)) * G%mask2dBu(I,J)
- grad(I-1,J) = (vbt_old(i,J) - vbt_old(i-1,J)) * G%mask2dBu(I-1,J)
- grad(I,J-1) = (vbt(i+1,J-1) - vbt(i,J-1)) * G%mask2dBu(I,J-1)
- grad(I-1,J-1) = (vbt(i,J-1) - vbt(i-1,J-1)) * G%mask2dBu(I-1,J-1)
- dhdt = vbt_old(i,J-1)-vbt(i,J-1) !old-new
- dhdy = vbt(i,J-1)-vbt(i,J-2) !in new time backward sasha for J-1
- if (dhdt*(grad(I,J-1) + grad(I-1,J-1)) > 0.0) then
- dhdx = grad(I-1,J-1)
- elseif (dhdt*(grad(I,J-1) + grad(I-1,J-1)) == 0.0) then
- dhdx = 0.0
- else
- dhdx = grad(I,J-1)
- endif
- if (dhdt*dhdy < 0.0) dhdt = 0.0
- Cy = min(dhdt*dhdy,rx_max) ! default to normal flow only
- cff = max(dhdx*dhdx + dhdy*dhdy, eps)
- Cx = min(cff,max(dhdt*dhdx,-cff))
- vbt(i,J) = ((cff*vbt_old(i,J) + Cy*vbt(i,J-1)) - &
- (max(Cx,0.0)*grad(I-1,J) + min(Cx,0.0)*grad(I,J))) / (cff + Cy)
-! vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
- vel_trans = vbt(I,j)
elseif (OBC%segment(OBC%segnum_v(i,J))%gradient) then
vbt(i,J) = vbt(i,J-1)
vel_trans = vbt(i,J)
@@ -2607,7 +2513,6 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
if (OBC%segment(OBC%segnum_v(i,J))%Flather) then
cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL
v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1
- ! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external
h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal
H_v = BT_OBC%H_v(i,J)
@@ -2616,28 +2521,6 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
(BT_OBC%Cg_v(i,J)/H_v) * (BT_OBC%eta_outer_v(i,J)-h_in))
vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
- elseif (OBC%segment(OBC%segnum_v(i,J))%oblique) then
- grad(I,J) = (vbt_old(i+1,J) - vbt_old(i,J)) * G%mask2dBu(I,J)
- grad(I-1,J) = (vbt_old(i,J) - vbt_old(i-1,J)) * G%mask2dBu(I-1,J)
- grad(I,J+1) = (vbt(i+1,J+1) - vbt(i,J+1)) * G%mask2dBu(I,J+1)
- grad(I-1,J+1) = (vbt(i,J+1) - vbt(i-1,J+1)) * G%mask2dBu(I-1,J+1)
- dhdt = vbt_old(i,J+1)-vbt(i,J+1) !old-new
- dhdy = vbt(i,J+1)-vbt(i,J+2) !in new time backward sasha for J+1
- if (dhdt*(grad(I,J+1) + grad(I-1,J+1)) > 0.0) then
- dhdx = grad(I-1,J+1)
- elseif (dhdt*(grad(I,J+1) + grad(I-1,J+1)) == 0.0) then
- dhdx = 0.0
- else
- dhdx = grad(I,J+1)
- endif
- if (dhdt*dhdy < 0.0) dhdt = 0.0
- Cy = min(dhdt*dhdy,rx_max) ! default to normal flow only
- cff = max(dhdx*dhdx + dhdy*dhdy, eps)
- Cx = min(cff,max(dhdt*dhdx,-cff))
- vbt(i,J) = ((cff*vbt_old(i,J) + Cy*vbt(i,J+1)) - &
- (max(Cx,0.0)*grad(I-1,J) + min(Cx,0.0)*grad(I,J))) / (cff + Cy)
-! vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
- vel_trans = vbt(i,J)
elseif (OBC%segment(OBC%segnum_v(i,J))%gradient) then
vbt(i,J) = vbt(i,J+1)
vel_trans = vbt(i,J)
@@ -2669,7 +2552,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co
type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
!! related to the open boundary conditions,
!! set by set_up_BT_OBC.
- type(MOM_domain_type), intent(inout) :: BT_Domain !< MOM_domain_type associated with wide arrays
+ type(MOM_domain_type), intent(inout) :: BT_Domain !< MOM_domain_type associated with wide arrays
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
integer, intent(in) :: halo !< The extra halo size to use here.
@@ -2748,21 +2631,24 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co
if (Datu(I,j) > 0.0) BT_OBC%ubt_outer(I,j) = BT_OBC%uhbt(I,j) / Datu(I,j)
endif
else ! This is assuming Flather as only other option
- BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1)*(0.5* &
- (G%bathyT(i,j) + G%bathyT(i+1,j))))
if (GV%Boussinesq) then
if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
- BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%m_to_H + eta(i,j)
+ BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j)
elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then
- BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*GV%m_to_H + eta(i+1,j)
+ BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j)
endif
else
if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
- BT_OBC%H_u(i,j) = eta(i,j)
+ BT_OBC%H_u(I,j) = eta(i,j)
+ BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + GV%m_to_Z*eta(i,j))) !### * GV%H_to_m?
elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then
- BT_OBC%H_u(i,j) = eta(i+1,j)
+ BT_OBC%H_u(I,j) = eta(i+1,j)
+ BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + GV%m_to_Z*eta(i+1,j))) !### * GV%H_to_m?
endif
endif
+ if (GV%Boussinesq) then
+ BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1)*GV%m_to_Z * BT_OBC%H_u(i,j)) !### * GV%H_to_m?
+ endif
endif
endif ; enddo ; enddo
if (OBC%Flather_u_BCs_exist_globally) then
@@ -2801,21 +2687,24 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co
if (Datv(i,J) > 0.0) BT_OBC%vbt_outer(i,J) = BT_OBC%vhbt(i,J) / Datv(i,J)
endif
else ! This is assuming Flather as only other option
- BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1)*(0.5* &
- (G%bathyT(i,j) + G%bathyT(i,j+1))))
if (GV%Boussinesq) then
if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
- BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%m_to_H + eta(i,j)
+ BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j)
elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then
- BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*GV%m_to_H + eta(i,j+1)
+ BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1)
endif
else
if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
BT_OBC%H_v(i,J) = eta(i,j)
+ BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j)*GV%m_to_Z)) !### * GV%H_to_m?
elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then
BT_OBC%H_v(i,J) = eta(i,j+1)
+ BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j+1) + eta(i,j+1)*GV%m_to_Z)) !### * GV%H_to_m?
endif
endif
+ if (GV%Boussinesq) then
+ BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1)*GV%m_to_Z * BT_OBC%H_v(i,J)) !### * GV%H_to_m?
+ endif
endif
endif ; enddo ; enddo
if (OBC%Flather_v_BCs_exist_globally) then
@@ -2874,11 +2763,9 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
type(barotropic_CS), pointer :: CS !< The control structure returned by a previous
!! call to barotropic_init.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- optional, intent(in) :: h_u !< The specified thicknesses at u-points,
- !! in m or kg m-2.
+ optional, intent(in) :: h_u !< The specified thicknesses at u-points, in m or kg m-2.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- optional, intent(in) :: h_v !< The specified thicknesses at v-points,
- !! in m or kg m-2.
+ optional, intent(in) :: h_v !< The specified thicknesses at v-points, in m or kg m-2.
logical, optional, intent(in) :: may_use_default !< An optional logical argument
!! to indicate that the default velocity point
!! thickesses may be used for this particular
@@ -2970,8 +2857,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
enddo ; enddo
elseif (CS%hvel_scheme == HYBRID .or. use_default) then
do I=is-1,ie
- e_u(I,nz+1) = -0.5 * GV%m_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j))
- D_shallow_u(I) = -GV%m_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j))
+ e_u(I,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j))
+ D_shallow_u(I) = -GV%Z_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j))
hatutot(I) = 0.0
enddo
do k=nz,1,-1 ; do I=is-1,ie
@@ -3033,8 +2920,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
enddo ; enddo
elseif (CS%hvel_scheme == HYBRID .or. use_default) then
do i=is,ie
- e_v(i,nz+1) = -0.5 * GV%m_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j))
- D_shallow_v(I) = -GV%m_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j))
+ e_v(i,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j))
+ D_shallow_v(I) = -GV%Z_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j))
hatvtot(I) = 0.0
enddo
do k=nz,1,-1 ; do i=is,ie
@@ -3632,7 +3519,8 @@ end subroutine BT_cont_to_face_areas
!> Swap the values of two real variables
subroutine swap(a,b)
- real, intent(inout) :: a, b !< The varaibles to be swapped.
+ real, intent(inout) :: a !< The first variable to be swapped.
+ real, intent(inout) :: b !< The second variable to be swapped.
real :: tmp
tmp = a ; a = b ; b = tmp
end subroutine swap
@@ -3654,7 +3542,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max)
!! or column mass anomaly, in H (m or kg m-2).
integer, optional, intent(in) :: halo !< The halo size to use, default = 1.
real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used
- !! to overestimate the external wave speed) in m.
+ !! to overestimate the external wave speed) in Z.
! Local variables
real :: H1, H2 ! Temporary total thicknesses, in m or kg m-2.
@@ -3669,14 +3557,14 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max)
if (GV%Boussinesq) then
!$OMP do
do j=js-hs,je+hs ; do I=is-1-hs,ie+hs
- H1 = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%m_to_H + eta(i+1,j)
+ H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j)
Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) &
Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2)
! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2)
enddo ; enddo
!$OMP do
do J=js-1-hs,je+hs ; do i=is-hs,ie+hs
- H1 = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%m_to_H + eta(i,j+1)
+ H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1)
Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) &
Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2)
! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2)
@@ -3700,13 +3588,13 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max)
elseif (present(add_max)) then
!$OMP do
do j=js-hs,je+hs ; do I=is-1-hs,ie+hs
- Datu(I,j) = CS%dy_Cu(I,j) * GV%m_to_H * &
- (max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max)
+ Datu(I,j) = CS%dy_Cu(I,j) * GV%Z_to_H * &
+ (max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max)
enddo ; enddo
!$OMP do
do J=js-1-hs,je+hs ; do i=is-hs,ie+hs
- Datv(i,J) = CS%dx_Cv(i,J) * GV%m_to_H * &
- (max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max)
+ Datv(i,J) = CS%dx_Cv(i,J) * GV%Z_to_H * &
+ (max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max)
enddo ; enddo
else
!$OMP do
@@ -3714,7 +3602,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max)
Datu(I, j) = 0.0
!Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain
if (CS%bathyT(i+1,j)+CS%bathyT(i,j)>0.) &
- Datu(I,j) = 2.0*CS%dy_Cu(I,j) * GV%m_to_H * &
+ Datu(I,j) = 2.0*CS%dy_Cu(I,j) * GV%Z_to_H * &
(CS%bathyT(i+1,j) * CS%bathyT(i,j)) / &
(CS%bathyT(i+1,j) + CS%bathyT(i,j))
enddo ; enddo
@@ -3723,7 +3611,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max)
Datv(i, J) = 0.0
!Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain
if (CS%bathyT(i,j+1)+CS%bathyT(i,j)>0.) &
- Datv(i,J) = 2.0*CS%dx_Cv(i,J) * GV%m_to_H * &
+ Datv(i,J) = 2.0*CS%dx_Cv(i,J) * GV%Z_to_H * &
(CS%bathyT(i,j+1) * CS%bathyT(i,j)) / &
(CS%bathyT(i,j+1) + CS%bathyT(i,j))
enddo ; enddo
@@ -3770,7 +3658,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS)
do j=js,je
do i=is,ie ; h_tot(i) = h(i,j,1) ; enddo
if (GV%Boussinesq) then
- do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*GV%m_to_H ; enddo
+ do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*GV%Z_to_H ; enddo
else
do i=is,ie ; eta_h(i) = h(i,j,1) ; enddo
endif
@@ -3844,6 +3732,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, &
! drag piston velocity.
character(len=80) :: wave_drag_var ! The wave drag piston velocity variable
! name in wave_drag_file.
+ real :: uH_rescale ! A rescaling factor for thickness transports from the representation in
+ ! a restart file to the internal representation in this run.
real, allocatable, dimension(:,:) :: lin_drag_h
type(memory_size_type) :: MS
type(group_pass_type) :: pass_static_data, pass_q_D_Cor
@@ -4070,7 +3960,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, &
"An estimate of how much higher SSH might get, for use \n"//&
"in calculating the safe external wave speed. The \n"//&
"default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", &
- units="m", default=min(10.0,0.05*G%max_depth))
+ units="m", default=min(10.0,0.05*G%max_depth*GV%Z_to_m))
call get_param(param_file, mdl, "DEBUG", CS%debug, &
"If true, write out verbose debugging data.", &
@@ -4168,7 +4058,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, &
! IareaT, IdxCu, and IdyCv need to be allocated with wide halos.
ALLOC_(CS%IareaT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IareaT(:,:) = 0.0
- ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = GV%Angstrom_z !### Change to 0.0?
+ ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = GV%Angstrom_m !### Change to 0.0?
ALLOC_(CS%IdxCu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IdxCu(:,:) = 0.0
ALLOC_(CS%IdyCv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%IdyCv(:,:) = 0.0
ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0
@@ -4177,6 +4067,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, &
CS%IareaT(i,j) = G%IareaT(i,j)
CS%bathyT(i,j) = G%bathyT(i,j)
enddo ; enddo
+
! Note: G%IdxCu & G%IdyCv may be smaller than CS%IdxCu & CS%IdyCv, even without
! wide halos.
do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB
@@ -4209,7 +4100,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, &
CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * &
((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / &
((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + &
- (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))
+ (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) )
else ! All four h points are masked out so q_D(I,J) will is meaningless
CS%q_D(I,J) = 0.
endif
@@ -4254,7 +4145,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, &
! Estimate the maximum stable barotropic time step.
gtot_estimate = 0.0
- do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K) ; enddo
+ do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K)*GV%m_to_Z ; enddo
call set_dtbt(G, GV, CS, gtot_est = gtot_estimate, SSH_add = SSH_extra)
if (dtbt_input > 0.0) then
@@ -4414,7 +4305,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, &
do J=js-1,je ; do i=is,ie
if (G%mask2dCv(i,J)>0.) then
CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%bathyT(i,j+1) + G%bathyT(i,j))
- else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless
+ else ! Both neighboring H points are masked out so IDatv(I,j) is meaningless
CS%IDatv(i,J) = 0.
endif
enddo ; enddo
@@ -4441,6 +4332,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, &
.NOT.query_initialized(CS%vhbt_IC,"vhbt_IC",restart_CS)) then
do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = CS%ubtav(I,j) * Datu(I,j) ; enddo ; enddo
do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = CS%vbtav(i,J) * Datv(i,J) ; enddo ; enddo
+ elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then
+ uH_rescale = GV%m_to_H / GV%m_to_H_restart
+ do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = uH_rescale * CS%uhbt_IC(I,j) ; enddo ; enddo
+ do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = uH_rescale * CS%vhbt_IC(I,j) ; enddo ; enddo
endif
call create_group_pass(pass_bt_hbt_btav, CS%ubt_IC, CS%vbt_IC, G%Domain)
@@ -4525,7 +4420,7 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS)
call register_restart_field(CS%vbt_IC, vd(3), .false., restart_CS)
if (GV%Boussinesq) then
- vd(2) = var_desc("uhbt_IC", "m3 s-1", &
+ vd(2) = var_desc("uhbt_IC", "m3 s-1", &
longname="Next initial condition for the barotropic zonal transport", &
hor_grid='u', z_grid='1')
vd(3) = var_desc("vhbt_IC", "m3 s-1", &
@@ -4547,4 +4442,62 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS)
end subroutine register_barotropic_restarts
+!> \namespace mom_barotropic
+!!
+!! By Robert Hallberg, April 1994 - January 2007
+!!
+!! This program contains the subroutines that time steps the
+!! linearized barotropic equations. btstep is used to actually
+!! time step the barotropic equations, and contains most of the
+!! substance of this module.
+!!
+!! btstep uses a forwards-backwards based scheme to time step
+!! the barotropic equations, returning the layers' accelerations due
+!! to the barotropic changes in the ocean state, the final free
+!! surface height (or column mass), and the volume (or mass) fluxes
+!! summed through the layers and averaged over the baroclinic time
+!! step. As input, btstep takes the initial 3-D velocities, the
+!! inital free surface height, the 3-D accelerations of the layers,
+!! and the external forcing. Everything in btstep is cast in terms
+!! of anomalies, so if everything is in balance, there is explicitly
+!! no acceleration due to btstep.
+!!
+!! The spatial discretization of the continuity equation is second
+!! order accurate. A flux conservative form is used to guarantee
+!! global conservation of volume. The spatial discretization of the
+!! momentum equation is second order accurate. The Coriolis force
+!! is written in a form which does not contribute to the energy
+!! tendency and which conserves linearized potential vorticity, f/D.
+!! These terms are exactly removed from the baroclinic momentum
+!! equations, so the linearization of vorticity advection will not
+!! degrade the overall solution.
+!!
+!! btcalc calculates the fractional thickness of each layer at the
+!! velocity points, for later use in calculating the barotropic
+!! velocities and the averaged accelerations. Harmonic mean
+!! thicknesses (i.e. 2*h_L*h_R/(h_L + h_R)) are used to avoid overly
+!! strong weighting of overly thin layers. This may later be relaxed
+!! to use thicknesses determined from the continuity equations.
+!!
+!! bt_mass_source determines the real mass sources for the
+!! barotropic solver, along with the corrective pseudo-fluxes that
+!! keep the barotropic and baroclinic estimates of the free surface
+!! height close to each other. Given the layer thicknesses and the
+!! free surface height that correspond to each other, it calculates
+!! a corrective mass source that is added to the barotropic continuity*
+!! equation, and optionally adjusts a slowly varying correction rate.
+!! Newer algorithmic changes have deemphasized the need for this, but
+!! it is still here to add net water sources to the barotropic solver.*
+!!
+!! barotropic_init allocates and initializes any barotropic arrays
+!! that have not been read from a restart file, reads parameters from
+!! the inputfile, and sets up diagnostic fields.
+!!
+!! barotropic_end deallocates anything allocated in barotropic_init
+!! or register_barotropic_restarts.
+!!
+!! register_barotropic_restarts is used to indicate any fields that
+!! are private to the barotropic solver that need to be included in
+!! the restart files, and to ensure that they are read.
+
end module MOM_barotropic
diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90
index 8d94bc12ea..fc198ead02 100644
--- a/src/core/MOM_boundary_update.F90
+++ b/src/core/MOM_boundary_update.F90
@@ -32,24 +32,25 @@ module MOM_boundary_update
public call_OBC_register, OBC_register_end
public update_OBC_data
+!> The control structure for the MOM_boundary_update module
type, public :: update_OBC_CS ; private
- logical :: use_files = .false.
- logical :: use_Kelvin = .false.
- logical :: use_tidal_bay = .false.
- logical :: use_shelfwave = .false.
- logical :: use_dyed_channel = .false.
+ logical :: use_files = .false. !< If true, use external files for the open boundary.
+ logical :: use_Kelvin = .false. !< If true, use the Kelvin wave open boundary.
+ logical :: use_tidal_bay = .false. !< If true, use the tidal_bay open boundary.
+ logical :: use_shelfwave = .false. !< If true, use the shelfwave open boundary.
+ logical :: use_dyed_channel = .false. !< If true, use the dyed channel open boundary.
+ !>@{ Pointers to the control structures for named OBC specifications
type(file_OBC_CS), pointer :: file_OBC_CSp => NULL()
type(Kelvin_OBC_CS), pointer :: Kelvin_OBC_CSp => NULL()
type(tidal_bay_OBC_CS), pointer :: tidal_bay_OBC_CSp => NULL()
type(shelfwave_OBC_CS), pointer :: shelfwave_OBC_CSp => NULL()
type(dyed_channel_OBC_CS), pointer :: dyed_channel_OBC_CSp => NULL()
+ !!@}
end type update_OBC_CS
-integer :: id_clock_pass
+integer :: id_clock_pass !< A CPU time clock ID
-character(len=40) :: mdl = "MOM_boundary_update" ! This module's name.
-! This include declares and sets the variable "version".
-#include "version_variable.h"
+! character(len=40) :: mdl = "MOM_boundary_update" ! This module's name.
contains
@@ -60,8 +61,11 @@ subroutine call_OBC_register(param_file, CS, OBC)
type(param_file_type), intent(in) :: param_file !< Parameter file to parse
type(update_OBC_CS), pointer :: CS !< Control structure for OBCs
type(ocean_OBC_type), pointer :: OBC !< Open boundary structure
- character(len=40) :: mdl = "MOM_boundary_update" ! This module's name.
+ ! Local variables
+ character(len=40) :: mdl = "MOM_boundary_update" ! This module's name.
+ ! This include declares and sets the variable "version".
+# include "version_variable.h"
if (associated(CS)) then
call MOM_error(WARNING, "call_OBC_register called with an associated "// &
"control structure.")
@@ -113,6 +117,7 @@ subroutine update_OBC_data(OBC, G, GV, tv, h, CS, Time)
type(ocean_OBC_type), pointer :: OBC !< Open boundary structure
type(update_OBC_CS), pointer :: CS !< Control structure for OBCs
type(time_type), intent(in) :: Time !< Model time
+
! Local variables
logical :: read_OBC_eta = .false.
logical :: read_OBC_uv = .false.
diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90
index 8f7685b605..d67695b8e6 100644
--- a/src/core/MOM_checksum_packages.F90
+++ b/src/core/MOM_checksum_packages.F90
@@ -1,8 +1,9 @@
+!> Provides routines that do checksums of groups of MOM variables
module MOM_checksum_packages
! This file is part of MOM6. See LICENSE.md for the license.
-! This module provdes a several routines that do check-sums of groups
+! This module provides several routines that do check-sums of groups
! of variables in the various dynamic solver routines.
use MOM_debugging, only : hchksum, uvchksum
@@ -17,6 +18,7 @@ module MOM_checksum_packages
public MOM_state_chksum, MOM_thermo_chksum, MOM_accel_chksum
public MOM_state_stats, MOM_surface_chksum
+!> Write out checksums of the MOM6 state variables
interface MOM_state_chksum
module procedure MOM_state_chksum_5arg
module procedure MOM_state_chksum_3arg
@@ -24,15 +26,18 @@ module MOM_checksum_packages
#include
-type :: stats
- private
- real :: minimum = 1.E34, maximum = -1.E34, average = 0.
+!> A type for storing statistica about a variable
+type :: stats ; private
+ real :: minimum = 1.E34 !< The minimum value
+ real :: maximum = -1.E34 !< The maximum value
+ real :: average = 0. !< The average value
end type stats
contains
! =============================================================================
+!> Write out chksums for the model's basic state variables, including transports.
subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmetric)
character(len=*), &
intent(in) :: mesg !< A message that appears on the chksum lines.
@@ -47,20 +52,11 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
intent(in) :: uh !< Volume flux through zonal faces = u*h*dy, m3 s-1.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- intent(in) :: vh !< Volume flux through meridional
- !! faces = v*h*dx, in m3 s-1.
+ intent(in) :: vh !< Volume flux through meridional faces = v*h*dx, in m3 s-1.
integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0).
logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric
!! computationoal domain.
-! This subroutine writes out chksums for the model's basic state variables.
-! Arguments: mesg - A message that appears on the chksum lines.
-! (in) u - Zonal velocity, in m s-1.
-! (in) v - Meridional velocity, in m s-1.
-! (in) h - Layer thickness, in m.
-! (in) uh - Volume flux through zonal faces = u*h*dy, m3 s-1.
-! (in) vh - Volume flux through meridional faces = v*h*dx, in m3 s-1.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
+
integer :: is, ie, js, je, nz, hs
logical :: sym
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
@@ -78,6 +74,7 @@ end subroutine MOM_state_chksum_5arg
! =============================================================================
+!> Write out chksums for the model's basic state variables.
subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric)
character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines.
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
@@ -91,15 +88,7 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric)
integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0).
logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric
!! computationoal domain.
-! This subroutine writes out chksums for the model's basic state variables.
-! Arguments: mesg - A message that appears on the chksum lines.
-! (in) u - Zonal velocity, in m s-1.
-! (in) v - Meridional velocity, in m s-1.
-! (in) h - Layer thickness, in m.
-! (in) uh - Volume flux through zonal faces = u*h*dy, m3 s-1.
-! (in) vh - Volume flux through meridional faces = v*h*dx, in m3 s-1.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
+
integer :: is, ie, js, je, nz, hs
logical :: sym
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
@@ -115,18 +104,14 @@ end subroutine MOM_state_chksum_3arg
! =============================================================================
+!> Write out chksums for the model's thermodynamic state variables.
subroutine MOM_thermo_chksum(mesg, tv, G, haloshift)
character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines.
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables.
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0).
-! This subroutine writes out chksums for the model's thermodynamic state
-! variables.
-! Arguments: mesg - A message that appears on the chksum lines.
-! (in) tv - A structure containing pointers to any thermodynamic
-! fields that are in use.
-! (in) G - The ocean's grid structure.
+
integer :: is, ie, js, je, nz, hs
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
hs=1; if (present(haloshift)) hs=haloshift
@@ -140,6 +125,7 @@ end subroutine MOM_thermo_chksum
! =============================================================================
+!> Write out chksums for the ocean surface variables.
subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric)
character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines.
type(surface), intent(inout) :: sfc !< transparent ocean surface state
@@ -149,12 +135,7 @@ subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric)
integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0).
logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric
!! computationoal domain.
-! This subroutine writes out chksums for the model's thermodynamic state
-! variables.
-! Arguments: mesg - A message that appears on the chksum lines.
-! (in) tv - A structure containing pointers to any thermodynamic
-! fields that are in use.
-! (in) G - The ocean's grid structure.
+
integer :: hs
logical :: sym
@@ -174,6 +155,7 @@ end subroutine MOM_surface_chksum
! =============================================================================
+!> Write out chksums for the model's accelerations
subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, &
u_accel_bt, v_accel_bt, symmetric)
character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines.
@@ -199,8 +181,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce,
!! the along-isopycnal stress tensor, in m s-2.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer
- !! due to free surface height anomalies, in
- !! m2 s-2 H-1.
+ !! due to free surface height anomalies, in m2 s-2 H-1.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the
!! barotropic solver,in m s-2.
@@ -210,29 +191,6 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce,
logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric
!! computationoal domain.
-! This subroutine writes out chksums for the model's accelerations.
-! Arguments: mesg - A message that appears on the chksum lines.
-! (in) CAu - Zonal acceleration due to Coriolis and momentum
-! advection terms, in m s-2.
-! (in) CAv - Meridional acceleration due to Coriolis and
-! momentum advection terms, in m s-2.
-! (in) PFu - Zonal acceleration due to pressure gradients
-! (equal to -dM/dx) in m s-2.
-! (in) PFv - Meridional acceleration due to pressure
-! gradients (equal to -dM/dy) in m s-2.
-! (in) diffu - Zonal acceleration due to convergence of the
-! along-isopycnal stress tensor, in m s-2.
-! (in) diffv - Meridional acceleration due to convergence of
-! the along-isopycnal stress tensor, in m s-2.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) pbce - the baroclinic pressure anomaly in each layer
-! due to free surface height anomalies, in m2 s-2 H-1.
-! pbce points to a space with nz layers or NULL.
-! (in) u_accel_bt - The zonal acceleration from terms in the barotropic
-! solver, in m s-2.
-! (in) v_accel_bt - The meridional acceleration from terms in the
-! barotropic solver, in m s-2.
integer :: is, ie, js, je, nz
logical :: sym
@@ -253,6 +211,7 @@ end subroutine MOM_accel_chksum
! =============================================================================
+!> Monitor and write out statistics for the model's state variables.
subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDiminishing)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines.
@@ -270,16 +229,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi
!! if the statistics change.
logical, optional, intent(in) :: permitDiminishing !< do not flag error
!!if the extrema are diminishing.
-! This subroutine monitors statistics for the model's state variables.
-! Arguments: mesg - A message that appears on the chksum lines.
-! (in) u - Zonal velocity, in m s-1.
-! (in) v - Meridional velocity, in m s-1.
-! (in) h - Layer thickness, in m.
-! (in) T - Temperature, in degree C.
-! (in) S - Salinity, in ppt.
-! (in) G - The ocean's grid structure.
-! (in) allowChange - do not flag an error if the statistics change
-! (in) permitDiminishing - do not flag an error if the extrema are diminishing
+ ! Local variables
integer :: is, ie, js, je, nz, i, j, k
real :: Vol, dV, Area, h_minimum
type(stats) :: T, S, delT, delS
diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90
index a54d7bb01f..bdf6e3f9b1 100644
--- a/src/core/MOM_continuity_PPM.F90
+++ b/src/core/MOM_continuity_PPM.F90
@@ -19,7 +19,9 @@ module MOM_continuity_PPM
public continuity_PPM, continuity_PPM_init, continuity_PPM_end, continuity_PPM_stencil
+!>@{ CPU time clock IDs
integer :: id_clock_update, id_clock_correct
+!!@}
!> Control structure for mom_continuity_ppm
type, public :: continuity_PPM_CS ; private
@@ -61,10 +63,9 @@ module MOM_continuity_PPM
!> A container for loop bounds
type :: loop_bounds_type ; private
- !>@{
- !! Loop bounds
+ !>@{ Loop bounds
integer :: ish, ieh, jsh, jeh
- !>@}
+ !!@}
end type loop_bounds_type
contains
@@ -98,37 +99,40 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
type(ocean_OBC_type), &
optional, pointer :: OBC !< Open boundaries control structure.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum originally
+ optional, intent(in) :: visc_rem_u
+ !< The fraction of zonal momentum originally
!! in a layer that remains after a time-step of viscosity, and the
!! fraction of a time-step's worth of a barotropic acceleration that
!! a layer experiences after viscosity is applied.
!! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- optional, intent(in) :: visc_rem_v !< The fraction of meridional momentum originally
+ optional, intent(in) :: visc_rem_v
+ !< The fraction of meridional momentum originally
!! in a layer that remains after a time-step of viscosity, and the
!! fraction of a time-step's worth of a barotropic acceleration that
!! a layer experiences after viscosity is applied.
!! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- optional, intent(out) :: u_cor !< The zonal velocities that give uhbt as the
- !! depth-integrated transport, in m s-1.
+ optional, intent(out) :: u_cor
+ !< The zonal velocities that give uhbt as the depth-integrated transport, in m s-1.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- optional, intent(out) :: v_cor !< The meridional velocities that give vhbt as the
- !! depth-integrated transport, in m s-1.
+ optional, intent(out) :: v_cor
+ !< The meridional velocities that give vhbt as the depth-integrated transport, in m s-1.
real, dimension(SZIB_(G),SZJ_(G)), &
- optional, intent(in) :: uhbt_aux !< A second set of summed volume fluxes
- !! through zonal faces, in H m2 s-1.
+ optional, intent(in) :: uhbt_aux
+ !< A second set of summed volume fluxes through zonal faces, in H m2 s-1.
real, dimension(SZI_(G),SZJB_(G)), &
- optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes
- !! through meridional faces, in H m2 s-1.
+ optional, intent(in) :: vhbt_aux
+ !< A second set of summed volume fluxes through meridional faces, in H m2 s-1.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- optional, intent(out) :: u_cor_aux !< The zonal velocities that give uhbt_aux
- !! as the depth-integrated transports, in m s-1.
+ optional, intent(out) :: u_cor_aux
+ !< The zonal velocities that give uhbt_aux as the depth-integrated
+ !! transports, in m s-1.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- optional, intent(out) :: v_cor_aux !< The meridional velocities that give
- !! vhbt_aux as the depth-integrated transports, in m s-1.
- type(BT_cont_type), &
- optional, pointer :: BT_cont !< A structure with elements that describe
+ optional, intent(out) :: v_cor_aux
+ !< The meridional velocities that give vhbt_aux as the depth-integrated
+ !! transports, in m s-1.
+ type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe
!! the effective open face areas as a function of barotropic flow.
! Local variables
@@ -140,7 +144,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
logical :: x_first
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
- h_min = GV%Angstrom
+ h_min = GV%Angstrom_H
if (.not.associated(CS)) call MOM_error(FATAL, &
"MOM_continuity_PPM: Module must be initialized before it is used.")
@@ -235,24 +239,26 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, &
type(ocean_OBC_type), &
optional, pointer :: OBC !< Open boundaries control structure.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum
- !! originally in a layer that remains after a time-step of viscosity,
- !! and the fraction of a time-step's worth of a barotropic acceleration that
- !! a layer experiences after viscosity is applied. Non-dimensional
- !! between 0 (at the bottom) and 1 (far above the bottom).
+ optional, intent(in) :: visc_rem_u
+ !< The fraction of zonal momentum originally in a layer that remains after a
+ !! time-step of viscosity, and the fraction of a time-step's worth of a barotropic
+ !! acceleration that a layer experiences after viscosity is applied.
+ !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
real, dimension(SZIB_(G),SZJ_(G)), &
optional, intent(in) :: uhbt !< The summed volume flux through zonal faces, H m2 s-1.
real, dimension(SZIB_(G),SZJ_(G)), &
- optional, intent(in) :: uhbt_aux !< A second set of summed volume fluxes through
- !! zonal faces, in H m2 s-1.
+ optional, intent(in) :: uhbt_aux
+ !< A second set of summed volume fluxes through zonal faces, in H m2 s-1.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction)
+ optional, intent(out) :: u_cor
+ !< The zonal velocitiess (u with a barotropic correction)
!! that give uhbt as the depth-integrated transport, m s-1.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- optional, intent(out) :: u_cor_aux !< The zonal velocities (u with a barotropic correction)
+ optional, intent(out) :: u_cor_aux
+ !< The zonal velocities (u with a barotropic correction)
!! that give uhbt_aux as the depth-integrated transports, in m s-1.
- type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the effective
- !! open face areas as a function of barotropic flow.
+ type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the
+ !! effective open face areas as a function of barotropic flow.
! Local variables
real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u, in H m.
@@ -278,7 +284,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, &
integer :: i, j, k, ish, ieh, jsh, jeh, n, nz
logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC
logical :: local_Flather_OBC, local_open_BC, is_simple
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
do_aux = (present(uhbt_aux) .and. present(u_cor_aux))
use_visc_rem = present(visc_rem_u)
@@ -287,8 +293,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, &
if (present(BT_cont)) set_BT_cont = (associated(BT_cont))
if (present(OBC)) then ; if (associated(OBC)) then
local_specified_BC = OBC%specified_u_BCs_exist_globally
- local_Flather_OBC = OBC%Flather_u_BCs_exist_globally .or. &
- OBC%Flather_v_BCs_exist_globally
+ local_Flather_OBC = OBC%Flather_u_BCs_exist_globally
local_open_BC = OBC%open_u_BCs_exist_globally
endif ; endif
ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke
@@ -307,7 +312,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, &
enddo ; enddo
else
call PPM_reconstruction_x(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, &
- 2.0*GV%Angstrom, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC)
+ 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC)
endif
do I=ish-1,ieh ; visc_rem(I,k) = 1.0 ; enddo
enddo
@@ -514,7 +519,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, &
endif
call cpu_clock_end(id_clock_correct)
- if (set_BT_cont) then ; if (associated(BT_cont%h_u)) then
+ if (set_BT_cont) then ; if (allocated(BT_cont%h_u)) then
if (present(u_cor)) then
call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt, G, LB, &
CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC)
@@ -532,10 +537,10 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, &
type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure.
real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity, in m s-1.
real, dimension(SZIB_(G)), intent(in) :: visc_rem !< Both the fraction of the
- !! momentum originally in a layer that remains after a time-step
- !! of viscosity, and the fraction of a time-step's worth of a barotropic
- !! acceleration that a layer experiences after viscosity is applied.
- !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
+ !! momentum originally in a layer that remains after a time-step
+ !! of viscosity, and the fraction of a time-step's worth of a barotropic
+ !! acceleration that a layer experiences after viscosity is applied.
+ !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
real, dimension(SZI_(G)), intent(in) :: h !< Layer thickness, in H.
real, dimension(SZI_(G)), intent(in) :: h_L !< Left thickness, in H.
real, dimension(SZI_(G)), intent(in) :: h_R !< Right thickness, in H.
@@ -613,8 +618,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, &
!! reconstruction, in H.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the
!! reconstruction, in H.
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces,
- !! in H.
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces, in H.
real, intent(in) :: dt !< Time increment in s.
type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure.
logical, intent(in) :: vol_CFL !< If true, rescale the ratio
@@ -622,10 +626,10 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, &
logical, intent(in) :: marginal !< If true, report the
!! marginal face thicknesses; otherwise report transport-averaged thicknesses.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- optional, intent(in) :: visc_rem_u !< Both the fraction of
- !! the momentum originally in a layer that remains after a time-step of
- !! viscosity, and the fraction of a time-step's worth of a barotropic
- !! acceleration that a layer experiences after viscosity is applied.
+ optional, intent(in) :: visc_rem_u
+ !< Both the fraction of the momentum originally in a layer that remains after
+ !! a time-step of viscosity, and the fraction of a time-step's worth of a
+ !! barotropic acceleration that a layer experiences after viscosity is applied.
!! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure.
@@ -721,23 +725,21 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, &
!! reconstruction, in H.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the
!! reconstruction, in H.
- real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !<
- !! Both the fraction of the momentum originally in a
- !! layer that remains after a time-step of viscosity,
- !! and the fraction of a time-step's worth of a
- !! barotropic acceleration that a layer experiences
- !! after viscosity is applied. Non-dimensional between
- !! 0 (at the bottom) and 1 (far above the bottom).
- real, dimension(SZIB_(G)), optional, intent(in) :: uhbt !<
- !! The summed volume flux through zonal faces, H m2 s-1.
+ real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the
+ !! momentum originally in a layer that remains after a time-step of viscosity, and
+ !! the fraction of a time-step's worth of a barotropic acceleration that a layer
+ !! experiences after viscosity is applied.
+ !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
+ real, dimension(SZIB_(G)), optional, intent(in) :: uhbt !< The summed volume flux
+ !! through zonal faces, H m2 s-1.
real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable
!! value of du, in m s-1.
real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable
!! value of du, in m s-1.
- real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !<
- !! The summed transport with 0 adjustment, in H m2 s-1.
- real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !<
- !! The partial derivative of du_err with du at 0 adjustment, in H m.
+ real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport
+ !! with 0 adjustment, in H m2 s-1.
+ real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative
+ !! of du_err with du at 0 adjustment, in H m.
real, dimension(SZIB_(G)), intent(out) :: du !<
!! The barotropic velocity adjustment, in m s-1.
real, intent(in) :: dt !< Time increment in s.
@@ -885,32 +887,29 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,
!! reconstruction, in H.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the
!! reconstruction, in H.
- type(BT_cont_type), intent(inout) :: BT_cont !<
- !! A structure with elements that describe the effective
- !! open face areas as a function of barotropic flow.
- real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !<
- !! The summed transport with 0 adjustment, in H m2 s-1.
- real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !<
- !! The partial derivative of du_err with du at 0 adjustment, in H m.
+ type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements
+ !! that describe the effective open face areas as a function of barotropic flow.
+ real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport
+ !! with 0 adjustment, in H m2 s-1.
+ real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative
+ !! of du_err with du at 0 adjustment, in H m.
real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable
!! value of du, in m s-1.
real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable
!! value of du, in m s-1.
real, intent(in) :: dt !< Time increment in s.
type(continuity_PPM_CS), pointer :: CS !< This module's control structure.
- real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !<
- !! Both the fraction of the momentum originally in a
- !! layer that remains after a time-step of viscosity,
- !! and the fraction of a time-step's worth of a
- !! barotropic acceleration that a layer experiences
- !! after viscosity is applied. Non-dimensional between
- !! 0 (at the bottom) and 1 (far above the bottom).
+ real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the
+ !! momentum originally in a layer that remains after a time-step of viscosity, and
+ !! the fraction of a time-step's worth of a barotropic acceleration that a layer
+ !! experiences after viscosity is applied.
+ !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
real, dimension(SZIB_(G)), intent(in) :: visc_rem_max !< Maximum allowable visc_rem.
integer, intent(in) :: j !< Spatial index.
integer, intent(in) :: ish !< Start of index range.
integer, intent(in) :: ieh !< End of index range.
- logical, dimension(SZIB_(G)), intent(in) :: do_I !<
- !! A logical flag indicating which I values to work on.
+ logical, dimension(SZIB_(G)), intent(in) :: do_I !< A logical flag indicating
+ !! which I values to work on.
! Local variables
real, dimension(SZIB_(G)) :: &
du0, & ! The barotropic velocity increment that gives 0 transport, m s-1.
@@ -1054,34 +1053,28 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, &
real, intent(in) :: dt !< Time increment in s.
type(continuity_PPM_CS), pointer :: CS !< This module's control structure.
type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure.
- type(ocean_OBC_type), optional, pointer :: OBC !<
- !! This open boundary condition type specifies whether, where,
- !! and what open boundary conditions are used.
+ type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary condition type
+ !! specifies whether, where, and what open boundary conditions are used.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- optional, intent(in) :: visc_rem_v !<
- !! Both the fraction of the momentum originally in a
- !! layer that remains after a time-step of viscosity,
- !! and the fraction of a time-step's worth of a
- !! barotropic acceleration that a layer experiences
- !! after viscosity is applied. Nondimensional between
- !! 0 (at the bottom) and 1 (far above the bottom).
- real, dimension(SZI_(G),SZJB_(G)), &
- optional, intent(in) :: vhbt !<
- !! The summed volume flux through meridional faces, H m2 s-1.
- real, dimension(SZI_(G),SZJB_(G)), &
- optional, intent(in) :: vhbt_aux !<
- !! A second set of summed volume fluxes through meridional
- !! faces, in H m2 s-1.
+ optional, intent(in) :: visc_rem_v !< Both the fraction of the momentum
+ !! originally in a layer that remains after a time-step of viscosity,
+ !! and the fraction of a time-step's worth of a barotropic acceleration
+ !! that a layer experiences after viscosity is applied. Nondimensional between
+ !! 0 (at the bottom) and 1 (far above the bottom).
+ real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through
+ !< meridional faces, H m2 s-1.
+ real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes
+ !! through meridional faces, in H m2 s-1.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- optional, intent(out) :: v_cor !<
- !! The meridional velocitiess (v with a barotropic correction)
- !! that give vhbt as the depth-integrated transport, m s-1.
+ optional, intent(out) :: v_cor
+ !< The meridional velocitiess (v with a barotropic correction)
+ !! that give vhbt as the depth-integrated transport, m s-1.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- optional, intent(out) :: v_cor_aux !<
- !! The meridional velocities (v with a barotropic correction)
- !! that give vhbt_aux as the depth-integrated transports, in m s-1.
- type(BT_cont_type), optional, pointer :: BT_cont !<
- !! A structure with elements that describe the effective
+ optional, intent(out) :: v_cor_aux
+ !< The meridional velocities (v with a barotropic correction)
+ !! that give vhbt_aux as the depth-integrated transports, in m s-1.
+ type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe
+ !! the effective open face areas as a function of barotropic flow.
! Local variables
real, dimension(SZI_(G),SZK_(G)) :: &
dvhdv ! Partial derivative of vh with v, in m2.
@@ -1108,7 +1101,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, &
integer :: i, j, k, ish, ieh, jsh, jeh, n, nz
logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC
logical :: local_Flather_OBC, is_simple, local_open_BC
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
do_aux = (present(vhbt_aux) .and. present(v_cor_aux))
use_visc_rem = present(visc_rem_v)
@@ -1117,8 +1110,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, &
if (present(BT_cont)) set_BT_cont = (associated(BT_cont))
if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then
local_specified_BC = OBC%specified_v_BCs_exist_globally
- local_Flather_OBC = OBC%Flather_u_BCs_exist_globally .or. &
- OBC%Flather_v_BCs_exist_globally
+ local_Flather_OBC = OBC%Flather_v_BCs_exist_globally
local_open_BC = OBC%open_v_BCs_exist_globally
endif ; endif ; endif
ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke
@@ -1137,7 +1129,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, &
enddo ; enddo
else
call PPM_reconstruction_y(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, &
- 2.0*GV%Angstrom, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC)
+ 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC)
endif
do i=ish,ieh ; visc_rem(i,k) = 1.0 ; enddo
enddo
@@ -1343,7 +1335,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, &
endif
call cpu_clock_end(id_clock_correct)
- if (set_BT_cont) then ; if (associated(BT_cont%h_v)) then
+ if (set_BT_cont) then ; if (allocated(BT_cont%h_v)) then
if (present(v_cor)) then
call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt, G, LB, &
CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC)
@@ -1365,16 +1357,11 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, &
!! of viscosity, and the fraction of a time-step's worth of a barotropic
!! acceleration that a layer experiences after viscosity is applied.
!! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Layer thickness used to
- !! calculate fluxes, in H.
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_L !< Left thickness in the
- !! reconstruction, in H.
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_R !< Right thickness in the
- !! reconstruction, in H.
- real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume
- !! transport, in H m2 s-1.
- real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh
- !! with v, in H m.
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, in H.
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, in H.
+ real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport, in H m2 s-1.
+ real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v, in H m.
real, intent(in) :: dt !< Time increment in s.
integer, intent(in) :: j !< Spatial index.
integer, intent(in) :: ish !< Start of index range.
@@ -1440,29 +1427,21 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, &
marginal, visc_rem_v, OBC)
type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to
- !! calculate fluxes, in H.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the
- !! reconstruction, in H.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the
- !! reconstruction, in H.
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces,
- !! in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, in H.
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, in H.
real, intent(in) :: dt !< Time increment in s.
type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure.
- logical, intent(in) :: vol_CFL !<
- !! If true, rescale the ratio of face areas to the cell
- !! areas when estimating the CFL number.
- logical, intent(in) :: marginal !<
- !! If true, report the marginal face thicknesses; otherwise
- !! report transport-averaged thicknesses.
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), optional, intent(in) :: visc_rem_v !<
- !! Both the fraction of the momentum originally in a
- !! layer that remains after a time-step of viscosity,
- !! and the fraction of a time-step's worth of a
- !! barotropic acceleration that a layer experiences
- !! after viscosity is applied. Non-dimensional between
- !! 0 (at the bottom) and 1 (far above the bottom).
+ logical, intent(in) :: vol_CFL !< If true, rescale the ratio
+ !! of face areas to the cell areas when estimating the CFL number.
+ logical, intent(in) :: marginal !< If true, report the marginal
+ !! face thicknesses; otherwise report transport-averaged thicknesses.
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), optional, intent(in) :: visc_rem_v !< Both the fraction
+ !! of the momentum originally in a layer that remains after a time-step of
+ !! viscosity, and the fraction of a time-step's worth of a barotropic
+ !! acceleration that a layer experiences after viscosity is applied.
+ !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure.
! Local variables
@@ -1560,7 +1539,8 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
intent(in) :: h_R !< Right thickness in the reconstruction, in H.
real, dimension(SZI_(G),SZK_(G)), &
- intent(in) :: visc_rem !< Both the fraction of the momentum originally
+ intent(in) :: visc_rem
+ !< Both the fraction of the momentum originally
!! in a layer that remains after a time-step of viscosity, and the
!! fraction of a time-step's worth of a barotropic acceleration that
!! a layer experiences after viscosity is applied. Non-dimensional
@@ -1712,38 +1692,30 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,
visc_rem_max, j, ish, ieh, do_I)
type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to
- !! calculate fluxes, in H.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the
- !! reconstruction, in H.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the
- !! reconstruction, in H.
- type(BT_cont_type), intent(inout) :: BT_cont !<
- !! A structure with elements that describe the effective
- !! open face areas as a function of barotropic flow.
- real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !<
- !! The summed transport with 0 adjustment, in H m2 s-1.
- real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !<
- !! The partial derivative of du_err with dv at 0 adjustment, in H m.
- real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value
- !! of dv, in m s-1.
- real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value
- !! of dv, in m s-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, in H.
+ type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements
+ !! that describe the effective open face areas as a function of barotropic flow.
+ real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport
+ !! with 0 adjustment, in H m2 s-1.
+ real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative
+ !! of du_err with dv at 0 adjustment, in H m.
+ real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv, in m s-1.
+ real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv, in m s-1.
real, intent(in) :: dt !< Time increment in s.
type(continuity_PPM_CS), pointer :: CS !< This module's control structure.
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !<
- !! Both the fraction of the momentum originally in a
- !! layer that remains after a time-step of viscosity,
- !! and the fraction of a time-step's worth of a
- !! barotropic acceleration that a layer experiences
- !! after viscosity is applied. Non-dimensional between
- !! 0 (at the bottom) and 1 (far above the bottom).
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the
+ !! momentum originally in a layer that remains after a time-step
+ !! of viscosity, and the fraction of a time-step's worth of a barotropic
+ !! acceleration that a layer experiences after viscosity is applied.
+ !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom).
real, dimension(SZI_(G)), intent(in) :: visc_rem_max !< Maximum allowable visc_rem.
integer, intent(in) :: j !< Spatial index.
integer, intent(in) :: ish !< Start of index range.
integer, intent(in) :: ieh !< End of index range.
- logical, dimension(SZI_(G)), intent(in) :: do_I !<
- !! A logical flag indicating which I values to work on.
+ logical, dimension(SZI_(G)), intent(in) :: do_I !< A logical flag indicating
+ !! which I values to work on.
! Local variables
real, dimension(SZI_(G)) :: &
dv0, & ! The barotropic velocity increment that gives 0 transport, m s-1.
@@ -1876,10 +1848,8 @@ end subroutine set_merid_BT_cont
subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_2nd, OBC)
type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure.
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H.
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_L !< Left thickness in the
- !! reconstruction, in H.
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_R !< Right thickness in the
- !! reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_L !< Left thickness in the reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_R !< Right thickness in the reconstruction, in H.
type(loop_bounds_type), intent(in) :: LB !< Active loop bounds structure.
real, intent(in) :: h_min !< The minimum thickness
!! that can be obtained by a concave parabolic fit.
@@ -1900,7 +1870,7 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_
character(len=256) :: mesg
integer :: i, j, isl, iel, jsl, jel, n, stencil
logical :: local_open_BC
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
use_CW84 = .false. ; if (present(monotonic)) use_CW84 = monotonic
use_2nd = .false. ; if (present(simple_2nd)) use_2nd = simple_2nd
@@ -2015,10 +1985,8 @@ end subroutine PPM_reconstruction_x
subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_2nd, OBC)
type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure.
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H.
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_L !< Left thickness in the
- !! reconstruction, in H.
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_R !< Right thickness in the
- !! reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_L !< Left thickness in the reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_R !< Right thickness in the reconstruction, in H.
type(loop_bounds_type), intent(in) :: LB !< Active loop bounds structure.
real, intent(in) :: h_min !< The minimum thickness
!! that can be obtained by a concave parabolic fit.
@@ -2039,7 +2007,7 @@ subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_
character(len=256) :: mesg
integer :: i, j, isl, iel, jsl, jel, n, stencil
logical :: local_open_BC
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
use_CW84 = .false. ; if (present(monotonic)) use_CW84 = monotonic
use_2nd = .false. ; if (present(simple_2nd)) use_2nd = simple_2nd
@@ -2155,10 +2123,8 @@ end subroutine PPM_reconstruction_y
subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie)
type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure.
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H.
- real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the
- !! reconstruction, in H.
- real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the
- !! reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the reconstruction, in H.
real, intent(in) :: h_min !< The minimum thickness
!! that can be obtained by a concave parabolic fit.
integer, intent(in) :: iis !< Start of i index range.
@@ -2198,10 +2164,8 @@ end subroutine PPM_limit_pos
subroutine PPM_limit_CW84(h_in, h_L, h_R, G, iis, iie, jis, jie)
type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure.
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H.
- real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the
- !! reconstruction, in H.
- real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the
- !! reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the reconstruction, in H.
+ real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the reconstruction, in H.
integer, intent(in) :: iis !< Start of i index range.
integer, intent(in) :: iie !< End of i index range.
integer, intent(in) :: jis !< Start of j index range.
@@ -2257,6 +2221,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS)
type(continuity_PPM_CS), pointer :: CS !< Module's control structure.
!> This include declares and sets the variable "version".
#include "version_variable.h"
+ real :: tol_eta_m ! An unscaled version of tol_eta, in m.
character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name.
if (associated(CS)) then
@@ -2290,8 +2255,8 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS)
"height due to the fluxes through each face. The total \n"//&
"tolerance for SSH is 4 times this value. The default \n"//&
"is 0.5*NK*ANGSTROM, and this should not be set less x\n"//&
- "than about 10^-15*MAXIMUM_DEPTH.", units="m", &
- default=0.5*G%ke*GV%Angstrom_z)
+ "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, &
+ default=0.5*G%ke*GV%Angstrom_m, unscaled=tol_eta_m)
call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, &
"The tolerance for free-surface height discrepancies \n"//&
@@ -2299,7 +2264,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS)
"layer thicknesses when calculating the auxiliary \n"//&
"corrected velocities. By default, this is the same as \n"//&
"ETA_TOLERANCE, but can be made larger for efficiency.", &
- units="m", default=CS%tol_eta)
+ units="m", default=tol_eta_m, scale=GV%m_to_H)
call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, &
"The tolerance for barotropic velocity discrepancies \n"//&
"between the barotropic solution and the sum of the \n"//&
@@ -2335,9 +2300,6 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS)
id_clock_update = cpu_clock_id('(Ocean continuity update)', grain=CLOCK_ROUTINE)
id_clock_correct = cpu_clock_id('(Ocean continuity correction)', grain=CLOCK_ROUTINE)
- CS%tol_eta = CS%tol_eta * GV%m_to_H
- CS%tol_eta_aux = CS%tol_eta_aux * GV%m_to_H
-
end subroutine continuity_PPM_init
!> continuity_PPM_stencil returns the continuity solver stencil size
diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90
index 9688ca2dcc..8ab7e0d337 100644
--- a/src/core/MOM_dynamics_split_RK2.F90
+++ b/src/core/MOM_dynamics_split_RK2.F90
@@ -30,7 +30,7 @@ module MOM_dynamics_split_RK2
use MOM_io, only : MOM_io_init, vardesc, var_desc
use MOM_restart, only : register_restart_field, query_initialized, save_restart
use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS
-use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+)
+use MOM_time_manager, only : time_type, time_type_to_real, operator(+)
use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/)
use MOM_ALE, only : ALE_CS
@@ -63,34 +63,38 @@ module MOM_dynamics_split_RK2
#include
-!> Module control structure
+!> MOM_dynamics_split_RK2 module control structure
type, public :: MOM_dyn_split_RK2_CS ; private
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: &
- CAu, & !< CAu = f*v - u.grad(u) in m s-2.
- PFu, & !< PFu = -dM/dx, in m s-2.
- diffu, & !< Zonal acceleration due to convergence of the along-isopycnal
- !! stress tensor, in m s-2.
- visc_rem_u, & !< Both the fraction of the zonal momentum originally in a
- !! layer that remains after a time-step of viscosity, and the
- !! fraction of a time-step's worth of a barotropic acceleration
- !! that a layer experiences after viscosity is applied.
- !! Nondimensional between 0 (at the bottom) and 1 (far above).
- u_accel_bt !< The layers' zonal accelerations due to the difference between
- !! the barotropic accelerations and the baroclinic accelerations
- !! that were fed into the barotopic calculation, in m s-2.
+ CAu, & !< CAu = f*v - u.grad(u) in m s-2.
+ PFu, & !< PFu = -dM/dx, in m s-2.
+ diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor, in m s-2.
+
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
- CAv, & !< CAv = -f*u - u.grad(v) in m s-2.
- PFv, & !< PFv = -dM/dy, in m s-2.
- diffv, & !< Meridional acceleration due to convergence of the
- !! along-isopycnal stress tensor, in m s-2.
- visc_rem_v, & !< Both the fraction of the meridional momentum originally in
- !! a layer that remains after a time-step of viscosity, and the
- !! fraction of a time-step's worth of a barotropic acceleration
- !! that a layer experiences after viscosity is applied.
- !! Nondimensional between 0 (at the bottom) and 1 (far above).
- v_accel_bt !< The layers' meridional accelerations due to the difference between
- !! the barotropic accelerations and the baroclinic accelerations
- !! that were fed into the barotopic calculation, in m s-2.
+ CAv, & !< CAv = -f*u - u.grad(v) in m s-2.
+ PFv, & !< PFv = -dM/dy, in m s-2.
+ diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor, in m s-2.
+
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u
+ !< Both the fraction of the zonal momentum originally in a
+ !! layer that remains after a time-step of viscosity, and the
+ !! fraction of a time-step worth of a barotropic acceleration
+ !! that a layer experiences after viscosity is applied.
+ !! Nondimensional between 0 (at the bottom) and 1 (far above).
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt
+ !< The zonal layer accelerations due to the difference between
+ !! the barotropic accelerations and the baroclinic accelerations
+ !! that were fed into the barotopic calculation, in m s-2.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v
+ !< Both the fraction of the meridional momentum originally in
+ !! a layer that remains after a time-step of viscosity, and the
+ !! fraction of a time-step worth of a barotropic acceleration
+ !! that a layer experiences after viscosity is applied.
+ !! Nondimensional between 0 (at the bottom) and 1 (far above).
+ real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt
+ !< The meridional layer accelerations due to the difference between
+ !! the barotropic accelerations and the baroclinic accelerations
+ !! that were fed into the barotopic calculation, in m s-2.
! The following variables are only used with the split time stepping scheme.
real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq
@@ -142,8 +146,9 @@ module MOM_dynamics_split_RK2
logical :: debug !< If true, write verbose checksums for debugging purposes.
logical :: debug_OBC !< If true, do debugging calls for open boundary conditions.
- logical :: module_is_initialized = .false.
+ logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed.
+ !>@{ Diagnostic IDs
integer :: id_uh = -1, id_vh = -1
integer :: id_umo = -1, id_vmo = -1
integer :: id_umo_2d = -1, id_vmo_2d = -1
@@ -153,6 +158,7 @@ module MOM_dynamics_split_RK2
! Split scheme only.
integer :: id_uav = -1, id_vav = -1
integer :: id_u_BT_accel = -1, id_v_BT_accel = -1
+ !!@}
type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
!! timing of diagnostic output.
@@ -165,31 +171,40 @@ module MOM_dynamics_split_RK2
!! which can later be used to calculate
!! derived diagnostics like energy budgets.
- ! Remainder of the structure points to child subroutines' control strings.
+ ! The remainder of the structure points to child subroutines' control structures.
+ !> A pointer to the horizontal viscosity control structure
type(hor_visc_CS), pointer :: hor_visc_CSp => NULL()
+ !> A pointer to the continuity control structure
type(continuity_CS), pointer :: continuity_CSp => NULL()
+ !> A pointer to the CoriolisAdv control structure
type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL()
+ !> A pointer to the PressureForce control structure
type(PressureForce_CS), pointer :: PressureForce_CSp => NULL()
+ !> A pointer to the barotropic stepping control structure
type(barotropic_CS), pointer :: barotropic_CSp => NULL()
+ !> A pointer to the vertical viscosity control structure
type(vertvisc_CS), pointer :: vertvisc_CSp => NULL()
+ !> A pointer to the set_visc control structure
type(set_visc_CS), pointer :: set_visc_CSp => NULL()
+ !> A pointer to the tidal forcing control structure
type(tidal_forcing_CS), pointer :: tides_CSp => NULL()
+ !> A pointer to the ALE control structure.
+ type(ALE_CS), pointer :: ALE_CSp => NULL()
type(ocean_OBC_type), pointer :: OBC => NULL() !< A pointer to an open boundary
!! condition type that specifies whether, where, and what open boundary
!! conditions are used. If no open BCs are used, this pointer stays
!! nullified. Flather OBCs use open boundary_CS as well.
+ !> A pointer to the update_OBC control structure
type(update_OBC_CS), pointer :: update_OBC_CSp => NULL()
- ! This is a copy of the pointer in the top-level control structure.
- type(ALE_CS), pointer :: ALE_CSp => NULL()
-
- ! for group halo pass
- type(group_pass_type) :: pass_eta
- type(group_pass_type) :: pass_visc_rem, pass_uvp
- type(group_pass_type) :: pass_hp_uv
- type(group_pass_type) :: pass_uv
- type(group_pass_type) :: pass_h, pass_av_uvh
+ type(group_pass_type) :: pass_eta !< Structure for group halo pass
+ type(group_pass_type) :: pass_visc_rem !< Structure for group halo pass
+ type(group_pass_type) :: pass_uvp !< Structure for group halo pass
+ type(group_pass_type) :: pass_hp_uv !< Structure for group halo pass
+ type(group_pass_type) :: pass_uv !< Structure for group halo pass
+ type(group_pass_type) :: pass_h !< Structure for group halo pass
+ type(group_pass_type) :: pass_av_uvh !< Structure for group halo pass
end type MOM_dyn_split_RK2_CS
@@ -199,11 +214,13 @@ module MOM_dynamics_split_RK2
public initialize_dyn_split_RK2
public end_dyn_split_RK2
+!>@{ CPU time clock IDs
integer :: id_clock_Cor, id_clock_pres, id_clock_vertvisc
integer :: id_clock_horvisc, id_clock_mom_update
integer :: id_clock_continuity, id_clock_thick_diff
integer :: id_clock_btstep, id_clock_btcalc, id_clock_btforce
integer :: id_clock_pass, id_clock_pass_init
+!!@}
contains
@@ -353,7 +370,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, &
BT_cont_BT_thick = .false.
if (associated(CS%BT_cont)) BT_cont_BT_thick = &
- (associated(CS%BT_cont%h_u) .and. associated(CS%BT_cont%h_v))
+ (allocated(CS%BT_cont%h_u) .and. allocated(CS%BT_cont%h_v))
if (CS%split_bottom_stress) then
taux_bot => CS%taux_bot ; tauy_bot => CS%tauy_bot
@@ -892,7 +909,7 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u
ALLOC_(CS%eta(isd:ied,jsd:jed)) ; CS%eta(:,:) = 0.0
ALLOC_(CS%u_av(IsdB:IedB,jsd:jed,nz)) ; CS%u_av(:,:,:) = 0.0
ALLOC_(CS%v_av(isd:ied,JsdB:JedB,nz)) ; CS%v_av(:,:,:) = 0.0
- ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom
+ ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom_H
thickness_units = get_thickness_units(GV)
flux_units = get_flux_units(GV)
@@ -975,6 +992,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp
character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name.
character(len=48) :: thickness_units, flux_units, eta_rest_name
+ real :: H_rescale ! A rescaling factor for thicknesses from the representation in
+ ! a restart file to the internal representation in this run.
+ real :: uH_rescale ! A rescaling factor for thickness transports from the representation in
+ ! a restart file to the internal representation in this run.
real :: H_convert
type(group_pass_type) :: pass_av_h_uvh
logical :: use_tides, debug_truncations
@@ -1093,11 +1114,14 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil
! dimensions as h, either m or kg m-3.
! CS%eta(:,:) = 0.0 already from initialization.
if (GV%Boussinesq) then
- do j=js,je ; do i=is,ie ; CS%eta(i,j) = -G%bathyT(i,j) * GV%m_to_H ; enddo ; enddo
+ do j=js,je ; do i=is,ie ; CS%eta(i,j) = -GV%Z_to_H * G%bathyT(i,j) ; enddo ; enddo
endif
do k=1,nz ; do j=js,je ; do i=is,ie
CS%eta(i,j) = CS%eta(i,j) + h(i,j,k)
enddo ; enddo ; enddo
+ elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then
+ H_rescale = GV%m_to_H / GV%m_to_H_restart
+ do j=js,je ; do i=is,ie ; CS%eta(i,j) = H_rescale * CS%eta(i,j) ; enddo ; enddo
endif
! Copy eta into an output array.
do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo
@@ -1124,8 +1148,17 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil
call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init)
CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:))
else
- if (.not. query_initialized(CS%h_av,"h2",restart_CS)) &
+ if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then
CS%h_av(:,:,:) = h(:,:,:)
+ elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then
+ H_rescale = GV%m_to_H / GV%m_to_H_restart
+ do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo
+ endif
+ if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then
+ uH_rescale = GV%m_to_H / GV%m_to_H_restart
+ do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo
+ do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo
+ endif
endif
call cpu_clock_begin(id_clock_pass_init)
diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90
index aa97b01915..430443de06 100644
--- a/src/core/MOM_dynamics_unsplit.F90
+++ b/src/core/MOM_dynamics_unsplit.F90
@@ -1,3 +1,4 @@
+!> Time steps the ocean dynamics with an unsplit quasi 3rd order scheme
module MOM_dynamics_unsplit
! This file is part of MOM6. See LICENSE.md for the license.
@@ -71,7 +72,7 @@ module MOM_dynamics_unsplit
use MOM_io, only : MOM_io_init
use MOM_restart, only : register_restart_field, query_initialized, save_restart
use MOM_restart, only : restart_init, MOM_restart_CS
-use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+)
+use MOM_time_manager, only : time_type, real_to_time, operator(+)
use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/)
use MOM_ALE, only : ALE_CS
@@ -100,80 +101,92 @@ module MOM_dynamics_unsplit
implicit none ; private
#include
+
+!> MOM_dynamics_unsplit module control structure
type, public :: MOM_dyn_unsplit_CS ; private
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: &
- CAu, & ! CAu = f*v - u.grad(u) in m s-2.
- PFu, & ! PFu = -dM/dx, in m s-2.
- diffu ! Zonal acceleration due to convergence of the along-isopycnal
- ! stress tensor, in m s-2.
+ CAu, & !< CAu = f*v - u.grad(u) in m s-2.
+ PFu, & !< PFu = -dM/dx, in m s-2.
+ diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor, in m s-2.
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
- CAv, & ! CAv = -f*u - u.grad(v) in m s-2.
- PFv, & ! PFv = -dM/dy, in m s-2.
- diffv ! Meridional acceleration due to convergence of the
- ! along-isopycnal stress tensor, in m s-2.
+ CAv, & !< CAv = -f*u - u.grad(v) in m s-2.
+ PFv, & !< PFv = -dM/dy, in m s-2.
+ diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor, in m s-2.
- real, pointer, dimension(:,:) :: taux_bot => NULL(), tauy_bot => NULL()
- ! The frictional bottom stresses from the ocean to the seafloor, in Pa.
+ real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa)
+ real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa)
- logical :: debug ! If true, write verbose checksums for debugging purposes.
+ logical :: debug !< If true, write verbose checksums for debugging purposes.
- logical :: module_is_initialized = .false.
+ logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed.
+ !>@{ Diagnostic IDs
integer :: id_uh = -1, id_vh = -1
integer :: id_PFu = -1, id_PFv = -1, id_CAu = -1, id_CAv = -1
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- type(accel_diag_ptrs), pointer :: ADp ! A structure pointing to the various
- ! accelerations in the momentum equations,
- ! which can later be used to calculate
- ! derived diagnostics like energy budgets.
- type(cont_diag_ptrs), pointer :: CDp ! A structure with pointers to various
- ! terms in the continuity equations,
- ! which can later be used to calculate
- ! derived diagnostics like energy budgets.
-! The remainder of the structure is pointers to child subroutines' control strings.
+ !!@}
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ type(accel_diag_ptrs), pointer :: ADp => NULL() !< A structure pointing to the
+ !! accelerations in the momentum equations,
+ !! which can later be used to calculate
+ !! derived diagnostics like energy budgets.
+ type(cont_diag_ptrs), pointer :: CDp => NULL() !< A structure with pointers to
+ !! various terms in the continuity equations,
+ !! which can later be used to calculate
+ !! derived diagnostics like energy budgets.
+
+ ! The remainder of the structure points to child subroutines' control structures.
+ !> A pointer to the horizontal viscosity control structure
type(hor_visc_CS), pointer :: hor_visc_CSp => NULL()
+ !> A pointer to the continuity control structure
type(continuity_CS), pointer :: continuity_CSp => NULL()
+ !> A pointer to the CoriolisAdv control structure
type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL()
+ !> A pointer to the PressureForce control structure
type(PressureForce_CS), pointer :: PressureForce_CSp => NULL()
+ !> A pointer to the vertvisc control structure
type(vertvisc_CS), pointer :: vertvisc_CSp => NULL()
+ !> A pointer to the set_visc control structure
type(set_visc_CS), pointer :: set_visc_CSp => NULL()
- type(ocean_OBC_type), pointer :: OBC => NULL() ! A pointer to an open boundary
+ !> A pointer to the tidal forcing control structure
+ type(tidal_forcing_CS), pointer :: tides_CSp => NULL()
+ !> A pointer to the ALE control structure.
+ type(ALE_CS), pointer :: ALE_CSp => NULL()
+
+ type(ocean_OBC_type), pointer :: OBC => NULL() !< A pointer to an open boundary
! condition type that specifies whether, where, and what open boundary
! conditions are used. If no open BCs are used, this pointer stays
! nullified. Flather OBCs use open boundary_CS as well.
+ !> A pointer to the update_OBC control structure
type(update_OBC_CS), pointer :: update_OBC_CSp => NULL()
- type(tidal_forcing_CS), pointer :: tides_CSp => NULL()
-
-! This is a copy of the pointer in the top-level control structure.
- type(ALE_CS), pointer :: ALE_CSp => NULL()
end type MOM_dyn_unsplit_CS
public step_MOM_dyn_unsplit, register_restarts_dyn_unsplit
public initialize_dyn_unsplit, end_dyn_unsplit
+!>@{ CPU time clock IDs
integer :: id_clock_Cor, id_clock_pres, id_clock_vertvisc
integer :: id_clock_continuity, id_clock_horvisc, id_clock_mom_update
integer :: id_clock_pass, id_clock_pass_init
+!!@}
contains
! =============================================================================
+!> Step the MOM6 dynamics using an unsplit mixed 2nd order (for continuity) and
+!! 3rd order (for the inviscid momentum equations) order scheme
subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, &
VarMix, MEKE, Waves)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: u !< The zonal velocity, in m s-1.
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- intent(inout) :: v !< The meridional velocity, in m s-1.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: h !< Layer thicknesses, in H.
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1.
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H.
!! (usually m or kg m-2).
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables.
@@ -183,70 +196,34 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
!! of the time step.
real, intent(in) :: dt !< The dynamics time step, in 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 beginning of this dynamic step, in Pa.
- real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the
- !! surface pressure at the end of this dynamic step, in Pa.
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: uh !< The zonal volume or mass transport,
+ real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface
+ !! pressure at the start of this dynamic step, in Pa.
+ real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface
+ !! pressure at the end of this dynamic step, in Pa.
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport,
!! in m3 s-1 or kg s-1.
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- intent(inout) :: vh !< The meridional volume or mass
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass
!! transport, in m3 s-1 or kg s-1.
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: uhtr !< he accumulated zonal volume or mass
- !! transport since the last tracer advection, in m3 or kg.
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- intent(inout) :: vhtr !< The accumulated meridional volume or
- !! mass transport since the last tracer advection, in m3 or kg.
- real, dimension(SZI_(G),SZJ_(G)), &
- intent(out) :: eta_av !< The time-mean free surface height or
- !! column mass, in m or kg m-2.
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or mass
+ !! transport since the last tracer advection, in m3 or kg.
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass
+ !! transport since the last tracer advection, in m3 or kg.
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or
+ !! column mass, in H (m or kg m-2).
type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by
!! initialize_dyn_unsplit.
type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields
!! that specify the spatially variable viscosities.
type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing
!! fields related to the Mesoscale Eddy Kinetic Energy.
- type(wave_parameters_CS), &
- optional, pointer :: Waves !< A pointer to a structure containing
+ type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing
!! fields related to the surface wave conditions
-! Arguments: u - The input and output zonal velocity, in m s-1.
-! (inout) v - The input and output meridional velocity, in m s-1.
-! (inout) h - The input and output layer thicknesses, in m or kg m-2,
-! depending on whether the Boussinesq approximation is made.
-! (in) tv - a structure pointing to various thermodynamic variables.
-! (inout) visc - A structure containing vertical viscosities, bottom drag
-! viscosities, and related fields.
-! (in) Time_local - The model time at the end of the time step.
-! (in) dt - The time step in s.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) p_surf_begin - A pointer (perhaps NULL) to the surface pressure
-! at the beginning of this dynamic step, in Pa.
-! (in) p_surf_end - A pointer (perhaps NULL) to the surface pressure
-! at the end of this dynamic step, in Pa.
-! (inout) uh - The zonal volume or mass transport, in m3 s-1 or kg s-1.
-! (inout) vh - The meridional volume or mass transport, in m3 s-1 or kg s-1.
-! (inout) uhtr - The accumulated zonal volume or mass transport since the last
-! tracer advection, in m3 or kg.
-! (inout) vhtr - The accumulated meridional volume or mass transport since the last
-! tracer advection, in m3 or kg.
-! (out) eta_av - The time-mean free surface height or column mass, in m or
-! kg m-2.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure set up by initialize_dyn_unsplit.
-! (in) VarMix - A pointer to a structure with fields that specify the
-! spatially variable viscosities.
-! (inout) MEKE - A pointer to a structure containing fields related to
-! the Mesoscale Eddy Kinetic Energy.
-
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp
real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp
- real, dimension(:,:), pointer :: p_surf
+ real, dimension(:,:), pointer :: p_surf => NULL()
real :: dt_pred ! The time step for the predictor part of the baroclinic
! time stepping.
logical :: dyn_p_surf
@@ -290,7 +267,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
call pass_var(hp, G%Domain, clock=id_clock_pass)
call pass_vector(uh, vh, G%Domain, clock=id_clock_pass)
- call enable_averaging(0.5*dt,Time_local-set_time(int(0.5*dt)), CS%diag)
+ call enable_averaging(0.5*dt,Time_local-real_to_time(0.5*dt), CS%diag)
! Here the first half of the thickness fluxes are offered for averaging.
if (CS%id_uh > 0) call post_data(CS%id_uh, uh, CS%diag)
if (CS%id_vh > 0) call post_data(CS%id_vh, vh, CS%diag)
@@ -514,7 +491,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
endif
if (GV%Boussinesq) then
- do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%bathyT(i,j) ; enddo ; enddo
+ do j=js,je ; do i=is,ie ; eta_av(i,j) = -GV%Z_to_H*G%bathyT(i,j) ; enddo ; enddo
else
do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo
endif
@@ -535,6 +512,11 @@ end subroutine step_MOM_dyn_unsplit
! =============================================================================
+!> Allocate the control structure for this module, allocates memory in it, and registers
+!! any auxiliary restart variables that are specific to the unsplit time stepping scheme.
+!!
+!! All variables registered here should have the ability to be recreated if they are not present
+!! in a restart file.
subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -544,24 +526,14 @@ subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS)
!! initialize_dyn_unsplit.
type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure.
-! This subroutine sets up any auxiliary restart variables that are specific
-! to the unsplit time stepping scheme. All variables registered here should
-! have the ability to be recreated if they are not present in a restart file.
-
-! Arguments: HI - A horizontal index type structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (inout) CS - The control structure set up by initialize_dyn_unsplit.
-! (inout) restart_CS - A pointer to the restart control structure.
-
+ ! Local arguments
character(len=40) :: mdl = "MOM_dynamics_unsplit" ! This module's name.
character(len=48) :: thickness_units, flux_units
integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB
isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke
IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB
-! This is where a control structure that is specific to this module would be allocated.
+ ! This is where a control structure that is specific to this module is allocated.
if (associated(CS)) then
call MOM_error(WARNING, "register_restarts_dyn_unsplit called with an associated "// &
"control structure.")
@@ -583,6 +555,7 @@ subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS)
end subroutine register_restarts_dyn_unsplit
+!> Initialize parameters and allocate memory associated with the unsplit dynamics module.
subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, &
restart_CS, Accel_diag, Cont_diag, MIS, &
OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, &
@@ -634,39 +607,10 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, &
!! records the number of times the velocity
!! is truncated (this should be 0).
-! Arguments: u - The zonal velocity, in m s-1.
-! (inout) v - The meridional velocity, in m s-1.
-! (inout) h - The layer thicknesses, in m or kg m-2, depending on whether
-! the Boussinesq approximation is made.
-! (in) Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (inout) CS - The control structure set up by initialize_dyn_unsplit.
-! (in) restart_CS - A pointer to the restart control structure.
-! (inout) Accel_diag - A set of pointers to the various accelerations in
-! the momentum equations, which can be used for later derived
-! diagnostics, like energy budgets.
-! (inout) Cont_diag - A structure with pointers to various terms in the
-! continuity equations.
-! (inout) MIS - The "MOM6 Internal State" structure, used to pass around
-! pointers to various arrays for diagnostic purposes.
-! (in) OBC - If open boundary conditions are used, this points to the
-! ocean_OBC_type that was set up in MOM_initialization.
-! (in) update_OBC_CSp - If open boundary condition updates are used,
-! this points to the appropriate control structure.
-! (in) ALE_CS - This points to the ALE control structure.
-! (in) setVisc_CSp - This points to the set_visc control structure.
-! (inout) visc - A structure containing vertical viscosities, bottom drag
-! viscosities, and related fields.
-! (in) dirs - A structure containing several relevant directory paths.
-! (in) ntrunc - A target for the variable that records the number of times
-! the velocity is truncated (this should be 0).
-
! This subroutine initializes all of the variables that are used by this
! dynamic core, including diagnostics and the cpu clocks.
+
+ ! Local variables
character(len=40) :: mdl = "MOM_dynamics_unsplit" ! This module's name.
character(len=48) :: thickness_units, flux_units
real :: H_convert
@@ -748,9 +692,10 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, &
end subroutine initialize_dyn_unsplit
+!> Clean up and deallocate memory associated with the unsplit dynamics module.
subroutine end_dyn_unsplit(CS)
- type(MOM_dyn_unsplit_CS), pointer :: CS
-! (inout) CS - The control structure set up by initialize_dyn_unsplit.
+ type(MOM_dyn_unsplit_CS), pointer :: CS !< unsplit dynamics control structure that
+ !! will be deallocated in this subroutine.
DEALLOC_(CS%diffu) ; DEALLOC_(CS%diffv)
DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv)
diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90
index 87759b0575..3a5db102f2 100644
--- a/src/core/MOM_dynamics_unsplit_RK2.F90
+++ b/src/core/MOM_dynamics_unsplit_RK2.F90
@@ -1,3 +1,4 @@
+!> Time steps the ocean dynamics with an unsplit quasi 2nd order Runge-Kutta scheme
module MOM_dynamics_unsplit_RK2
! This file is part of MOM6. See LICENSE.md for the license.
@@ -69,7 +70,7 @@ module MOM_dynamics_unsplit_RK2
use MOM_io, only : MOM_io_init
use MOM_restart, only : register_restart_field, query_initialized, save_restart
use MOM_restart, only : restart_init, MOM_restart_CS
-use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+)
+use MOM_time_manager, only : time_type, time_type_to_real, operator(+)
use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/)
use MOM_ALE, only : ALE_CS
@@ -97,93 +98,102 @@ module MOM_dynamics_unsplit_RK2
#include
+!> MOM_dynamics_unsplit_RK2 module control structure
type, public :: MOM_dyn_unsplit_RK2_CS ; private
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: &
- CAu, & ! CAu = f*v - u.grad(u) in m s-2.
- PFu, & ! PFu = -dM/dx, in m s-2.
- diffu ! Zonal acceleration due to convergence of the along-isopycnal
- ! stress tensor, in m s-2.
- real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
- CAv, & ! CAv = -f*u - u.grad(v) in m s-2.
- PFv, & ! PFv = -dM/dy, in m s-2.
- diffv ! Meridional acceleration due to convergence of the
- ! along-isopycnal stress tensor, in m s-2.
+ CAu, & !< CAu = f*v - u.grad(u) in m s-2.
+ PFu, & !< PFu = -dM/dx, in m s-2.
+ diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor, in m s-2.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
+ CAv, & !< CAv = -f*u - u.grad(v) in m s-2.
+ PFv, & !< PFv = -dM/dy, in m s-2.
+ diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor, in m s-2.
- real, pointer, dimension(:,:) :: taux_bot => NULL(), tauy_bot => NULL()
- ! The frictional bottom stresses from the ocean to the seafloor, in Pa.
+ real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa)
+ real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa)
- real :: be ! A nondimensional number from 0.5 to 1 that controls
- ! the backward weighting of the time stepping scheme.
- real :: begw ! A nondimensional number from 0 to 1 that controls
- ! the extent to which the treatment of gravity waves
- ! is forward-backward (0) or simulated backward
- ! Euler (1). 0 is almost always used.
- logical :: debug ! If true, write verbose checksums for debugging purposes.
+ real :: be !< A nondimensional number from 0.5 to 1 that controls
+ !! the backward weighting of the time stepping scheme.
+ real :: begw !< A nondimensional number from 0 to 1 that controls
+ !! the extent to which the treatment of gravity waves
+ !! is forward-backward (0) or simulated backward
+ !! Euler (1). 0 is almost always used.
+ logical :: debug !< If true, write verbose checksums for debugging purposes.
- logical :: module_is_initialized = .false.
+ logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed.
+ !>@{ Diagnostic IDs
integer :: id_uh = -1, id_vh = -1
integer :: id_PFu = -1, id_PFv = -1, id_CAu = -1, id_CAv = -1
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- type(accel_diag_ptrs), pointer :: ADp ! A structure pointing to the various
- ! accelerations in the momentum equations,
- ! which can later be used to calculate
- ! derived diagnostics like energy budgets.
- type(cont_diag_ptrs), pointer :: CDp ! A structure with pointers to various
- ! terms in the continuity equations,
- ! which can later be used to calculate
- ! derived diagnostics like energy budgets.
-
-! The remainder of the structure is pointers to child subroutines' control strings.
+ !!@}
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ type(accel_diag_ptrs), pointer :: ADp => NULL() !< A structure pointing to the
+ !! accelerations in the momentum equations,
+ !! which can later be used to calculate
+ !! derived diagnostics like energy budgets.
+ type(cont_diag_ptrs), pointer :: CDp => NULL() !< A structure with pointers to
+ !! various terms in the continuity equations,
+ !! which can later be used to calculate
+ !! derived diagnostics like energy budgets.
+
+ ! The remainder of the structure points to child subroutines' control structures.
+ !> A pointer to the horizontal viscosity control structure
type(hor_visc_CS), pointer :: hor_visc_CSp => NULL()
+ !> A pointer to the continuity control structure
type(continuity_CS), pointer :: continuity_CSp => NULL()
+ !> A pointer to the CoriolisAdv control structure
type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL()
+ !> A pointer to the PressureForce control structure
type(PressureForce_CS), pointer :: PressureForce_CSp => NULL()
+ !> A pointer to the vertvisc control structure
type(vertvisc_CS), pointer :: vertvisc_CSp => NULL()
+ !> A pointer to the set_visc control structure
type(set_visc_CS), pointer :: set_visc_CSp => NULL()
- type(ocean_OBC_type), pointer :: OBC => NULL() ! A pointer to an open boundary
- ! condition type that specifies whether, where, and what open boundary
- ! conditions are used. If no open BCs are used, this pointer stays
- ! nullified. Flather OBCs use open boundary_CS as well.
+ !> A pointer to the tidal forcing control structure
type(tidal_forcing_CS), pointer :: tides_CSp => NULL()
- type(update_OBC_CS), pointer :: update_OBC_CSp => NULL()
-
-! This is a copy of the pointer in the top-level control structure.
+ !> A pointer to the ALE control structure.
type(ALE_CS), pointer :: ALE_CSp => NULL()
+ type(ocean_OBC_type), pointer :: OBC => NULL() !< A pointer to an open boundary
+ !! condition type that specifies whether, where, and what open boundary
+ !! conditions are used. If no open BCs are used, this pointer stays
+ !! nullified. Flather OBCs use open boundary_CS as well.
+ !> A pointer to the update_OBC control structure
+ type(update_OBC_CS), pointer :: update_OBC_CSp => NULL()
+
end type MOM_dyn_unsplit_RK2_CS
public step_MOM_dyn_unsplit_RK2, register_restarts_dyn_unsplit_RK2
public initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2
+!>@{ CPU time clock IDs
integer :: id_clock_Cor, id_clock_pres, id_clock_vertvisc
integer :: id_clock_horvisc, id_clock_continuity, id_clock_mom_update
integer :: id_clock_pass, id_clock_pass_init
+!!@}
contains
! =============================================================================
+!> Step the MOM6 dynamics using an unsplit quasi-2nd order Runge-Kutta scheme
subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, forces, &
p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, &
VarMix, MEKE)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid
!! structure.
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: u_in !< The input and output zonal
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_in !< The input and output zonal
!! velocity, in m s-1.
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- intent(inout) :: v_in !< The input and output meridional
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in !< The input and output meridional
!! velocity, in m s-1.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: h_in !< The input and output layer
- !! thicknesses, in m or kg m-2, depending on
- !! whether the Boussinesq approximation is made.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_in !< The input and output layer thicknesses,
+ !! in m or kg m-2, depending on whether
+ !! the Boussinesq approximation is made.
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables.
type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical
@@ -195,27 +205,23 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt,
!! in 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 beginning
- !! of this dynamic step, in Pa.
+ !! the surface pressure at the beginning
+ !! of this dynamic step, in Pa.
real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to
!! the surface pressure at the end of
!! this dynamic step, in Pa.
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: uh !< The zonal volume or mass transport,
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport,
!! in m3 s-1 or kg s-1.
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- intent(inout) :: vh !< The meridional volume or mass
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass
!! transport, in m3 s-1 or kg s-1.
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: uhtr !< The accumulated zonal volume or
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or
!! mass transport since the last
!! tracer advection, in m3 or kg.
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- intent(inout) :: vhtr !< The accumulated meridional volume
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume
!! or mass transport since the last
!! tracer advection, in m3 or kg.
real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height
- !! or column mass, in m or kg m-2.
+ !! or column mass, in H (m or kg m-2).
type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by
!! initialize_dyn_unsplit_RK2.
type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with
@@ -224,41 +230,12 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt,
type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing
!! fields related to the Mesoscale
!! Eddy Kinetic Energy.
-! Arguments: u_in - The input and output zonal velocity, in m s-1.
-! (inout) v_in - The input and output meridional velocity, in m s-1.
-! (inout) h_in - The input and output layer thicknesses, in m or kg m-2,
-! depending on whether the Boussinesq approximation is made.
-! (in) tv - a structure pointing to various thermodynamic variables.
-! (inout) visc - A structure containing vertical viscosities, bottom drag
-! viscosities, and related fields.
-! (in) Time_local - The model time at the end of the time step.
-! (in) dt - The time step in s.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) p_surf_begin - A pointer (perhaps NULL) to the surface pressure
-! at the beginning of this dynamic step, in Pa.
-! (in) p_surf_end - A pointer (perhaps NULL) to the surface pressure
-! at the end of this dynamic step, in Pa.
-! (inout) uh - The zonal volume or mass transport, in m3 s-1 or kg s-1.
-! (inout) vh - The meridional volume or mass transport, in m3 s-1 or kg s-1.
-! (inout) uhtr - The accumulated zonal volume or mass transport since the last
-! tracer advection, in m3 or kg.
-! (inout) vhtr - The accumulated meridional volume or mass transport since the last
-! tracer advection, in m3 or kg.
-! (out) eta_av - The time-mean free surface height or column mass, in m or
-! kg m-2.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure set up by initialize_dyn_unsplit_RK2.
-! (in) VarMix - A pointer to a structure with fields that specify the
-! spatially variable viscosities.
-! (inout) MEKE - A pointer to a structure containing fields related to
-! the Mesoscale Eddy Kinetic Energy.
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up
real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp
- real, dimension(:,:), pointer :: p_surf
+ real, dimension(:,:), pointer :: p_surf => NULL()
real :: dt_pred ! The time step for the predictor part of the baroclinic
! time stepping.
logical :: dyn_p_surf
@@ -454,7 +431,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt,
endif
if (GV%Boussinesq) then
- do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%bathyT(i,j) ; enddo ; enddo
+ do j=js,je ; do i=is,ie ; eta_av(i,j) = -GV%Z_to_H*G%bathyT(i,j) ; enddo ; enddo
else
do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo
endif
@@ -479,6 +456,11 @@ end subroutine step_MOM_dyn_unsplit_RK2
! =============================================================================
+!> Allocate the control structure for this module, allocates memory in it, and registers
+!! any auxiliary restart variables that are specific to the unsplit RK2 time stepping scheme.
+!!
+!! All variables registered here should have the ability to be recreated if they are not present
+!! in a restart file.
subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -492,13 +474,7 @@ subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS, restart_CS)
! to the unsplit time stepping scheme. All variables registered here should
! have the ability to be recreated if they are not present in a restart file.
-! Arguments: HI - A horizontal index type structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (inout) CS - The control structure set up by initialize_dyn_unsplit_RK2.
-! (inout) restart_CS - A pointer to the restart control structure.
-
+ ! Local variables
character(len=48) :: thickness_units, flux_units
integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB
isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke
@@ -526,6 +502,7 @@ subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS, restart_CS)
end subroutine register_restarts_dyn_unsplit_RK2
+!> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module.
subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS, &
restart_CS, Accel_diag, Cont_diag, MIS, &
OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, &
@@ -575,39 +552,11 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS
integer, target, intent(inout) :: ntrunc !< A target for the variable
!! that records the number of times the
!! velocity is truncated (this should be 0).
-! Arguments: u - The zonal velocity, in m s-1.
-! (inout) v - The meridional velocity, in m s-1.
-! (inout) h - The layer thicknesses, in m or kg m-2, depending on whether
-! the Boussinesq approximation is made.
-! (in) Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (inout) CS - The control structure set up by initialize_dyn_unsplit_RK2.
-! (in) restart_CS - A pointer to the restart control structure.
-! (inout) Accel_diag - A set of pointers to the various accelerations in
-! the momentum equations, which can be used for later derived
-! diagnostics, like energy budgets.
-! (inout) Cont_diag - A structure with pointers to various terms in the
-! continuity equations.
-! (inout) MIS - The "MOM6 Internal State" structure, used to pass around
-! pointers to various arrays for diagnostic purposes.
-! (in) OBC - If open boundary conditions are used, this points to the
-! ocean_OBC_type that was set up in MOM_initialization.
-! (in) update_OBC_CSp - If open boundary condition updates are used,
-! this points to the appropriate control structure.
-! (in) ALE_CS - This points to the ALE control structure.
-! (in) setVisc_CSp - This points to the set_visc control structure.
-! (inout) visc - A structure containing vertical viscosities, bottom drag
-! viscosities, and related fields.
-! (in) dirs - A structure containing several relevant directory paths.
-! (in) ntrunc - A target for the variable that records the number of times
-! the velocity is truncated (this should be 0).
! This subroutine initializes all of the variables that are used by this
! dynamic core, including diagnostics and the cpu clocks.
+
+ ! Local varaibles
character(len=40) :: mdl = "MOM_dynamics_unsplit_RK2" ! This module's name.
character(len=48) :: thickness_units, flux_units
real :: H_convert
@@ -704,9 +653,10 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS
end subroutine initialize_dyn_unsplit_RK2
+!> Clean up and deallocate memory associated with the dyn_unsplit_RK2 module.
subroutine end_dyn_unsplit_RK2(CS)
- type(MOM_dyn_unsplit_RK2_CS), pointer :: CS
-! (inout) CS - The control structure set up by initialize_dyn_unsplit_RK2.
+ type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< dyn_unsplit_RK2 control structure that
+ !! will be deallocated in this subroutine.
DEALLOC_(CS%diffu) ; DEALLOC_(CS%diffv)
DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv)
diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90
index bb03370e03..11b94a2c0c 100644
--- a/src/core/MOM_forcing_type.F90
+++ b/src/core/MOM_forcing_type.F90
@@ -26,23 +26,22 @@ module MOM_forcing_type
public extractFluxes1d, extractFluxes2d, optics_type
public MOM_forcing_chksum, MOM_mech_forcing_chksum
-public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d, forcing_accumulate
+public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d
+public forcing_accumulate, fluxes_accumulate
public forcing_SinglePointPrint, mech_forcing_diags, forcing_diagnostics
public register_forcing_type_diags, allocate_forcing_type, deallocate_forcing_type
public copy_common_forcing_fields, allocate_mech_forcing, deallocate_mech_forcing
-public set_derived_forcing_fields, copy_back_forcing_fields, set_net_mass_forcing
+public set_derived_forcing_fields, copy_back_forcing_fields
+public set_net_mass_forcing, get_net_mass_forcing
-!> Structure that contains pointers to the boundary forcing
-!! used to drive the liquid ocean simulated by MOM.
-!! Data in this type is allocated in the module
-!! MOM_surface_forcing.F90, of which there are three:
-!! solo, coupled, and ice-shelf. Alternatively, they are
-!! allocated in MESO_surface_forcing.F90, which is a
-!! special case of solo_driver/MOM_surface_forcing.F90.
+!> Structure that contains pointers to the boundary forcing used to drive the
+!! liquid ocean simulated by MOM.
+!!
+!! Data in this type is allocated in the module MOM_surface_forcing.F90, of which there
+!! are three: solo, coupled, and ice-shelf. Alternatively, they are allocated in
+!! MESO_surface_forcing.F90, which is a special case of solo_driver/MOM_surface_forcing.F90.
type, public :: forcing
- ! Pointers in this module should be initialized to NULL.
-
! surface stress components and turbulent velocity scale
real, pointer, dimension(:,:) :: &
ustar => NULL(), & !< surface friction velocity scale (m/s)
@@ -107,17 +106,16 @@ module MOM_forcing_type
!! to net zero ( kg salt/(m^2 s) )
! 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).
- !! if there is sea-ice, then p_surf_flux is at ice-ocean interface
- p_surf => NULL(), & !< Pressure at the top ocean interface (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.
- 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.
- !! This may point to p_surf or to p_surf_full.
+ real, pointer, dimension(:,:) :: p_surf_full => NULL()
+ !< Pressure at the top ocean interface (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.
+ !! 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.
+ !! 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
!! and various types of ice needs to be accumulated, and the
!! surface pressure explicitly reset to zero at the driver level
@@ -135,14 +133,14 @@ module MOM_forcing_type
mass_berg => NULL() !< mass of icebergs (kg/m2)
! land ice-shelf related inputs
- real, pointer, dimension(:,:) :: &
- ustar_shelf => NULL(), & !< friction velocity under ice-shelves (m/s)
+ real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves (in m/s)
!! as computed by the ocean at the previous time step.
- frac_shelf_h => NULL(), & !! Fractional ice shelf coverage of h-cells, nondimensional
+ real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of h-cells, nondimensional
!! cells, nondimensional from 0 to 1. This is only
!! associated if ice shelves are enabled, and are
!! exactly 0 away from shelves or on land.
- iceshelf_melt => NULL() !< ice shelf melt rate (positive) or freezing (negative) ( m/year )
+ real, pointer, dimension(:,:) :: iceshelf_melt => NULL() !< Ice shelf melt rate (positive)
+ !! or freezing (negative) (in m/year)
! Scalars set by surface forcing modules
real :: vPrecGlobalAdj !< adjustment to restoring vprec to zero out global net ( kg/(m^2 s) )
@@ -154,11 +152,10 @@ module MOM_forcing_type
logical :: fluxes_used = .true. !< If true, all of the heat, salt, and mass
!! fluxes have been applied to the ocean.
- real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes
+ real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes
!! should be applied, in s. If negative, this forcing
!! type variable has not yet been inialized.
- ! heat capacity
real :: C_p !< heat capacity of seawater ( J/(K kg) ).
!! C_p is is the same value as in thermovar_ptrs_type.
@@ -169,7 +166,7 @@ module MOM_forcing_type
!! This is not a convenient convention, but imposed on MOM6 by the coupler.
! For internal error tracking
- integer :: num_msg = 0 !< Number of messages issues about excessive SW penetration
+ integer :: num_msg = 0 !< Number of messages issued about excessive SW penetration
integer :: max_msg = 2 !< Maximum number of messages to issue about excessive SW penetration
end type forcing
@@ -184,48 +181,53 @@ module MOM_forcing_type
taux => NULL(), & !< zonal wind stress (Pa)
tauy => NULL(), & !< meridional wind stress (Pa)
ustar => NULL(), & !< surface friction velocity scale (m/s)
+ net_mass_src => NULL() !< The net mass source to the ocean, in kg m-2 s-1.
! applied surface pressure from other component models (e.g., atmos, sea ice, land ice)
- p_surf_full => NULL(), & !< Pressure at the top ocean interface (Pa).
- !! if there is sea-ice, then p_surf_flux is at ice-ocean interface
- p_surf => NULL(), & !< Pressure at the top ocean interface (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.
- 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.
- !! This may point to p_surf or to p_surf_full.
- net_mass_src => NULL(), & !< The net mass source to the ocean, in kg m-2 s-1.
+ real, pointer, dimension(:,:) :: p_surf_full => NULL()
+ !< Pressure at the top ocean interface (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.
+ !! 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.
+ !! p_surf_SSH may point to p_surf or to p_surf_full.
! iceberg related inputs
+ real, pointer, dimension(:,:) :: &
area_berg => NULL(), & !< area of ocean surface covered by icebergs (m2/m2)
- mass_berg => NULL(), & !< mass of icebergs (kg/m2)
+ mass_berg => NULL() !< mass of icebergs (kg/m2)
! land ice-shelf related inputs
- frac_shelf_u => NULL(), & !< Fractional ice shelf coverage of u-cells, nondimensional
- !! from 0 to 1. This is only associated if ice shelves are
- !< enabled, and is exactly 0 away from shelves or on land.
- frac_shelf_v => NULL(), & !< Fractional ice shelf coverage of v-cells, nondimensional
- !! from 0 to 1. This is only associated if ice shelves are
- !< enabled, and is exactly 0 away from shelves or on land.
- rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice
- rigidity_ice_v => NULL() !< shelves or sea ice at u- or v-points (m3/s)
+ real, pointer, dimension(:,:) :: frac_shelf_u => NULL() !< Fractional ice shelf coverage of u-cells,
+ !! nondimensional from 0 to 1. This is only associated if ice shelves are enabled,
+ !! and is exactly 0 away from shelves or on land.
+ real, pointer, dimension(:,:) :: frac_shelf_v => NULL() !< Fractional ice shelf coverage of v-cells,
+ !! nondimensional from 0 to 1. This is only associated if ice shelves are enabled,
+ !! and is exactly 0 away from shelves or on land.
+ real, pointer, dimension(:,:) :: &
+ rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points (m3/s)
+ rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points (m3/s)
+ real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes
+ !! have been averaged, in s.
+ logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided.
logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere
- !! and various types of ice needs to be accumulated, and the
- !! surface pressure explicitly reset to zero at the driver level
- !! when appropriate.
+ !! and various types of ice needs to be accumulated, and the
+ !! surface pressure explicitly reset to zero at the driver level
+ !! when appropriate.
logical :: accumulate_rigidity = .false. !< If true, the rigidity due to various types of
- !! ice needs to be accumulated, and the rigidity explicitly
- !! reset to zero at the driver level when appropriate.
+ !! ice needs to be accumulated, and the rigidity explicitly
+ !! reset to zero at the driver level when appropriate.
- logical :: initialized = .false. !< This indicates whether the appropriate
- !! arrays have been initialized.
+ logical :: initialized = .false. !< This indicates whether the appropriate arrays have been initialized.
end type mech_forcing
!> Structure that defines the id handles for the forcing type
type, public :: forcing_diags
+ !>@{ Forcing diagnostic handles
! mass flux diagnostic handles
integer :: id_prcme = -1, id_evap = -1
integer :: id_precip = -1, id_vprec = -1
@@ -262,7 +264,6 @@ module MOM_forcing_type
integer :: id_heat_added = -1, id_heat_content_massin = -1
integer :: id_hfrainds = -1, id_hfrunoffds = -1
-
! global area integrated heat flux diagnostic handles
integer :: id_total_net_heat_coupler = -1, id_total_net_heat_surface = -1
integer :: id_total_sens = -1, id_total_LwLatSens = -1
@@ -297,7 +298,7 @@ module MOM_forcing_type
integer :: id_netFWGlobalAdj = -1
integer :: id_netFWGlobalScl = -1
- ! momentum flux diagnostic handls
+ ! momentum flux and forcing diagnostic handles
integer :: id_taux = -1
integer :: id_tauy = -1
integer :: id_ustar = -1
@@ -306,17 +307,17 @@ module MOM_forcing_type
integer :: id_TKE_tidal = -1
integer :: id_buoy = -1
- ! clock id handle
- integer :: id_clock_forcing
-
- ! iceberg id handle
+ ! iceberg diagnostic handles
integer :: id_ustar_berg = -1
integer :: id_area_berg = -1
integer :: id_mass_berg = -1
- !Iceberg + Ice shelf
+ ! Iceberg + Ice shelf diagnostic handles
integer :: id_ustar_ice_cover = -1
integer :: id_frac_ice_cover = -1
+ !!@}
+
+ integer :: id_clock_forcing = -1 !< CPU clock id
end type forcing_diags
@@ -372,21 +373,19 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt,
!! thermodynamic fields. Used to keep
!! track of the heat flux associated with net
!! mass fluxes into the ocean.
- logical, intent(in) :: aggregate_FW !< For determining how to aggregate forcing.
+ logical, intent(in) :: aggregate_FW !< For determining how to aggregate forcing.
real, dimension(SZI_(G)), &
- optional, intent(out) :: nonpenSW !< non-downwelling SW; use in net_heat.
- !! Sum over SW bands when diagnosing nonpenSW.
- !! Units are (K * H).
+ optional, intent(out) :: nonpenSW !< Non-penetrating SW in degC H, used in net_heat.
+ !! Summed over SW bands when diagnosing nonpenSW.
real, dimension(SZI_(G)), &
- optional, intent(out) :: net_Heat_rate !< Rate of net surface heating in H K s-1.
+ optional, intent(out) :: net_Heat_rate !< Rate of net surface heating in H K s-1.
real, dimension(SZI_(G)), &
- optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in ppt H s-1.
+ optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in ppt H s-1.
real, dimension(SZI_(G)), &
- optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean in H s-1.
+ optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean in H s-1.
real, dimension(:,:), &
- optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating
- !! in degC H s-1.
- logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics
+ optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating in degC H s-1.
+ logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics
! local
real :: htot(SZI_(G)) ! total ocean depth (m for Bouss or kg/m^2 for non-Bouss)
@@ -857,9 +856,9 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j,
useRiverHeatContent = .False.
useCalvingHeatContent = .False.
- depthBeforeScalingFluxes = max( GV%Angstrom, 1.e-30*GV%m_to_H )
+ depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H )
pressure(:) = 0. ! Ignore atmospheric pressure
- GoRho = GV%g_Earth / GV%Rho0
+ GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0
start = 1 + G%isc - G%isd
npts = 1 + G%iec - G%isc
@@ -1039,12 +1038,17 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, haloshift)
haloshift=hshift, symmetric=.true.)
if (associated(forces%p_surf)) &
call hchksum(forces%p_surf, mesg//" forces%p_surf",G%HI,haloshift=hshift)
+ if (associated(forces%ustar)) &
+ call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift)
+ if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) &
+ call uvchksum(mesg//" forces%rigidity_ice_[uv]", forces%rigidity_ice_u, &
+ forces%rigidity_ice_v, G%HI, haloshift=hshift, symmetric=.true.)
end subroutine MOM_mech_forcing_chksum
!> Write out values of the mechanical forcing arrays at the i,j location. This is a debugging tool.
subroutine mech_forcing_SinglePointPrint(forces, G, i, j, mesg)
- type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
+ type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
type(ocean_grid_type), intent(in) :: G !< Grid type
character(len=*), intent(in) :: mesg !< Message
integer, intent(in) :: i !< i-index
@@ -1744,7 +1748,8 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use
end subroutine register_forcing_type_diags
-!> Accumulate the forcing over time steps
+!> Accumulate the forcing over time steps, taking input from a mechanical forcing type
+!! and a temporary forcing-flux type.
subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2)
type(forcing), intent(in) :: flux_tmp !< A temporary structure with current
!!thermodynamic forcing fields
@@ -1755,6 +1760,26 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
real, intent(out) :: wt2 !< The relative weight of the new fluxes
+ ! This subroutine copies mechancal forcing from flux_tmp to fluxes and
+ ! stores the time-weighted averages of the various buoyancy fluxes in fluxes,
+ ! and increments the amount of time over which the buoyancy forcing should be
+ ! applied, all via a call to fluxes accumulate.
+
+ call fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces)
+
+end subroutine forcing_accumulate
+
+!> Accumulate the thermodynamic fluxes over time steps
+subroutine fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces)
+ type(forcing), intent(in) :: flux_tmp !< A temporary structure with current
+ !! thermodynamic forcing fields
+ type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged
+ !! thermodynamic forcing fields
+ real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
+ real, intent(out) :: wt2 !< The relative weight of the new fluxes
+ type(mech_forcing), optional, intent(in) :: forces !< A structure with the driving mechanical forces
+
! This subroutine copies mechancal forcing from flux_tmp to fluxes and
! stores the time-weighted averages of the various buoyancy fluxes in fluxes,
! and increments the amount of time over which the buoyancy forcing should be
@@ -1777,15 +1802,29 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2)
wt2 = 1.0 - wt1 ! = dt / (fluxes%dt_buoy_accum + dt)
fluxes%dt_buoy_accum = fluxes%dt_buoy_accum + dt
- ! Copy over the pressure fields.
- do j=js,je ; do i=is,ie
- fluxes%p_surf(i,j) = forces%p_surf(i,j)
- fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j)
- enddo ; enddo
+ ! Copy over the pressure fields and accumulate averages of ustar, either from the forcing
+ ! type or from the temporary fluxes type.
+ if (present(forces)) then
+ do j=js,je ; do i=is,ie
+ fluxes%p_surf(i,j) = forces%p_surf(i,j)
+ fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j)
+
+ fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j)
+ enddo ; enddo
+ else
+ do j=js,je ; do i=is,ie
+ fluxes%p_surf(i,j) = flux_tmp%p_surf(i,j)
+ fluxes%p_surf_full(i,j) = flux_tmp%p_surf_full(i,j)
+
+ fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*flux_tmp%ustar(i,j)
+ enddo ; enddo
+ endif
! Average the water, heat, and salt fluxes, and ustar.
do j=js,je ; do i=is,ie
- fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j)
+!### Replace the expression for ustar_gustless with this one...
+! fluxes%ustar_gustless(i,j) = wt1*fluxes%ustar_gustless(i,j) + wt2*flux_tmp%ustar_gustless(i,j)
+ fluxes%ustar_gustless(i,j) = flux_tmp%ustar_gustless(i,j)
fluxes%evap(i,j) = wt1*fluxes%evap(i,j) + wt2*flux_tmp%evap(i,j)
fluxes%lprec(i,j) = wt1*fluxes%lprec(i,j) + wt2*flux_tmp%lprec(i,j)
@@ -1869,7 +1908,7 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2)
call coupler_type_increment_data(flux_tmp%tr_fluxes, fluxes%tr_fluxes, &
scale_factor=wt2, scale_prev=wt1)
-end subroutine forcing_accumulate
+end subroutine fluxes_accumulate
!> This subroutine copies the computational domains of common forcing fields
!! from a mech_forcing type to a (thermodynamic) forcing type.
@@ -1925,9 +1964,12 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0)
!! as used to calculate ustar.
real :: taux2, tauy2 ! Squared wind stress components, in Pa^2.
+ real :: Irho0 ! Inverse of the mean density in (m^3/kg)
integer :: i, j, is, ie, js, je
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
+ Irho0 = 1.0/Rho0
+
if (associated(forces%taux) .and. associated(forces%tauy) .and. &
associated(fluxes%ustar_gustless)) then
do j=js,je ; do i=is,ie
@@ -1943,45 +1985,58 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0)
(G%mask2dCv(i,J-1) + G%mask2dCv(i,J))
fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) / Rho0)
+!### Change to:
+! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0)
enddo ; enddo
endif
end subroutine set_derived_forcing_fields
-!> This subroutine calculates determines the net mass source to th eocean from
+!> This subroutine calculates determines the net mass source to the ocean from
!! a (thermodynamic) forcing type and stores it in a mech_forcing type.
subroutine set_net_mass_forcing(fluxes, forces, G)
type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields
type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces
- type(ocean_grid_type), intent(in) :: G !< grid type
+ type(ocean_grid_type), intent(in) :: G !< The ocean grid type
+
+ if (associated(forces%net_mass_src)) &
+ call get_net_mass_forcing(fluxes, G, forces%net_mass_src)
+
+end subroutine set_net_mass_forcing
+
+!> This subroutine calculates determines the net mass source to the ocean from
+!! a (thermodynamic) forcing type and stores it in a provided array.
+subroutine get_net_mass_forcing(fluxes, G, net_mass_src)
+ type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields
+ type(ocean_grid_type), intent(in) :: G !< The ocean grid type
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_mass_src !< The net mass flux of water into the ocean
+ !! in kg m-2 s-1.
integer :: i, j, is, ie, js, je
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
- if (associated(forces%net_mass_src)) then
- forces%net_mass_src(:,:) = 0.0
- if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie
- forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%lprec(i,j)
- enddo ; enddo ; endif
- if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie
- forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%fprec(i,j)
- enddo ; enddo ; endif
- if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie
- forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%vprec(i,j)
- enddo ; enddo ; endif
- if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie
- forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%lrunoff(i,j)
- enddo ; enddo ; endif
- if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie
- forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%frunoff(i,j)
- enddo ; enddo ; endif
- if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie
- forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%evap(i,j)
- enddo ; enddo ; endif
- endif
-
-end subroutine set_net_mass_forcing
+ net_mass_src(:,:) = 0.0
+ if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie
+ net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lprec(i,j)
+ enddo ; enddo ; endif
+ if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie
+ net_mass_src(i,j) = net_mass_src(i,j) + fluxes%fprec(i,j)
+ enddo ; enddo ; endif
+ if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie
+ net_mass_src(i,j) = net_mass_src(i,j) + fluxes%vprec(i,j)
+ enddo ; enddo ; endif
+ if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie
+ net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lrunoff(i,j)
+ enddo ; enddo ; endif
+ if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie
+ net_mass_src(i,j) = net_mass_src(i,j) + fluxes%frunoff(i,j)
+ enddo ; enddo ; endif
+ if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie
+ net_mass_src(i,j) = net_mass_src(i,j) + fluxes%evap(i,j)
+ enddo ; enddo ; endif
+
+end subroutine get_net_mass_forcing
!> This subroutine copies the computational domains of common forcing fields
!! from a mech_forcing type to a (thermodynamic) forcing type.
@@ -2004,9 +2059,8 @@ end subroutine copy_back_forcing_fields
!> Offer mechanical forcing fields for diagnostics for those
!! fields registered as part of register_forcing_type_diags.
-subroutine mech_forcing_diags(forces, fluxes, dt, G, diag, handles)
+subroutine mech_forcing_diags(forces, dt, G, diag, handles)
type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
- type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields
real, intent(in) :: dt !< time step
type(ocean_grid_type), intent(in) :: G !< grid type
type(diag_ctrl), intent(in) :: diag !< diagnostic type
@@ -2021,20 +2075,15 @@ subroutine mech_forcing_diags(forces, fluxes, dt, G, diag, handles)
if ((handles%id_taux > 0) .and. associated(forces%taux)) &
call post_data(handles%id_taux, forces%taux, diag)
+
if ((handles%id_tauy > 0) .and. associated(forces%tauy)) &
call post_data(handles%id_tauy, forces%tauy, diag)
- if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) &
- call post_data(handles%id_ustar, fluxes%ustar, diag)
- if (handles%id_ustar_berg > 0) &
- call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag)
- if (handles%id_area_berg > 0) &
- call post_data(handles%id_area_berg, fluxes%area_berg, diag)
- if (handles%id_mass_berg > 0) &
- call post_data(handles%id_mass_berg, fluxes%mass_berg, diag)
- if (handles%id_frac_ice_cover > 0) &
- call post_data(handles%id_frac_ice_cover, fluxes%frac_shelf_h, diag)
- if (handles%id_ustar_ice_cover > 0) &
- call post_data(handles%id_ustar_ice_cover, fluxes%ustar_shelf, diag)
+
+ if ((handles%id_mass_berg > 0) .and. associated(forces%mass_berg)) &
+ call post_data(handles%id_mass_berg, forces%mass_berg, diag)
+
+ if ((handles%id_area_berg > 0) .and. associated(forces%area_berg)) &
+ call post_data(handles%id_area_berg, forces%area_berg, diag)
endif
@@ -2084,7 +2133,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles)
if (associated(fluxes%frunoff)) res(i,j) = res(i,j)+fluxes%frunoff(i,j)
if (associated(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j)
enddo ; enddo
- call post_data(handles%id_prcme, res, diag)
+ if (handles%id_prcme > 0) call post_data(handles%id_prcme, res, diag)
if (handles%id_total_prcme > 0) then
total_transport = global_area_integral(res,G)
call post_data(handles%id_total_prcme, total_transport, diag)
@@ -2102,7 +2151,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles)
if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j)
if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j)
enddo ; enddo
- call post_data(handles%id_net_massout, res, diag)
+ if (handles%id_net_massout > 0) call post_data(handles%id_net_massout, res, diag)
if (handles%id_total_net_massout > 0) then
total_transport = global_area_integral(res,G)
call post_data(handles%id_total_net_massout, total_transport, diag)
@@ -2119,7 +2168,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles)
! fluxes%cond is not needed because it is derived from %evap > 0
if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j)
enddo ; enddo
- call post_data(handles%id_net_massin, res, diag)
+ if (handles%id_net_massin > 0) call post_data(handles%id_net_massin, res, diag)
if (handles%id_total_net_massin > 0) then
total_transport = global_area_integral(res,G)
call post_data(handles%id_total_net_massin, total_transport, diag)
@@ -2273,7 +2322,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles)
if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j)
if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j)
enddo ; enddo
- call post_data(handles%id_net_heat_coupler, res, diag)
+ if (handles%id_net_heat_coupler > 0) call post_data(handles%id_net_heat_coupler, res, diag)
if (handles%id_total_net_heat_coupler > 0) then
total_transport = global_area_integral(res,G)
call post_data(handles%id_total_net_heat_coupler, total_transport, diag)
@@ -2333,7 +2382,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles)
if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j)
! endif
enddo ; enddo
- call post_data(handles%id_heat_content_surfwater, res, diag)
+ if (handles%id_heat_content_surfwater > 0) call post_data(handles%id_heat_content_surfwater, res, diag)
if (handles%id_total_heat_content_surfwater > 0) then
total_transport = global_area_integral(res,G)
call post_data(handles%id_total_heat_content_surfwater, total_transport, diag)
@@ -2525,8 +2574,19 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles)
if ((handles%id_buoy > 0) .and. associated(fluxes%buoy)) &
call post_data(handles%id_buoy, fluxes%buoy, diag)
+ if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) &
+ call post_data(handles%id_ustar, fluxes%ustar, diag)
+
+ if ((handles%id_ustar_berg > 0) .and. associated(fluxes%ustar_berg)) &
+ call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag)
- endif
+ if ((handles%id_frac_ice_cover > 0) .and. associated(fluxes%frac_shelf_h)) &
+ call post_data(handles%id_frac_ice_cover, fluxes%frac_shelf_h, diag)
+
+ if ((handles%id_ustar_ice_cover > 0) .and. associated(fluxes%ustar_shelf)) &
+ call post_data(handles%id_ustar_ice_cover, fluxes%ustar_shelf, diag)
+
+ endif ! query_averaging_enabled
call cpu_clock_end(handles%id_clock_forcing)
end subroutine forcing_diagnostics
diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90
index d302b2c152..c0ca264d68 100644
--- a/src/core/MOM_grid.F90
+++ b/src/core/MOM_grid.F90
@@ -14,7 +14,7 @@ module MOM_grid
#include
public MOM_grid_init, MOM_grid_end, set_derived_metrics, set_first_direction
-public isPointInCell, hor_index_type, get_global_grid_size
+public isPointInCell, hor_index_type, get_global_grid_size, rescale_grid_bathymetry
!> Ocean grid type. See mom_grid for details.
type, public :: ocean_grid_type
@@ -131,22 +131,23 @@ module MOM_grid
y_axis_units !< The units that are used in labeling the y coordinate axes.
real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: &
- bathyT !< Ocean bottom depth at tracer points, in m.
+ bathyT !< Ocean bottom depth at tracer points, in depth units.
+ real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m.
logical :: bathymetry_at_vel !< If true, there are separate values for the
!! basin depths at velocity points. Otherwise the effects of
!! of topography are entirely determined from thickness points.
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: &
- Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in m.
- Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in m.
+ Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in depth units.
+ Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in depth units.
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: &
- Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in m.
- Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in m.
+ Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units.
+ Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units.
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: &
CoriolisBu !< The Coriolis parameter at corner points, in s-1.
real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: &
- dF_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points, in s-1 m-1.
- dF_dy !< Derivative d/dy f (Coriolis parameter) at h-points, in s-1 m-1.
+ df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points, in s-1 m-1.
+ df_dy !< Derivative d/dy f (Coriolis parameter) at h-points, in s-1 m-1.
real :: g_Earth !< The gravitational acceleration in m s-2.
! These variables are global sums that are useful for 1-d diagnostics
@@ -154,8 +155,8 @@ module MOM_grid
real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) in m2.
! These variables are for block structures.
- integer :: nblocks
- type(hor_index_type), pointer :: Block(:) => NULL() ! store indices for each block
+ integer :: nblocks !< The number of sub-PE blocks on this PE
+ type(hor_index_type), pointer :: Block(:) => NULL() !< Index ranges for each block
! These parameters are run-time parameters that are used during some
! initialization routines (but not all)
@@ -164,7 +165,7 @@ module MOM_grid
real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain
real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain
real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters.
- real :: max_depth !< The maximum depth of the ocean in meters.
+ real :: max_depth !< The maximum depth of the ocean in depth units (scaled by Zd_to_m).
end type ocean_grid_type
contains
@@ -345,6 +346,39 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel)
end subroutine MOM_grid_init
+!> rescale_grid_bathymetry permits a change in the internal units for the bathymetry on the grid,
+!! both rescaling the depths and recording the new internal units.
+subroutine rescale_grid_bathymetry(G, m_in_new_units)
+ type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure
+ real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth.
+
+ ! Local variables
+ real :: rescale
+ integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
+
+ isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
+ IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
+
+ if (m_in_new_units == G%Zd_to_m) return
+ if (m_in_new_units < 0.0) &
+ call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.")
+ if (m_in_new_units == 0.0) &
+ call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.")
+
+ rescale = G%Zd_to_m / m_in_new_units
+ do j=jsd,jed ; do i=isd,ied
+ G%bathyT(i,j) = rescale*G%bathyT(i,j)
+ enddo ; enddo
+ if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB
+ G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j)
+ enddo ; enddo ; endif
+ if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied
+ G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J)
+ enddo ; enddo ; endif
+ G%max_depth = rescale*G%max_depth
+ G%Zd_to_m = m_in_new_units
+
+end subroutine rescale_grid_bathymetry
!> set_derived_metrics calculates metric terms that are derived from other metrics.
subroutine set_derived_metrics(G)
diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90
index f30bcda8cb..c6c283dfc2 100644
--- a/src/core/MOM_interface_heights.F90
+++ b/src/core/MOM_interface_heights.F90
@@ -27,9 +27,8 @@ module MOM_interface_heights
!! 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_Earth, G, GV, eta, eta_bt, halo_size)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid
- !! structure.
+subroutine find_eta_3d(h, tv, G, GV, 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.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H
@@ -37,16 +36,17 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to
!! various thermodynamic
!! variables.
- real, intent(in) :: G_Earth !< Earth gravitational
- !! acceleration (m/s2).
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights
- !! (meter).
+ !! (Z 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, in 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 GV%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
@@ -54,6 +54,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
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)
@@ -64,18 +65,19 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
if ((isvG%ied) .or. (jsvG%jed)) &
call MOM_error(FATAL,"find_eta called with an overly large halo_size.")
- I_gEarth = 1.0 / G_Earth
+ Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%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 * (GV%m_to_Z * Z_to_eta)
+ I_gEarth = Z_to_eta / GV%g_Earth
-!$OMP parallel default(none) shared(isv,iev,jsv,jev,nz,eta,G,GV,h,eta_bt,tv,p, &
-!$OMP G_Earth,dz_geo,halo,I_gEarth) &
-!$OMP private(dilate,htot)
+!$OMP parallel default(shared) private(dilate,htot)
!$OMP do
- do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -G%bathyT(i,j) ; enddo ; enddo
+ 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)*GV%H_to_m
+ 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
@@ -83,22 +85,22 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
!$OMP do
do j=jsv,jev
do i=isv,iev
- dilate(i) = (eta_bt(i,j)*GV%H_to_m + G%bathyT(i,j)) / &
- (eta(i,j,1) + G%bathyT(i,j))
+ 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) + G%bathyT(i,j)) - G%bathyT(i,j)
+ 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
- ! ### THIS SHOULD BE P_SURF, IF AVAILABLE.
!$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) + G_Earth*GV%H_to_kg_m2*h(i,j,k)
+ p(i,j,K+1) = p(i,j,K) + GV%H_to_Pa*h(i,j,k)
enddo ; enddo
enddo
!$OMP do
@@ -115,7 +117,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
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) + GV%H_to_kg_m2*h(i,j,k)/GV%Rlay(k)
+ 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
@@ -127,7 +129,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
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) + G%bathyT(i,j)) - G%bathyT(i,j)
+ 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
@@ -140,7 +142,7 @@ end subroutine find_eta_3d
!! 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_Earth, G, GV, eta, eta_bt, halo_size)
+subroutine find_eta_2d(h, tv, G, GV, 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.
@@ -149,8 +151,6 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to
!! various thermodynamic
!! variables.
- real, intent(in) :: G_Earth !< Earth gravitational
- !! acceleration (m/s2).
real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height
!! relative to mean sea
!! level (z=0) (m).
@@ -159,37 +159,41 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
!! water column mass per unit area (non-Boussinesq), in 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 GV%Z_to_m.
! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: &
p ! The pressure in Pa.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
dz_geo ! The change in geopotential height across a layer, in m2 s-2.
- real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in kg m-2 or m.
+ real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in 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, 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
- I_gEarth = 1.0 / G_Earth
+ Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%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 * (GV%m_to_Z * Z_to_eta)
+ I_gEarth = Z_to_eta / GV%g_Earth
-!$OMP parallel default(none) shared(is,ie,js,je,nz,eta,G,GV,eta_bt,h,tv,p, &
-!$OMP G_Earth,dz_geo,halo,I_gEarth) &
-!$OMP private(htot)
+!$OMP parallel default(shared) private(htot)
!$OMP do
- do j=js,je ; do i=is,ie ; eta(i,j) = -G%bathyT(i,j) ; enddo ; enddo
+ 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) = GV%H_to_m*eta_bt(i,j)
+ 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)*GV%H_to_m
+ eta(i,j) = eta(i,j) + h(i,j,k)*H_to_eta
enddo ; enddo ; enddo
endif
else
@@ -199,7 +203,7 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
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) + G_Earth*GV%H_to_kg_m2*h(i,j,k)
+ p(i,j,k+1) = p(i,j,k) + GV%H_to_Pa*h(i,j,k)
enddo ; enddo
enddo
!$OMP do
@@ -214,7 +218,7 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
else
!$OMP do
do j=js,je ; do k=1,nz ; do i=is,ie
- eta(i,j) = eta(i,j) + GV%H_to_kg_m2*h(i,j,k)/GV%Rlay(k)
+ 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
@@ -225,8 +229,8 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size)
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) + G%bathyT(i,j)) - &
- G%bathyT(i,j)
+ 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
diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90
index c677f3863c..41b9bef817 100644
--- a/src/core/MOM_isopycnal_slopes.F90
+++ b/src/core/MOM_isopycnal_slopes.F90
@@ -18,15 +18,16 @@ module MOM_isopycnal_slopes
!> Calculate isopycnal slopes, and optionally return N2 used in calculation.
subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
- slope_x, slope_y, N2_u, N2_v, halo)
+ slope_x, slope_y, N2_u, N2_v, halo) !, 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
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (m)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (in Z or units
+ !! given by 1/eta_to_m)
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables
- real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing
- !! timescale, in s.
+ real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity
+ !! times a smoothing timescale, in Z2.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim)
real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction (nondim)
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), &
@@ -36,6 +37,9 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at
!! interfaces between u-points (s-2)
integer, optional, intent(in) :: halo !< Halo width over which to compute
+
+ ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units
+ ! (This argument has been tested but for now serves no purpose.) !! of eta to m; GV%Z_to_m by default.
! Local variables
real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: &
T, & ! The temperature (or density) in C, with the values in
@@ -63,12 +67,12 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
! interface times the grid spacing, in kg m-3.
real :: drdkL, drdkR ! Vertical density differences across an interface,
! in kg m-3.
- real :: hg2A, hg2B, hg2L, hg2R
- real :: haA, haB, haL, haR
- real :: dzaL, dzaR
- real :: wtA, wtB, wtL, wtR
- real :: drdx, drdy, drdz ! Zonal, meridional, and vertical density gradients,
- ! in units of kg m-4.
+ real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses, in H2.
+ real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H.
+ real :: dzaL, dzaR ! Temporary thicknesses in eta units (Z?).
+ real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units.
+ real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4.
+ real :: drdz ! Vertical density gradient, in units of kg m-3 Z-1.
real :: Slope ! The slope of density surfaces, calculated in a way
! that is always between -1 and 1.
real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8.
@@ -77,10 +81,15 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
! in roundoff and can be neglected, in H.
real :: h_neglect2 ! h_neglect^2, in H2.
real :: dz_neglect ! A thickness in m that is so small it is usually lost
- ! in roundoff and can be neglected, in m.
+ ! in roundoff and can be neglected, in eta units (Z?).
logical :: use_EOS ! If true, density is calculated from T & S using an
! equation of state.
real :: G_Rho0, N2, dzN2, H_x(SZIB_(G)), H_y(SZI_(G))
+ real :: Z_to_L ! A conversion factor between from units for e to the
+ ! units for lateral distances.
+ real :: L_to_Z ! A conversion factor between from units for lateral distances
+ ! to the units for e.
+ real :: H_to_Z ! A conversion factor from thickness units to the units of e.
logical :: present_N2_u, present_N2_v
integer :: is, ie, js, je, nz, IsdB
@@ -94,13 +103,18 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
nz = G%ke ; IsdB = G%IsdB
h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2
- dz_neglect = GV%H_subroundoff*GV%H_to_m
+ Z_to_L = GV%Z_to_m ; H_to_Z = GV%H_to_Z
+ ! if (present(eta_to_m)) then
+ ! Z_to_L = eta_to_m ; H_to_Z = GV%H_to_m / eta_to_m
+ ! endif
+ L_to_Z = 1.0 / Z_to_L
+ dz_neglect = GV%H_subroundoff * H_to_Z
use_EOS = associated(tv%eqn_of_state)
present_N2_u = PRESENT(N2_u)
present_N2_v = PRESENT(N2_v)
- G_Rho0 = GV%g_Earth / GV%Rho0
+ G_Rho0 = (GV%g_Earth*L_to_Z*GV%m_to_Z) / GV%Rho0
if (present_N2_u) then
do j=js,je ; do I=is-1,ie
N2_u(I,j,1) = 0.
@@ -116,34 +130,32 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
if (use_EOS) then
if (present(halo)) then
- call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, 1.0, T, S, G, GV, halo+1)
+ call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, halo+1)
else
- call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, 1.0, T, S, G, GV, 1)
+ call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, 1)
endif
endif
! Find the maximum and minimum permitted streamfunction.
-!$OMP parallel default(none) shared(is,ie,js,je,pres,GV,h,nz)
-!$OMP do
+ !$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 do
+ !$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)
enddo ; enddo
enddo
-!$OMP end parallel
-
-!$OMP parallel do default(none) shared(nz,is,ie,js,je,use_EOS,G,GV,pres,T,S, &
-!$OMP IsdB,tv,h,h_neglect,e,dz_neglect, &
-!$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) &
-!$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, &
-!$OMP drdx,mag_grad2,Slope,slope2_Ratio)
+
+ !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,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) &
+ !$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, &
+ !$OMP drdx,mag_grad2,Slope,slope2_Ratio)
do j=js,je ; do K=nz,2,-1
if (.not.(use_EOS)) then
drdiA = 0.0 ; drdiB = 0.0
@@ -187,7 +199,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect
haR = 0.5*(h(i+1,j,k-1) + h(i+1,j,k)) + h_neglect
if (GV%Boussinesq) then
- dzaL = haL * GV%H_to_m ; dzaR = haR * GV%H_to_m
+ dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z
else
dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect
dzaR = 0.5*(e(i+1,j,K-1) - e(i+1,j,K+1)) + dz_neglect
@@ -207,7 +219,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
! This estimate of slope is accurate for small slopes, but bounded
! to be between -1 and 1.
- mag_grad2 = drdx**2 + drdz**2
+ mag_grad2 = drdx**2 + (L_to_Z*drdz)**2
if (mag_grad2 > 0.0) then
slope_x(I,j,K) = drdx / sqrt(mag_grad2)
else ! Just in case mag_grad2 = 0 ever.
@@ -217,20 +229,20 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of Brunt-Vaisala frequency (s-2)
else ! With .not.use_EOS, the layers are constant density.
- slope_x(I,j,K) = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j))
+ slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j)
endif
enddo ! I
enddo ; enddo ! end of j-loop
- ! Calculate the meridional isopycnal slope.
-!$OMP parallel do default(none) shared(nz,is,ie,js,je,use_EOS,G,GV,pres,T,S, &
-!$OMP IsdB,tv,h,h_neglect,e,dz_neglect, &
-!$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y) &
-!$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, &
-!$OMP drdy,mag_grad2,Slope,slope2_Ratio)
+ ! Calculate the meridional isopycnal slope.
+ !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,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 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, &
+ !$OMP drdy,mag_grad2,Slope,slope2_Ratio)
do j=js-1,je ; do K=nz,2,-1
if (.not.(use_EOS)) then
drdjA = 0.0 ; drdjB = 0.0
@@ -271,7 +283,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect
haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect
if (GV%Boussinesq) then
- dzaL = haL * GV%H_to_m ; dzaR = haR * GV%H_to_m
+ dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z
else
dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect
dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect
@@ -291,7 +303,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
! This estimate of slope is accurate for small slopes, but bounded
! to be between -1 and 1.
- mag_grad2 = drdy**2 + drdz**2
+ mag_grad2 = drdy**2 + (L_to_Z*drdz)**2
if (mag_grad2 > 0.0) then
slope_y(i,J,K) = drdy / sqrt(mag_grad2)
else ! Just in case mag_grad2 = 0 ever.
@@ -301,7 +313,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, &
if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of Brunt-Vaisala frequency (s-2)
else ! With .not.use_EOS, the layers are constant density.
- slope_y(i,J,K) = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J))
+ slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J)
endif
enddo ! i
@@ -311,14 +323,14 @@ end subroutine calc_isoneutral_slopes
!> Returns tracer arrays (nominally T and S) with massless layers filled with
!! sensible values, by diffusing vertically with a small but constant diffusivity.
-subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here)
+subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu)
- real, intent(in) :: kappa !< A vertical diffusivity to use for smoothing (m2 s-1)
- real, intent(in) :: dt !< The time increment, in s.
+ real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing
+ !! times a smoothing timescale, in Z2.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu)
integer, optional, intent(in) :: halo_here !< Halo width over which to compute
@@ -338,7 +350,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here)
is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo
nz = G%ke
- kap_dt_x2 = (2.0*kappa*dt)*GV%m_to_H**2
+ kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2
h_neglect = GV%H_subroundoff
if (kap_dt_x2 <= 0.0) then
diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90
index 38eb78b89a..6296dbc35b 100644
--- a/src/core/MOM_open_boundary.F90
+++ b/src/core/MOM_open_boundary.F90
@@ -53,9 +53,11 @@ module MOM_open_boundary
public fill_temp_salt_segments
public open_boundary_register_restarts
-integer, parameter, public :: OBC_NONE = 0, OBC_SIMPLE = 1, OBC_WALL = 2
-integer, parameter, public :: OBC_FLATHER = 3
-integer, parameter, public :: OBC_RADIATION = 4
+integer, parameter, public :: OBC_NONE = 0 !< Indicates the use of no open boundary
+integer, parameter, public :: OBC_SIMPLE = 1 !< Indicates the use of a simple inflow open boundary
+integer, parameter, public :: OBC_WALL = 2 !< Indicates the use of a closed sall
+integer, parameter, public :: OBC_FLATHER = 3 !< Indicates the use of a Flather open boundary
+integer, parameter, public :: OBC_RADIATION = 4 !< Indicates the use of a radiation open boundary
integer, parameter, public :: OBC_DIRECTION_N = 100 !< Indicates the boundary is an effective northern boundary
integer, parameter, public :: OBC_DIRECTION_S = 200 !< Indicates the boundary is an effective southern boundary
integer, parameter, public :: OBC_DIRECTION_E = 300 !< Indicates the boundary is an effective eastern boundary
@@ -110,6 +112,10 @@ module MOM_open_boundary
logical :: radiation_grad !< If true, 1D Orlanksi radiation boundary conditions are applied to
!! dudv and dvdx.
logical :: oblique !< Oblique waves supported at radiation boundary.
+ logical :: oblique_tan !< If true, 2D radiation boundary conditions are applied to
+ !! tangential flows.
+ logical :: oblique_grad !< If true, 2D radiation boundary conditions are applied to
+ !! dudv and dvdx.
logical :: nudged !< Optional supplement to radiation boundary.
logical :: nudged_tan !< Optional supplement to nudge tangential velocity.
logical :: nudged_grad !< Optional supplement to nudge normal gradient of tangential velocity.
@@ -147,15 +153,19 @@ module MOM_open_boundary
!! segment (m3 s-1).
real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to
!! the OB segment (m s-1).
- real, pointer, dimension(:,:) :: normal_trans_bt=>NULL()!< The barotropic transport normal to
- !! the OB segment (m3 s-1).
real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment (m).
real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the
- !! segment (m s-1)
+ !! segment (s-1)
+ real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the
+ !! segment (s-1)
+ real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the
+ !! segment (m-1 s-1)
real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff
!! for normal velocity
real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff
!! for normal velocity
+ real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation
+ !! for normal velocity
real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment
!! that values should be nudged towards (m s-1).
real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment
@@ -215,7 +225,7 @@ module MOM_open_boundary
logical :: zero_biharmonic = .false. !< If True, zeros the Laplacian of flow on open boundaries for
!! use in the biharmonic viscosity term.
logical :: brushcutter_mode = .false. !< If True, read data on supergrid.
- real :: g_Earth
+ real :: g_Earth !< The gravitational acceleration in m s-2.
! Properties of the segments used.
type(OBC_segment_type), pointer, dimension(:) :: &
segment => NULL() !< List of segment objects.
@@ -229,10 +239,6 @@ module MOM_open_boundary
!! velocities (or speed of characteristics) at the
!! new time level (1) or the running mean (0) for velocities.
!! Valid values range from 0 to 1, with a default of 0.3.
- real :: gamma_h !< The relative weighting for the baroclinic radiation
- !! velocities (or speed of characteristics) at the
- !! new time level (1) or the running mean (0) for thicknesses.
- !! Valid values range from 0 to 1, with a default of 0.2.
real :: rx_max !< The maximum magnitude of the baroclinic radiation
!! velocity (or speed of characteristics), in m s-1. The
!! default value is 10 m s-1.
@@ -241,6 +247,7 @@ module MOM_open_boundary
type(OBC_registry_type), pointer :: OBC_Reg => NULL() !< Registry type for boundaries
real, pointer, dimension(:,:,:) :: rx_normal => NULL() !< Array storage for restarts
real, pointer, dimension(:,:,:) :: ry_normal => NULL() !< Array storage for restarts
+ real, pointer, dimension(:,:,:) :: cff_normal => NULL() !< Array storage for restarts
real :: silly_h !< A silly value of thickness outside of the domain that
!! can be used to test the independence of the OBCs to
!! this external data, in m.
@@ -268,9 +275,9 @@ module MOM_open_boundary
!! When locked=.true.,no more boundaries can be registered.
end type OBC_registry_type
-integer :: id_clock_pass
+integer :: id_clock_pass !< A CPU time clock
-character(len=40) :: mdl = "MOM_open_boundary" ! This module's name.
+character(len=40) :: mdl = "MOM_open_boundary" !< This module's name.
! This include declares and sets the variable "version".
#include "version_variable.h"
@@ -289,7 +296,7 @@ subroutine open_boundary_config(G, param_file, OBC)
type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure
! Local variables
integer :: l ! For looping over segments
- logical :: debug_OBC, debug, mask_outside
+ logical :: debug_OBC, debug, mask_outside, reentrant_x, reentrant_y
character(len=15) :: segment_param_str ! The run-time parameter name for each segment
character(len=100) :: segment_str ! The contents (rhs) for parameter "segment_param_str"
character(len=200) :: config1 ! String for OBC_USER_CONFIG
@@ -319,7 +326,7 @@ subroutine open_boundary_config(G, param_file, OBC)
call get_param(param_file, mdl, "OBC_FREESLIP_VORTICITY", OBC%freeslip_vorticity, &
"If true, sets the normal gradient of tangential velocity to\n"// &
"zero in the relative vorticity on open boundaries. This cannot\n"// &
- "be true if another OBC_XXX_VORTICITY option is True.", default=.false.)
+ "be true if another OBC_XXX_VORTICITY option is True.", default=.true.)
call get_param(param_file, mdl, "OBC_COMPUTED_VORTICITY", OBC%computed_vorticity, &
"If true, uses the external values of tangential velocity\n"// &
"in the relative vorticity on open boundaries. This cannot\n"// &
@@ -343,7 +350,7 @@ subroutine open_boundary_config(G, param_file, OBC)
call get_param(param_file, mdl, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, &
"If true, sets the normal gradient of tangential velocity to\n"// &
"zero in the strain use in the stress tensor on open boundaries. This cannot\n"// &
- "be true if another OBC_XXX_STRAIN option is True.", default=.false.)
+ "be true if another OBC_XXX_STRAIN option is True.", default=.true.)
call get_param(param_file, mdl, "OBC_COMPUTED_STRAIN", OBC%computed_strain, &
"If true, sets the normal gradient of tangential velocity to\n"// &
"zero in the strain use in the stress tensor on open boundaries. This cannot\n"// &
@@ -384,6 +391,10 @@ subroutine open_boundary_config(G, param_file, OBC)
"A silly value of velocities used outside of open boundary \n"//&
"conditions for debugging.", units="m/s", default=0.0, &
do_not_log=.not.debug_OBC, debuggingParam=.true.)
+ reentrant_x = .false.
+ call get_param(param_file, mdl, "REENTRANT_X", reentrant_x, default=.true.)
+ reentrant_y = .false.
+ call get_param(param_file, mdl, "REENTRANT_Y", reentrant_y, default=.false.)
! Allocate everything
! Note the 0-segment is needed when %segnum_u/v(:,:) = 0
@@ -394,6 +405,8 @@ subroutine open_boundary_config(G, param_file, OBC)
OBC%segment(l)%radiation_tan = .false.
OBC%segment(l)%radiation_grad = .false.
OBC%segment(l)%oblique = .false.
+ OBC%segment(l)%oblique_tan = .false.
+ OBC%segment(l)%oblique_grad = .false.
OBC%segment(l)%nudged = .false.
OBC%segment(l)%nudged_tan = .false.
OBC%segment(l)%nudged_grad = .false.
@@ -419,9 +432,9 @@ subroutine open_boundary_config(G, param_file, OBC)
fail_if_missing=.true.)
segment_str = remove_spaces(segment_str)
if (segment_str(1:2) == 'I=') then
- call setup_u_point_obc(OBC, G, segment_str, l, param_file)
+ call setup_u_point_obc(OBC, G, segment_str, l, param_file, reentrant_y)
elseif (segment_str(1:2) == 'J=') then
- call setup_v_point_obc(OBC, G, segment_str, l, param_file)
+ call setup_v_point_obc(OBC, G, segment_str, l, param_file, reentrant_x)
else
call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config: "//&
"Unable to interpret "//segment_param_str//" = "//trim(segment_str))
@@ -431,7 +444,7 @@ subroutine open_boundary_config(G, param_file, OBC)
! if (open_boundary_query(OBC, needs_ext_seg_data=.true.)) &
call initialize_segment_data(G, OBC, param_file)
- if (open_boundary_query(OBC, apply_Flather_OBC=.true.)) then
+ if (open_boundary_query(OBC, apply_open_OBC=.true.)) then
call get_param(param_file, mdl, "OBC_RADIATION_MAX", OBC%rx_max, &
"The maximum magnitude of the baroclinic radiation \n"//&
"velocity (or speed of characteristics). This is only \n"//&
@@ -444,13 +457,6 @@ subroutine open_boundary_config(G, param_file, OBC)
"Valid values range from 0 to 1. This is only used if \n"//&
"one of the open boundary segments is using Orlanski.", &
units="nondim", default=0.3)
- call get_param(param_file, mdl, "OBC_RAD_THICK_WT", OBC%gamma_h, &
- "The relative weighting for the baroclinic radiation \n"//&
- "velocities (or speed of characteristics) at the new \n"//&
- "time level (1) or the running mean (0) for thicknesses. \n"//&
- "Valid values range from 0 to 1. This is only used if \n"//&
- "one of the open boundary segments is using Orlanski.", &
- units="nondim", default=0.2)
endif
Lscale_in = 0.
@@ -498,12 +504,14 @@ subroutine open_boundary_config(G, param_file, OBC)
end subroutine open_boundary_config
+!> Allocate space for reading OBC data from files. It sets up the required vertical
+!! remapping. In the process, it does funky stuff with the MPI processes.
subroutine initialize_segment_data(G, OBC, PF)
use mpp_mod, only : mpp_pe, mpp_set_current_pelist, mpp_get_current_pelist,mpp_npes
- type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure
- type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure
- type(param_file_type), intent(in) :: PF !< Parameter file handle
+ type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure
+ type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure
+ type(param_file_type), intent(in) :: PF !< Parameter file handle
integer :: n,m,num_fields
character(len=256) :: segstr, filename
@@ -513,7 +521,7 @@ subroutine initialize_segment_data(G, OBC, PF)
integer :: orient
character(len=32), dimension(MAX_OBC_FIELDS) :: fields ! segment field names
character(len=128) :: inputdir
- type(OBC_segment_type), pointer :: segment ! pointer to segment type list
+ type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list
character(len=32) :: remappingScheme
logical :: check_reconstruction, check_remapping, force_bounds_in_subcell
integer, dimension(4) :: siz,siz2
@@ -563,6 +571,13 @@ subroutine initialize_segment_data(G, OBC, PF)
if (OBC%user_BCs_set_globally) return
+ ! Try this here just for the documentation. It is repeated below.
+ do n=1, OBC%number_of_segments
+ segment => OBC%segment(n)
+ write(segnam,"('OBC_SEGMENT_',i3.3,'_DATA')") n
+ call get_param(PF, mdl, segnam, segstr, 'OBC segment docs')
+ enddo
+
!< temporarily disable communication in order to read segment data independently
allocate(saved_pelist(0:mpp_npes()-1))
@@ -583,7 +598,8 @@ subroutine initialize_segment_data(G, OBC, PF)
call parse_segment_data_str(trim(segstr), fields=fields, num_fields=num_fields)
if (num_fields == 0) then
- print *,'num_fields = 0';cycle ! cycle to next segment
+ call MOM_mesg('initialize_segment_data: num_fields = 0')
+ cycle ! cycle to next segment
endif
allocate(segment%field(num_fields))
@@ -756,12 +772,13 @@ subroutine setup_segment_indices(G, seg, Is_obc, Ie_obc, Js_obc, Je_obc)
end subroutine setup_segment_indices
!> Parse an OBC_SEGMENT_%%% string starting with "I=" and configure placement and type of OBC accordingly
-subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF)
+subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y)
type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure
type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure
character(len=*), intent(in) :: segment_str !< A string in form of "I=%,J=%:%,string"
integer, intent(in) :: l_seg !< which segment is this?
type(param_file_type), intent(in) :: PF !< Parameter file handle
+ logical, intent(in) :: reentrant_y !< is the domain reentrant in y?
! Local variables
integer :: I_obc, Js_obc, Je_obc ! Position of segment in global index space
integer :: j, a_loop
@@ -769,7 +786,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF)
character(len=128) :: segment_param_str
real, allocatable, dimension(:) :: tnudge
! This returns the global indices for the segment
- call parse_segment_str(G%ieg, G%jeg, segment_str, I_obc, Js_obc, Je_obc, action_str )
+ call parse_segment_str(G%ieg, G%jeg, segment_str, I_obc, Js_obc, Je_obc, action_str, reentrant_y)
call setup_segment_indices(G, OBC%segment(l_seg),I_obc,I_obc,Js_obc,Je_obc)
@@ -800,15 +817,24 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF)
OBC%open_u_BCs_exist_globally = .true.
OBC%radiation_BCs_exist_globally = .true.
elseif (trim(action_str(a_loop)) == 'ORLANSKI_TAN') then
+ OBC%segment(l_seg)%radiation = .true.
OBC%segment(l_seg)%radiation_tan = .true.
OBC%radiation_BCs_exist_globally = .true.
elseif (trim(action_str(a_loop)) == 'ORLANSKI_GRAD') then
+ OBC%segment(l_seg)%radiation = .true.
OBC%segment(l_seg)%radiation_grad = .true.
elseif (trim(action_str(a_loop)) == 'OBLIQUE') then
OBC%segment(l_seg)%oblique = .true.
OBC%segment(l_seg)%open = .true.
OBC%oblique_BCs_exist_globally = .true.
OBC%open_u_BCs_exist_globally = .true.
+ elseif (trim(action_str(a_loop)) == 'OBLIQUE_TAN') then
+ OBC%segment(l_seg)%oblique = .true.
+ OBC%segment(l_seg)%oblique_tan = .true.
+ OBC%oblique_BCs_exist_globally = .true.
+ elseif (trim(action_str(a_loop)) == 'OBLIQUE_GRAD') then
+ OBC%segment(l_seg)%oblique = .true.
+ OBC%segment(l_seg)%oblique_grad = .true.
elseif (trim(action_str(a_loop)) == 'NUDGED') then
OBC%segment(l_seg)%nudged = .true.
OBC%nudged_u_BCs_exist_globally = .true.
@@ -821,12 +847,6 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF)
OBC%segment(l_seg)%gradient = .true.
OBC%segment(l_seg)%open = .true.
OBC%open_u_BCs_exist_globally = .true.
- elseif (trim(action_str(a_loop)) == 'LEGACY') then
- OBC%segment(l_seg)%Flather = .true.
- OBC%segment(l_seg)%radiation = .true.
- OBC%Flather_u_BCs_exist_globally = .true.
- OBC%open_u_BCs_exist_globally = .true.
- OBC%radiation_BCs_exist_globally = .true.
elseif (trim(action_str(a_loop)) == 'SIMPLE') then
OBC%segment(l_seg)%specified = .true.
OBC%specified_u_BCs_exist_globally = .true. ! This avoids deallocation
@@ -868,15 +888,20 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF)
OBC%segment(l_seg)%Je_obc = Je_obc
call allocate_OBC_segment_data(OBC, OBC%segment(l_seg))
+ if (OBC%segment(l_seg)%oblique .and. OBC%segment(l_seg)%radiation) &
+ call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc:\n"//&
+ "Orlanski and Oblique OBC options cannot be used together on one segment.")
+
end subroutine setup_u_point_obc
!> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly
-subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF)
+subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x)
type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure
type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure
character(len=*), intent(in) :: segment_str !< A string in form of "J=%,I=%:%,string"
integer, intent(in) :: l_seg !< which segment is this?
type(param_file_type), intent(in) :: PF !< Parameter file handle
+ logical, intent(in) :: reentrant_x !< is the domain reentrant in x?
! Local variables
integer :: J_obc, Is_obc, Ie_obc ! Position of segment in global index space
integer :: i, a_loop
@@ -885,7 +910,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF)
real, allocatable, dimension(:) :: tnudge
! This returns the global indices for the segment
- call parse_segment_str(G%ieg, G%jeg, segment_str, J_obc, Is_obc, Ie_obc, action_str )
+ call parse_segment_str(G%ieg, G%jeg, segment_str, J_obc, Is_obc, Ie_obc, action_str, reentrant_x)
call setup_segment_indices(G, OBC%segment(l_seg),Is_obc,Ie_obc,J_obc,J_obc)
@@ -916,15 +941,24 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF)
OBC%open_v_BCs_exist_globally = .true.
OBC%radiation_BCs_exist_globally = .true.
elseif (trim(action_str(a_loop)) == 'ORLANSKI_TAN') then
+ OBC%segment(l_seg)%radiation = .true.
OBC%segment(l_seg)%radiation_tan = .true.
OBC%radiation_BCs_exist_globally = .true.
elseif (trim(action_str(a_loop)) == 'ORLANSKI_GRAD') then
+ OBC%segment(l_seg)%radiation = .true.
OBC%segment(l_seg)%radiation_grad = .true.
elseif (trim(action_str(a_loop)) == 'OBLIQUE') then
OBC%segment(l_seg)%oblique = .true.
OBC%segment(l_seg)%open = .true.
OBC%oblique_BCs_exist_globally = .true.
OBC%open_v_BCs_exist_globally = .true.
+ elseif (trim(action_str(a_loop)) == 'OBLIQUE_TAN') then
+ OBC%segment(l_seg)%oblique = .true.
+ OBC%segment(l_seg)%oblique_tan = .true.
+ OBC%oblique_BCs_exist_globally = .true.
+ elseif (trim(action_str(a_loop)) == 'OBLIQUE_GRAD') then
+ OBC%segment(l_seg)%oblique = .true.
+ OBC%segment(l_seg)%oblique_grad = .true.
elseif (trim(action_str(a_loop)) == 'NUDGED') then
OBC%segment(l_seg)%nudged = .true.
OBC%nudged_v_BCs_exist_globally = .true.
@@ -937,12 +971,6 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF)
OBC%segment(l_seg)%gradient = .true.
OBC%segment(l_seg)%open = .true.
OBC%open_v_BCs_exist_globally = .true.
- elseif (trim(action_str(a_loop)) == 'LEGACY') then
- OBC%segment(l_seg)%radiation = .true.
- OBC%segment(l_seg)%Flather = .true.
- OBC%Flather_v_BCs_exist_globally = .true.
- OBC%open_v_BCs_exist_globally = .true.
- OBC%radiation_BCs_exist_globally = .true.
elseif (trim(action_str(a_loop)) == 'SIMPLE') then
OBC%segment(l_seg)%specified = .true.
OBC%specified_v_BCs_exist_globally = .true. ! This avoids deallocation
@@ -984,10 +1012,14 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF)
OBC%segment(l_seg)%Je_obc = J_obc
call allocate_OBC_segment_data(OBC, OBC%segment(l_seg))
+ if (OBC%segment(l_seg)%oblique .and. OBC%segment(l_seg)%radiation) &
+ call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc:\n"//&
+ "Orlanski and Oblique OBC options cannot be used together on one segment.")
+
end subroutine setup_v_point_obc
!> Parse an OBC_SEGMENT_%%% string
-subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_str )
+subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_str, reentrant)
integer, intent(in) :: ni_global !< Number of h-points in zonal direction
integer, intent(in) :: nj_global !< Number of h-points in meridional direction
character(len=*), intent(in) :: segment_str !< A string in form of "I=l,J=m:n,string" or "J=l,I=m,n,string"
@@ -995,12 +1027,14 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_
integer, intent(out) :: m !< The value of J=m, if segment_str begins with I=, or the value of I=m
integer, intent(out) :: n !< The value of J=n, if segment_str begins with I=, or the value of I=n
character(len=*), intent(out) :: action_str(:) !< The "string" part of segment_str
+ logical, intent(in) :: reentrant !< is domain reentrant in relevant direction?
! Local variables
character(len=24) :: word1, word2, m_word, n_word !< Words delineated by commas in a string in form of
!! "I=%,J=%:%,string"
integer :: l_max !< Either ni_global or nj_global, depending on whether segment_str begins with "I=" or "J="
integer :: mn_max !< Either nj_global or ni_global, depending on whether segment_str begins with "I=" or "J="
integer :: j
+ integer, parameter :: halo = 10
! Process first word which will started with either 'I=' or 'J='
word1 = extract_word(segment_str,',',1)
@@ -1030,17 +1064,31 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_
! Read m
m_word = extract_word(word2(3:24),':',1)
m = interpret_int_expr( m_word, mn_max )
- if (m<-1 .or. m>mn_max+1) then
- call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//&
- "Beginning of range in string '"//trim(segment_str)//"' is outside of the physical domain.")
+ if (reentrant) then
+ if (m<-halo .or. m>mn_max+halo) then
+ call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//&
+ "Beginning of range in string '"//trim(segment_str)//"' is outside of the physical domain.")
+ endif
+ else
+ if (m<-1 .or. m>mn_max+1) then
+ call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//&
+ "Beginning of range in string '"//trim(segment_str)//"' is outside of the physical domain.")
+ endif
endif
- ! Read m
+ ! Read n
n_word = extract_word(word2(3:24),':',2)
n = interpret_int_expr( n_word, mn_max )
- if (n<-1 .or. n>mn_max+1) then
- call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//&
- "End of range in string '"//trim(segment_str)//"' is outside of the physical domain.")
+ if (reentrant) then
+ if (n<-halo .or. n>mn_max+halo) then
+ call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//&
+ "End of range in string '"//trim(segment_str)//"' is outside of the physical domain.")
+ endif
+ else
+ if (n<-1 .or. n>mn_max+1) then
+ call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//&
+ "End of range in string '"//trim(segment_str)//"' is outside of the physical domain.")
+ endif
endif
if (abs(n-m)==0) then
@@ -1055,7 +1103,7 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_
contains
- ! Returns integer value interpreted from string in form of %I, N or N-%I
+ ! Returns integer value interpreted from string in form of %I, N or N+-%I
integer function interpret_int_expr(string, imax)
character(len=*), intent(in) :: string !< Integer in form or %I, N or N-%I
integer, intent(in) :: imax !< Value to replace 'N' with
@@ -1068,8 +1116,13 @@ integer function interpret_int_expr(string, imax)
if (len_trim(string)==1 .and. string(1:1)=='N') then
interpret_int_expr = imax
elseif (string(1:1)=='N') then
- read(string(2:slen),*,err=911) interpret_int_expr
- interpret_int_expr = imax - interpret_int_expr
+ if (string(2:2)=='+') then
+ read(string(3:slen),*,err=911) interpret_int_expr
+ interpret_int_expr = imax + interpret_int_expr
+ elseif (string(2:2)=='-') then
+ read(string(3:slen),*,err=911) interpret_int_expr
+ interpret_int_expr = imax - interpret_int_expr
+ endif
else
read(string(1:slen),*,err=911) interpret_int_expr
endif
@@ -1216,7 +1269,6 @@ subroutine parse_segment_param_real(segment_str, var, param_value, debug )
call abort()
endif
- print *,'00001x'
! Process first word which will start with the fieldname
word3 = extract_word(segment_str,',',m)
! word1 = extract_word(word3,':',1)
@@ -1226,7 +1278,6 @@ subroutine parse_segment_param_real(segment_str, var, param_value, debug )
method=trim(extract_word(word1,'=',2))
lword=len_trim(method)
read(method(1:lword),*,err=987) param_value
- print *,'00002x'
! if (method(lword-3:lword) == 'file') then
! ! raise an error id filename/fieldname not in argument list
! word1 = extract_word(word3,':',2)
@@ -1289,7 +1340,7 @@ end function open_boundary_query
!> Deallocate open boundary data
subroutine open_boundary_dealloc(OBC)
type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
integer :: n
if (.not. associated(OBC)) return
@@ -1317,7 +1368,7 @@ subroutine open_boundary_impose_normal_slope(OBC, G, depth)
real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: depth !< Bathymetry at h-points
! Local variables
integer :: i, j, n
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
if (.not.associated(OBC)) return
@@ -1354,7 +1405,8 @@ subroutine open_boundary_impose_normal_slope(OBC, G, depth)
end subroutine open_boundary_impose_normal_slope
!> Reconcile masks and open boundaries, deallocate OBC on PEs where it is not needed.
-!! Also adjust u- and v-point cell area on specified open boundaries.
+!! Also adjust u- and v-point cell area on specified open boundaries and mask all
+!! points outside open boundaries.
subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv)
type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure
type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure
@@ -1362,7 +1414,7 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv)
real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell (m2)
! Local variables
integer :: i, j, n
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
logical :: any_U, any_V
if (.not.associated(OBC)) return
@@ -1372,6 +1424,7 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv)
if (.not. segment%on_pe) cycle
if (segment%is_E_or_W) then
! Sweep along u-segments and delete the OBC for blocked points.
+ ! Also, mask all points outside.
I=segment%HI%IsdB
do j=segment%HI%jsd,segment%HI%jed
if (G%mask2dCu(I,j) == 0) OBC%segnum_u(I,j) = OBC_NONE
@@ -1476,15 +1529,17 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v
real, intent(in) :: dt !< Appropriate timestep
! Local variables
- real :: dhdt, dhdx, dhdy, gamma_u, gamma_h, gamma_v, gamma_2
+ real :: dhdt, dhdx, dhdy, gamma_u, gamma_v, gamma_2
real :: cff, Cx, Cy, tau
real :: rx_max, ry_max ! coefficients for radiation
real :: rx_new, rx_avg ! coefficients for radiation
real :: ry_new, ry_avg ! coefficients for radiation
+ real :: cff_new, cff_avg ! denominator in oblique
real, pointer, dimension(:,:,:) :: rx_tangential=>NULL()
real, pointer, dimension(:,:,:) :: ry_tangential=>NULL()
+ real, pointer, dimension(:,:,:) :: cff_tangential=>NULL()
real, parameter :: eps = 1.0e-20
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
integer :: i, j, k, is, ie, js, je, nz, n
integer :: is_obc, ie_obc, js_obc, je_obc
@@ -1522,6 +1577,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
do j=segment%HI%jsd,segment%HI%jed
segment%rx_normal(I,j,k) = OBC%rx_normal(I,j,k)
segment%ry_normal(I,j,k) = OBC%ry_normal(I,j,k)
+ segment%cff_normal(I,j,k) = OBC%cff_normal(I,j,k)
enddo
enddo
elseif (segment%is_N_or_S .and. segment%oblique) then
@@ -1530,12 +1586,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
do i=segment%HI%isd,segment%HI%ied
segment%rx_normal(i,J,k) = OBC%rx_normal(i,J,k)
segment%ry_normal(i,J,k) = OBC%ry_normal(i,J,k)
+ segment%cff_normal(i,J,k) = OBC%cff_normal(i,J,k)
enddo
enddo
endif
enddo
- gamma_u = OBC%gamma_uv ; gamma_v = OBC%gamma_uv ; gamma_h = OBC%gamma_h
+ gamma_u = OBC%gamma_uv ; gamma_v = OBC%gamma_uv
rx_max = OBC%rx_max ; ry_max = OBC%rx_max
do n=1,OBC%number_of_segments
segment=>OBC%segment(n)
@@ -1563,23 +1620,36 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
dhdt = u_old(I-1,j,k)-u_new(I-1,j,k) !old-new
dhdx = u_new(I-1,j,k)-u_new(I-2,j,k) !in new time backward sasha for I-1
if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then
- ry_new = segment%grad_normal(J-1,1,k)
+ dhdy = segment%grad_normal(J-1,1,k)
elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then
- ry_new = 0.0
+ dhdy = 0.0
else
- ry_new = segment%grad_normal(J,1,k)
+ dhdy = segment%grad_normal(J,1,k)
endif
if (dhdt*dhdx < 0.0) dhdt = 0.0
- Cx = dhdt*dhdx
- cff = max(dhdx*dhdx + dhdy*dhdy, eps)
- Cy = min(cff,max(dhdt*dhdy,-cff))
- segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I-1,j,k)) - &
- (max(Cy,0.0)*segment%grad_normal(J-1,2,k) + min(Cy,0.0)*segment%grad_normal(J,2,k))) / (cff + Cx)
+ rx_new = dhdt*dhdx
+ cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
+ ry_new = min(cff,max(dhdt*dhdy,-cff))
+ rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new
+ ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new
+ cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new
+ segment%rx_normal(I,j,k) = rx_avg
+ segment%ry_normal(i,J,k) = ry_avg
+ segment%cff_normal(i,J,k) = cff_avg
+ segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - &
+ (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / &
+ (cff_avg + rx_avg)
+ ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues
+ ! implemented as a work-around to limitations in restart capability
+ OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k)
+ OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k)
+ OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k)
elseif (segment%gradient) then
segment%normal_vel(I,j,k) = u_new(I-1,j,k)
endif
if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then
- if (dhdt*dhdx < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (dhdt*dhdx <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1607,7 +1677,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
endif
if (segment%nudged_tan) then
do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
- if (rx_tangential(I,J,k) < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (rx_tangential(I,J,k) <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1637,7 +1708,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
endif
if (segment%nudged_grad) then
do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
- if (rx_tangential(I,J,k) < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (rx_tangential(I,J,k) <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1649,6 +1721,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
endif
deallocate(rx_tangential)
endif
+ if (segment%oblique_tan .or. segment%oblique_grad) then
+ I=segment%HI%IsdB
+ allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ do k=1,nz
+ rx_tangential(I,segment%HI%JsdB,k) = segment%rx_normal(I,segment%HI%jsd,k)
+ rx_tangential(I,segment%HI%JedB,k) = segment%rx_normal(I,segment%HI%jed,k)
+ ry_tangential(I,segment%HI%JsdB,k) = segment%ry_normal(I,segment%HI%jsd,k)
+ ry_tangential(I,segment%HI%JedB,k) = segment%ry_normal(I,segment%HI%jed,k)
+ cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k)
+ cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k)
+ do J=segment%HI%JsdB+1,segment%HI%JedB-1
+ rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k))
+ ry_tangential(I,J,k) = 0.5*(segment%ry_normal(I,j,k) + segment%ry_normal(I,j+1,k))
+ cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k))
+ enddo
+ enddo
+ if (segment%oblique_tan) then
+ do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1
+ rx_avg = rx_tangential(I,J,k)
+ ry_avg = ry_tangential(I,J,k)
+ cff_avg = cff_tangential(I,J,k)
+ segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - &
+ (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / &
+ (cff_avg + rx_avg)
+ enddo ; enddo
+ endif
+ if (segment%nudged_tan) then
+ do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (rx_tangential(I,J,k) <= 0.0) then
+ tau = segment%Velocity_nudging_timescale_in
+ else
+ tau = segment%Velocity_nudging_timescale_out
+ endif
+ gamma_2 = dt / (tau + dt)
+ segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + &
+ gamma_2 * segment%nudged_tangential_vel(I,J,k)
+ enddo ; enddo
+ endif
+ if (segment%oblique_grad) then
+ Js_obc = max(segment%HI%JsdB,G%jsd+1)
+ Je_obc = min(segment%HI%JedB,G%jed-1)
+ do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1
+ rx_avg = rx_tangential(I,J,k)
+ ry_avg = ry_tangential(I,J,k)
+ cff_avg = cff_tangential(I,J,k)
+ segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) &
+ + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - &
+ (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / &
+ (cff_avg + rx_avg)
+ enddo ; enddo
+ endif
+ if (segment%nudged_grad) then
+ do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (rx_tangential(I,J,k) <= 0.0) then
+ tau = segment%Velocity_nudging_timescale_in
+ else
+ tau = segment%Velocity_nudging_timescale_out
+ endif
+ gamma_2 = dt / (tau + dt)
+ segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + &
+ gamma_2 * segment%nudged_tangential_grad(I,J,k)
+ enddo ; enddo
+ endif
+ deallocate(rx_tangential)
+ deallocate(ry_tangential)
+ deallocate(cff_tangential)
+ endif
endif
if (segment%direction == OBC_DIRECTION_W) then
@@ -1680,16 +1823,29 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
dhdy = segment%grad_normal(J,1,k)
endif
if (dhdt*dhdx < 0.0) dhdt = 0.0
- Cx = dhdt*dhdx
- cff = max(dhdx*dhdx + dhdy*dhdy, eps)
- Cy = min(cff,max(dhdt*dhdy,-cff))
- segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I+1,j,k)) - &
- (max(Cy,0.0)*segment%grad_normal(J-1,2,k) + min(Cy,0.0)*segment%grad_normal(J,2,k))) / (cff + Cx)
+ rx_new = dhdt*dhdx
+ cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
+ ry_new = min(cff,max(dhdt*dhdy,-cff))
+ rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new
+ ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new
+ cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new
+ segment%rx_normal(I,j,k) = rx_avg
+ segment%ry_normal(i,J,k) = ry_avg
+ segment%cff_normal(i,J,k) = cff_avg
+ segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - &
+ (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / &
+ (cff_avg + rx_avg)
+ ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues
+ ! implemented as a work-around to limitations in restart capability
+ OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k)
+ OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k)
+ OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k)
elseif (segment%gradient) then
segment%normal_vel(I,j,k) = u_new(I+1,j,k)
endif
if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then
- if (dhdt*dhdx < 0.0) then
+ ! dhdt gets set to 0. on inflow in oblique case
+ if (dhdt*dhdx <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1712,12 +1868,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
if (segment%radiation_tan) then
do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
rx_avg = rx_tangential(I,J,k)
- segment%tangential_vel(I,J,k) = (v_new(I+1,J,k) + rx_avg*v_new(I+2,J,k)) / (1.0+rx_avg)
+ segment%tangential_vel(I,J,k) = (v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg)
enddo ; enddo
endif
if (segment%nudged_tan) then
do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
- if (rx_tangential(I,J,k) < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (rx_tangential(I,J,k) <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1747,7 +1904,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
endif
if (segment%nudged_grad) then
do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
- if (rx_tangential(I,J,k) < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (rx_tangential(I,J,k) <= 0.0) then
+ tau = segment%Velocity_nudging_timescale_in
+ else
+ tau = segment%Velocity_nudging_timescale_out
+ endif
+ gamma_2 = dt / (tau + dt)
+ segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + &
+ gamma_2 * segment%nudged_tangential_grad(I,J,k)
+ enddo ; enddo
+ endif
+ deallocate(rx_tangential)
+ endif
+ if (segment%oblique_tan .or. segment%oblique_grad) then
+ I=segment%HI%IsdB
+ allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ do k=1,nz
+ rx_tangential(I,segment%HI%JsdB,k) = segment%rx_normal(I,segment%HI%jsd,k)
+ rx_tangential(I,segment%HI%JedB,k) = segment%rx_normal(I,segment%HI%jed,k)
+ ry_tangential(I,segment%HI%JsdB,k) = segment%ry_normal(I,segment%HI%jsd,k)
+ ry_tangential(I,segment%HI%JedB,k) = segment%ry_normal(I,segment%HI%jed,k)
+ cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k)
+ cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k)
+ do J=segment%HI%JsdB+1,segment%HI%JedB-1
+ rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k))
+ ry_tangential(I,J,k) = 0.5*(segment%ry_normal(I,j,k) + segment%ry_normal(I,j+1,k))
+ cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k))
+ enddo
+ enddo
+ if (segment%oblique_tan) then
+ do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1
+ rx_avg = rx_tangential(I,J,k)
+ ry_avg = ry_tangential(I,J,k)
+ cff_avg = cff_tangential(I,J,k)
+ segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - &
+ (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / &
+ (cff_avg + rx_avg)
+ enddo ; enddo
+ endif
+ if (segment%nudged_tan) then
+ do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (rx_tangential(I,J,k) <= 0.0) then
+ tau = segment%Velocity_nudging_timescale_in
+ else
+ tau = segment%Velocity_nudging_timescale_out
+ endif
+ gamma_2 = dt / (tau + dt)
+ segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + &
+ gamma_2 * segment%nudged_tangential_vel(I,J,k)
+ enddo ; enddo
+ endif
+ if (segment%oblique_grad) then
+ Js_obc = max(segment%HI%JsdB,G%jsd+1)
+ Je_obc = min(segment%HI%JedB,G%jed-1)
+ do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1
+ rx_avg = rx_tangential(I,J,k)
+ ry_avg = ry_tangential(I,J,k)
+ cff_avg = cff_tangential(I,J,k)
+ segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) &
+ + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - &
+ (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / &
+ (cff_avg + rx_avg)
+ enddo ; enddo
+ endif
+ if (segment%nudged_grad) then
+ do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (rx_tangential(I,J,k) <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1758,6 +1985,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
enddo ; enddo
endif
deallocate(rx_tangential)
+ deallocate(ry_tangential)
+ deallocate(cff_tangential)
endif
endif
@@ -1791,16 +2020,29 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
dhdx = segment%grad_normal(I,1,k)
endif
if (dhdt*dhdy < 0.0) dhdt = 0.0
- Cy = dhdt*dhdy
- cff = max(dhdx*dhdx + dhdy*dhdy, eps)
- Cx = min(cff,max(dhdt*dhdx,-cff))
- segment%normal_vel(i,J,k) = ((cff*v_new(i,J,k) + Cy*v_new(i,J-1,k)) - &
- (max(Cx,0.0)*segment%grad_normal(I-1,2,k) + min(Cx,0.0)*segment%grad_normal(I,2,k))) / (cff + Cy)
+ ry_new = dhdt*dhdy
+ cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
+ rx_new = min(cff,max(dhdt*dhdx,-cff))
+ rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new
+ ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new
+ cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new
+ segment%rx_normal(I,j,k) = rx_avg
+ segment%ry_normal(i,J,k) = ry_avg
+ segment%cff_normal(i,J,k) = cff_avg
+ segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - &
+ (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / &
+ (cff_avg + ry_avg)
+ ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues
+ ! implemented as a work-around to limitations in restart capability
+ OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k)
+ OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k)
+ OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k)
elseif (segment%gradient) then
segment%normal_vel(i,J,k) = v_new(i,J-1,k)
endif
if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then
- if (dhdt*dhdy < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (dhdt*dhdy <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1828,7 +2070,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
endif
if (segment%nudged_tan) then
do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB
- if (rx_tangential(I,J,k) < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (rx_tangential(I,J,k) <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1852,13 +2095,83 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
! else
! rx_avg = 0.0
! endif
- segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I-1,j,k))*G%IdyBu(I,J-1) + &
+ segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + &
rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg)
enddo ; enddo
endif
if (segment%nudged_grad) then
do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB
- if (rx_tangential(I,J,k) < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (ry_tangential(I,J,k) <= 0.0) then
+ tau = segment%Velocity_nudging_timescale_in
+ else
+ tau = segment%Velocity_nudging_timescale_out
+ endif
+ gamma_2 = dt / (tau + dt)
+ segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + &
+ gamma_2 * segment%nudged_tangential_grad(I,J,k)
+ enddo ; enddo
+ endif
+ deallocate(rx_tangential)
+ endif
+ if (segment%oblique_tan .or. segment%oblique_grad) then
+ J=segment%HI%JsdB
+ allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ do k=1,nz
+ rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k)
+ rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k)
+ ry_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k)
+ ry_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k)
+ cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k)
+ cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k)
+ do I=segment%HI%IsdB+1,segment%HI%IedB-1
+ rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k))
+ ry_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k))
+ cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k))
+ enddo
+ enddo
+ if (segment%oblique_tan) then
+ do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1
+ rx_avg = rx_tangential(I,J,k)
+ ry_avg = ry_tangential(I,J,k)
+ cff_avg = cff_tangential(I,J,k)
+ segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - &
+ (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / &
+ (cff_avg + rx_avg)
+ enddo ; enddo
+ endif
+ if (segment%nudged_tan) then
+ do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (ry_tangential(I,J,k) <= 0.0) then
+ tau = segment%Velocity_nudging_timescale_in
+ else
+ tau = segment%Velocity_nudging_timescale_out
+ endif
+ gamma_2 = dt / (tau + dt)
+ segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + &
+ gamma_2 * segment%nudged_tangential_vel(I,J,k)
+ enddo ; enddo
+ endif
+ if (segment%oblique_grad) then
+ Is_obc = max(segment%HI%IsdB,G%isd+1)
+ Ie_obc = min(segment%HI%IedB,G%ied-1)
+ do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1
+ rx_avg = rx_tangential(I,J,k)
+ ry_avg = ry_tangential(I,J,k)
+ cff_avg = cff_tangential(I,J,k)
+ segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) &
+ + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - &
+ (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / &
+ (cff_avg + rx_avg)
+ enddo ; enddo
+ endif
+ if (segment%nudged_grad) then
+ do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (ry_tangential(I,J,k) <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1869,10 +2182,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
enddo ; enddo
endif
deallocate(rx_tangential)
+ deallocate(ry_tangential)
+ deallocate(cff_tangential)
endif
endif
-
if (segment%direction == OBC_DIRECTION_S) then
J=segment%HI%JsdB
if (J>G%HI%JecB) cycle
@@ -1902,16 +2216,29 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
dhdx = segment%grad_normal(I,1,k)
endif
if (dhdt*dhdy < 0.0) dhdt = 0.0
- Cy = dhdt*dhdy
- cff = max(dhdx*dhdx + dhdy*dhdy, eps)
- Cx = min(cff,max(dhdt*dhdx,-cff))
- segment%normal_vel(i,J,k) = ((cff*v_new(i,J,k) + Cy*v_new(i,J+1,k)) - &
- (max(Cx,0.0)*segment%grad_normal(I-1,2,k) + min(Cx,0.0)*segment%grad_normal(I,2,k))) / (cff + Cy)
+ ry_new = dhdt*dhdy
+ cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
+ rx_new = min(cff,max(dhdt*dhdx,-cff))
+ rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new
+ ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new
+ cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new
+ segment%rx_normal(I,j,k) = rx_avg
+ segment%ry_normal(i,J,k) = ry_avg
+ segment%cff_normal(i,J,k) = cff_avg
+ segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - &
+ (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / &
+ (cff_avg + ry_avg)
+ ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues
+ ! implemented as a work-around to limitations in restart capability
+ OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k)
+ OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k)
+ OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k)
elseif (segment%gradient) then
segment%normal_vel(i,J,k) = v_new(i,J+1,k)
endif
if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then
- if (dhdt*dhdy < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (dhdt*dhdy <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1939,7 +2266,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
endif
if (segment%nudged_tan) then
do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB
- if (rx_tangential(I,J,k) < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (rx_tangential(I,J,k) <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1969,7 +2297,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
endif
if (segment%nudged_grad) then
do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
- if (rx_tangential(I,J,k) < 0.0) then
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (ry_tangential(I,J,k) <= 0.0) then
tau = segment%Velocity_nudging_timescale_in
else
tau = segment%Velocity_nudging_timescale_out
@@ -1981,6 +2310,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
endif
deallocate(rx_tangential)
endif
+ if (segment%oblique_tan .or. segment%oblique_grad) then
+ J=segment%HI%JsdB
+ allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz))
+ do k=1,nz
+ rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k)
+ rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k)
+ ry_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k)
+ ry_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k)
+ cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k)
+ cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k)
+ do I=segment%HI%IsdB+1,segment%HI%IedB-1
+ rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k))
+ ry_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k))
+ cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k))
+ enddo
+ enddo
+ if (segment%oblique_tan) then
+ do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1
+ rx_avg = rx_tangential(I,J,k)
+ ry_avg = ry_tangential(I,J,k)
+ cff_avg = cff_tangential(I,J,k)
+ segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - &
+ (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / &
+ (cff_avg + rx_avg)
+ enddo ; enddo
+ endif
+ if (segment%nudged_tan) then
+ do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (ry_tangential(I,J,k) <= 0.0) then
+ tau = segment%Velocity_nudging_timescale_in
+ else
+ tau = segment%Velocity_nudging_timescale_out
+ endif
+ gamma_2 = dt / (tau + dt)
+ segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + &
+ gamma_2 * segment%nudged_tangential_vel(I,J,k)
+ enddo ; enddo
+ endif
+ if (segment%oblique_grad) then
+ Is_obc = max(segment%HI%IsdB,G%isd+1)
+ Ie_obc = min(segment%HI%IedB,G%ied-1)
+ do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1
+ rx_avg = rx_tangential(I,J,k)
+ ry_avg = ry_tangential(I,J,k)
+ cff_avg = cff_tangential(I,J,k)
+ segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) &
+ + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - &
+ (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / &
+ (cff_avg + rx_avg)
+ enddo ; enddo
+ endif
+ if (segment%nudged_grad) then
+ do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB
+ ! dhdt gets set to 0 on inflow in oblique case
+ if (ry_tangential(I,J,k) <= 0.0) then
+ tau = segment%Velocity_nudging_timescale_in
+ else
+ tau = segment%Velocity_nudging_timescale_out
+ endif
+ gamma_2 = dt / (tau + dt)
+ segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + &
+ gamma_2 * segment%nudged_tangential_grad(I,J,k)
+ enddo ; enddo
+ endif
+ deallocate(rx_tangential)
+ deallocate(ry_tangential)
+ deallocate(cff_tangential)
+ endif
endif
enddo
@@ -2000,7 +2400,7 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v)
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open boundaries
! Local variables
integer :: i, j, k, n
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
if (.not.associated(OBC)) return ! Bail out if OBC is not available
@@ -2034,7 +2434,7 @@ subroutine open_boundary_zero_normal_flow(OBC, G, u, v)
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open boundaries
! Local variables
integer :: i, j, k, n
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
if (.not.associated(OBC)) return ! Bail out if OBC is not available
@@ -2058,7 +2458,7 @@ subroutine open_boundary_zero_normal_flow(OBC, G, u, v)
end subroutine open_boundary_zero_normal_flow
!> Calculate the tangential gradient of the normal flow at the boundary q-points.
-subroutine gradient_at_q_points(G,segment,uvel,vvel)
+subroutine gradient_at_q_points(G, segment, uvel, vvel)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(OBC_segment_type), pointer :: segment !< OBC segment structure
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity
@@ -2076,6 +2476,24 @@ subroutine gradient_at_q_points(G,segment,uvel,vvel)
segment%grad_normal(J,2,k) = (uvel(I,j+1,k)-uvel(I,j,k)) * G%mask2dBu(I,J)
enddo
enddo
+ if (segment%oblique_tan) then
+ do k=1,G%ke
+ do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1)
+ segment%grad_tan(j,1,k) = (vvel(i-1,J,k)-vvel(i-1,J-1,k)) * G%mask2dT(i-1,j)
+ segment%grad_tan(j,2,k) = (vvel(i,J,k)-vvel(i,J-1,k)) * G%mask2dT(i,j)
+ enddo
+ enddo
+ endif
+ if (segment%oblique_grad) then
+ do k=1,G%ke
+ do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1)
+ segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%IdxBu(I-2,J)) - &
+ (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j)
+ segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%IdxBu(I-1,J)) - &
+ (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j)
+ enddo
+ enddo
+ endif
else ! western segment
I=segment%HI%isdB
do k=1,G%ke
@@ -2084,6 +2502,24 @@ subroutine gradient_at_q_points(G,segment,uvel,vvel)
segment%grad_normal(J,2,k) = (uvel(I,j+1,k)-uvel(I,j,k)) * G%mask2dBu(I,J)
enddo
enddo
+ if (segment%oblique_tan) then
+ do k=1,G%ke
+ do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1)
+ segment%grad_tan(j,1,k) = (vvel(i+2,J,k)-vvel(i+2,J-1,k)) * G%mask2dT(i+2,j)
+ segment%grad_tan(j,2,k) = (vvel(i+1,J,k)-vvel(i+1,J-1,k)) * G%mask2dT(i+1,j)
+ enddo
+ enddo
+ endif
+ if (segment%oblique_grad) then
+ do k=1,G%ke
+ do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1)
+ segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%IdxBu(I+2,J)) - &
+ (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j)
+ segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%IdxBu(I+1,J)) - &
+ (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j)
+ enddo
+ enddo
+ endif
endif
elseif (segment%is_N_or_S) then
if (segment%direction == OBC_DIRECTION_N) then
@@ -2094,6 +2530,24 @@ subroutine gradient_at_q_points(G,segment,uvel,vvel)
segment%grad_normal(I,2,k) = (vvel(i+1,J,k)-vvel(i,J,k)) * G%mask2dBu(I,J)
enddo
enddo
+ if (segment%oblique_tan) then
+ do k=1,G%ke
+ do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1)
+ segment%grad_tan(i,1,k) = (uvel(I,j-1,k)-uvel(I-1,j-1,k)) * G%mask2dT(i,j-1)
+ segment%grad_tan(i,2,k) = (uvel(I,j,k)-uvel(I-1,j,k)) * G%mask2dT(i,j)
+ enddo
+ enddo
+ endif
+ if (segment%oblique_grad) then
+ do k=1,G%ke
+ do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1)
+ segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdxBu(I,J-2)) - &
+ (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1)
+ segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%IdyBu(I,J-1)) - &
+ (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J)
+ enddo
+ enddo
+ endif
else ! south segment
J=segment%HI%jsdB
do k=1,G%ke
@@ -2102,6 +2556,24 @@ subroutine gradient_at_q_points(G,segment,uvel,vvel)
segment%grad_normal(I,2,k) = (vvel(i+1,J,k)-vvel(i,J,k)) * G%mask2dBu(I,J)
enddo
enddo
+ if (segment%oblique_tan) then
+ do k=1,G%ke
+ do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1)
+ segment%grad_tan(i,1,k) = (uvel(I,j+2,k)-uvel(I-1,j+2,k)) * G%mask2dT(i,j+2)
+ segment%grad_tan(i,2,k) = (uvel(I,j+1,k)-uvel(I-1,j+1,k)) * G%mask2dT(i,j+1)
+ enddo
+ enddo
+ endif
+ if (segment%oblique_grad) then
+ do k=1,G%ke
+ do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1)
+ segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdxBu(I,J+2)) - &
+ (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2)
+ segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%IdxBu(I,J+1)) - &
+ (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1)
+ enddo
+ enddo
+ endif
endif
endif
@@ -2121,7 +2593,7 @@ subroutine set_tracer_data(OBC, tv, h, G, PF, tracer_Reg)
integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz, n
integer :: isd_off, jsd_off
integer :: IsdB, IedB, JsdB, JedB
- type(OBC_segment_type), pointer :: segment ! pointer to segment type list
+ type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list
character(len=40) :: mdl = "set_tracer_data" ! This subroutine's name.
character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path
@@ -2242,7 +2714,6 @@ subroutine allocate_OBC_segment_data(OBC, segment)
allocate(segment%Htot(IsdB:IedB,jsd:jed)); segment%Htot(:,:)=0.0
allocate(segment%h(IsdB:IedB,jsd:jed,OBC%ke)); segment%h(:,:,:)=0.0
allocate(segment%eta(IsdB:IedB,jsd:jed)); segment%eta(:,:)=0.0
- allocate(segment%normal_trans_bt(IsdB:IedB,jsd:jed)); segment%normal_trans_bt(:,:)=0.0
if (segment%radiation) then
allocate(segment%rx_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_normal(:,:,:)=0.0
endif
@@ -2252,8 +2723,8 @@ subroutine allocate_OBC_segment_data(OBC, segment)
if (segment%nudged) then
allocate(segment%nudged_normal_vel(IsdB:IedB,jsd:jed,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0
endif
- if (OBC%computed_vorticity .or. segment%nudged_tan .or. segment%specified_tan .or. &
- OBC%computed_strain) then
+ if (segment%radiation_tan .or. segment%nudged_tan .or. segment%specified_tan .or. &
+ OBC%computed_vorticity .or. OBC%computed_strain) then
allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_vel(:,:,:)=0.0
endif
if (segment%nudged_tan) then
@@ -2262,13 +2733,21 @@ subroutine allocate_OBC_segment_data(OBC, segment)
if (segment%nudged_grad) then
allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0
endif
- if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad) then
+ if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. &
+ segment%oblique_grad) then
allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0
endif
if (segment%oblique) then
allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0
allocate(segment%rx_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_normal(:,:,:)=0.0
allocate(segment%ry_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%ry_normal(:,:,:)=0.0
+ allocate(segment%cff_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%cff_normal(:,:,:)=0.0
+ endif
+ if (segment%oblique_tan) then
+ allocate(segment%grad_tan(jsd:jed,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0
+ endif
+ if (segment%oblique_grad) then
+ allocate(segment%grad_gradient(jsd:jed,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0
endif
endif
@@ -2278,7 +2757,6 @@ subroutine allocate_OBC_segment_data(OBC, segment)
allocate(segment%Htot(isd:ied,JsdB:JedB)); segment%Htot(:,:)=0.0
allocate(segment%h(isd:ied,JsdB:JedB,OBC%ke)); segment%h(:,:,:)=0.0
allocate(segment%eta(isd:ied,JsdB:JedB)); segment%eta(:,:)=0.0
- allocate(segment%normal_trans_bt(isd:ied,JsdB:JedB)); segment%normal_trans_bt(:,:)=0.0
if (segment%radiation) then
allocate(segment%ry_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_normal(:,:,:)=0.0
endif
@@ -2288,8 +2766,8 @@ subroutine allocate_OBC_segment_data(OBC, segment)
if (segment%nudged) then
allocate(segment%nudged_normal_vel(isd:ied,JsdB:JedB,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0
endif
- if (OBC%computed_vorticity .or. segment%nudged_tan .or. segment%specified_tan .or. &
- OBC%computed_strain) then
+ if (segment%radiation_tan .or. segment%nudged_tan .or. segment%specified_tan .or. &
+ OBC%computed_vorticity .or. OBC%computed_strain) then
allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_vel(:,:,:)=0.0
endif
if (segment%nudged_tan) then
@@ -2298,13 +2776,21 @@ subroutine allocate_OBC_segment_data(OBC, segment)
if (segment%nudged_grad) then
allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0
endif
- if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad) then
+ if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. &
+ segment%oblique_grad) then
allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0
endif
if (segment%oblique) then
allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0
allocate(segment%rx_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%rx_normal(:,:,:)=0.0
allocate(segment%ry_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_normal(:,:,:)=0.0
+ allocate(segment%cff_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%cff_normal(:,:,:)=0.0
+ endif
+ if (segment%oblique_tan) then
+ allocate(segment%grad_tan(isd:ied,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0
+ endif
+ if (segment%oblique_grad) then
+ allocate(segment%grad_gradient(isd:ied,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0
endif
endif
@@ -2323,15 +2809,19 @@ subroutine deallocate_OBC_segment_data(OBC, segment)
if (associated (segment%Htot)) deallocate(segment%Htot)
if (associated (segment%h)) deallocate(segment%h)
if (associated (segment%eta)) deallocate(segment%eta)
- if (associated (segment%normal_trans_bt)) deallocate(segment%normal_trans_bt)
if (associated (segment%rx_normal)) deallocate(segment%rx_normal)
if (associated (segment%ry_normal)) deallocate(segment%ry_normal)
+ if (associated (segment%cff_normal)) deallocate(segment%cff_normal)
+ if (associated (segment%grad_normal)) deallocate(segment%grad_normal)
+ if (associated (segment%grad_tan)) deallocate(segment%grad_tan)
+ if (associated (segment%grad_gradient)) deallocate(segment%grad_gradient)
if (associated (segment%normal_vel)) deallocate(segment%normal_vel)
if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt)
if (associated (segment%normal_trans)) deallocate(segment%normal_trans)
if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel)
if (associated (segment%tangential_vel)) deallocate(segment%tangential_vel)
if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel)
+ if (associated (segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad)
if (associated (segment%tangential_grad)) deallocate(segment%tangential_grad)
if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg)
@@ -2430,16 +2920,13 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time)
type(ocean_OBC_type), pointer :: OBC !< Open boundary structure
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure
real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Thickness
-! real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: e !< Layer interface height
-! real, dimension(SZI_(G),SZJ_(G)) , intent(inout) :: eta !< Thickness
- type(time_type), intent(in) :: Time !< Time
+ type(time_type), intent(in) :: Time !< Model time
! Local variables
-
integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed
integer :: IsdB, IedB, JsdB, JedB, n, m, nz
character(len=40) :: mdl = "set_OBC_segment_data" ! This subroutine's name.
character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
integer, dimension(4) :: siz,siz2
real :: sumh ! column sum of thicknesses (m)
integer :: ni_seg, nj_seg ! number of src gridpoints along the segments
@@ -2452,6 +2939,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time)
real, dimension(:), allocatable :: h_stack
integer :: is_obc2, js_obc2
real :: net_H_src, net_H_int, scl_fac
+ real, pointer, dimension(:,:) :: normal_trans_bt=>NULL() ! barotropic transport
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -2484,6 +2972,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time)
! calculate auxiliary fields at staggered locations
ishift=0;jshift=0
if (segment%is_E_or_W) then
+ allocate(normal_trans_bt(segment%HI%IsdB:segment%HI%IedB,segment%HI%jsd:segment%HI%jed))
+ normal_trans_bt(:,:)=0.0
if (segment%direction == OBC_DIRECTION_W) ishift=1
I=segment%HI%IsdB
do j=segment%HI%jsd,segment%HI%jed
@@ -2495,6 +2985,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time)
enddo
enddo
else! (segment%direction == OBC_DIRECTION_N .or. segment%direction == OBC_DIRECTION_S)
+ allocate(normal_trans_bt(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB))
+ normal_trans_bt(:,:)=0.0
if (segment%direction == OBC_DIRECTION_S) jshift=1
J=segment%HI%JsdB
do i=segment%HI%isd,segment%HI%ied
@@ -2784,28 +3276,28 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time)
if (trim(segment%field(m)%name) == 'U' .and. segment%is_E_or_W) then
I=is_obc
do j=js_obc+1,je_obc
- segment%normal_trans_bt(I,j) = 0.0
+ normal_trans_bt(I,j) = 0.0
do k=1,G%ke
segment%normal_vel(I,j,k) = segment%field(m)%buffer_dst(I,j,k)
segment%normal_trans(I,j,k) = segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * &
G%dyCu(I,j)
- segment%normal_trans_bt(I,j)= segment%normal_trans_bt(I,j)+segment%normal_trans(I,j,k)
+ normal_trans_bt(I,j) = normal_trans_bt(I,j)+segment%normal_trans(I,j,k)
enddo
- segment%normal_vel_bt(I,j) = segment%normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * &
+ segment%normal_vel_bt(I,j) = normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * &
G%dyCu(I,j))
if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:)
enddo
elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then
J=js_obc
do i=is_obc+1,ie_obc
- segment%normal_trans_bt(i,J) = 0.0
+ normal_trans_bt(i,J) = 0.0
do k=1,G%ke
segment%normal_vel(i,J,k) = segment%field(m)%buffer_dst(i,J,k)
segment%normal_trans(i,J,k) = segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * &
G%dxCv(i,J)
- segment%normal_trans_bt(i,J)= segment%normal_trans_bt(i,J)+segment%normal_trans(i,J,k)
+ normal_trans_bt(i,J) = normal_trans_bt(i,J)+segment%normal_trans(i,J,k)
enddo
- segment%normal_vel_bt(i,J) = segment%normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * &
+ segment%normal_vel_bt(i,J) = normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * &
G%dxCv(i,J))
if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:)
enddo
@@ -2908,6 +3400,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time)
enddo ! end field loop
deallocate(h_stack)
+ deallocate(normal_trans_bt)
enddo ! end segment loop
@@ -3114,7 +3607,7 @@ subroutine register_temp_salt_segments(GV, OBC, tr_Reg, param_file)
integer :: i, j, k, n
character(len=32) :: name
type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list
- type(tracer_type), pointer :: tr_ptr
+ type(tracer_type), pointer :: tr_ptr => NULL()
if (.not. associated(OBC)) return
@@ -3145,7 +3638,7 @@ subroutine fill_temp_salt_segments(G, OBC, tv)
! Local variables
integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, n, nz
integer :: i, j, k
- type(OBC_segment_type), pointer :: segment ! pointer to segment type list
+ type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list
if (.not. associated(OBC)) return
if (.not. associated(tv%T) .and. associated(tv%S)) return
@@ -3209,7 +3702,7 @@ subroutine mask_outside_OBCs(G, param_file, OBC)
real :: min_depth
integer, parameter :: cin = 3, cout = 4, cland = -1, cedge = -2
character(len=256) :: mesg ! Message for error messages.
- type(OBC_segment_type), pointer :: segment ! pointer to segment type list
+ type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list
real, allocatable, dimension(:,:) :: color, color2 ! For sorting inside from outside,
! two different ways
@@ -3217,6 +3710,7 @@ subroutine mask_outside_OBCs(G, param_file, OBC)
call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, &
default=0.0, do_not_log=.true.)
+ min_depth = min_depth / G%Zd_to_m
allocate(color(G%isd:G%ied, G%jsd:G%jed)) ; color = 0
allocate(color2(G%isd:G%ied, G%jsd:G%jed)) ; color2 = 0
@@ -3455,6 +3949,12 @@ subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp)
vd = var_desc("ry_normal","m s-1", "Normal Phase Speed for NS OBCs",'v','L')
call register_restart_field(OBC_CS%ry_normal, vd, .true., restart_CSp)
endif
+ if (OBC_CS%oblique_BCs_exist_globally) then
+ allocate(OBC_CS%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke))
+ OBC_CS%cff_normal(:,:,:) = 0.0
+ vd = var_desc("cff_normal","m s-1", "denominator for oblique OBCs",'q','L')
+ call register_restart_field(OBC_CS%cff_normal, vd, .true., restart_CSp)
+ endif
end subroutine open_boundary_register_restarts
diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90
index 75892d19f3..8c3786d51a 100644
--- a/src/core/MOM_transcribe_grid.F90
+++ b/src/core/MOM_transcribe_grid.F90
@@ -1,3 +1,5 @@
+!> Module with routines for copying information from a shared dynamic horizontal
+!! grid to an ocean-specific horizontal grid and the reverse.
module MOM_transcribe_grid
! This file is part of MOM6. See LICENSE.md for the license.
@@ -42,6 +44,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG)
if ((isd > oG%isc) .or. (ied < oG%ied) .or. (jsd > oG%jsc) .or. (jed > oG%jed)) &
call MOM_error(FATAL, "copy_dyngrid_to_MOM_grid called with incompatible grids.")
+ oG%Zd_to_m = dG%Zd_to_m
do i=isd,ied ; do j=jsd,jed
oG%geoLonT(i,j) = dG%geoLonT(i+ido,j+jdo)
oG%geoLatT(i,j) = dG%geoLatT(i+ido,j+jdo)
@@ -141,7 +144,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG)
call pass_vector(oG%geoLatCu, oG%geoLatCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE)
call pass_var(oG%areaBu, oG%Domain, position=CORNER)
- call pass_var(oG%geoLonBu, oG%Domain, position=CORNER)
+ call pass_var(oG%geoLonBu, oG%Domain, position=CORNER, inner_halo=oG%isc-isd)
call pass_var(oG%geoLatBu, oG%Domain, position=CORNER)
call pass_vector(oG%dxBu, oG%dyBu, oG%Domain, To_All+Scalar_Pair, BGRID_NE)
call pass_var(oG%CoriolisBu, oG%Domain, position=CORNER)
@@ -185,6 +188,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG)
if ((isd > dG%isc) .or. (ied < dG%ied) .or. (jsd > dG%jsc) .or. (jed > dG%jed)) &
call MOM_error(FATAL, "copy_dyngrid_to_MOM_grid called with incompatible grids.")
+ dG%Zd_to_m = oG%Zd_to_m
do i=isd,ied ; do j=jsd,jed
dG%geoLonT(i,j) = oG%geoLonT(i+ido,j+jdo)
dG%geoLatT(i,j) = oG%geoLatT(i+ido,j+jdo)
@@ -285,7 +289,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG)
call pass_vector(dG%geoLatCu, dG%geoLatCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE)
call pass_var(dG%areaBu, dG%Domain, position=CORNER)
- call pass_var(dG%geoLonBu, dG%Domain, position=CORNER)
+ call pass_var(dG%geoLonBu, dG%Domain, position=CORNER, inner_halo=dG%isc-isd)
call pass_var(dG%geoLatBu, dG%Domain, position=CORNER)
call pass_vector(dG%dxBu, dG%dyBu, dG%Domain, To_All+Scalar_Pair, BGRID_NE)
call pass_var(dG%CoriolisBu, dG%Domain, position=CORNER)
diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90
index 02b0b622a3..4aa14cb082 100644
--- a/src/core/MOM_variables.F90
+++ b/src/core/MOM_variables.F90
@@ -1,3 +1,4 @@
+!> Provides transparent structures with groups of MOM6 variables and supporting routines
module MOM_variables
! This file is part of MOM6. See LICENSE.md for the license.
@@ -18,68 +19,67 @@ module MOM_variables
public allocate_surface_state, deallocate_surface_state, MOM_thermovar_chksum
public ocean_grid_type, alloc_BT_cont_type, dealloc_BT_cont_type
+!> A structure for creating arrays of pointers to 3D arrays
type, public :: p3d
- real, dimension(:,:,:), pointer :: p => NULL()
+ real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3D array
end type p3d
+!> A structure for creating arrays of pointers to 2D arrays
type, public :: p2d
- real, dimension(:,:), pointer :: p => NULL()
+ real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array
end type p2d
-!> The following structure contains pointers to various fields
-!! which may be used describe the surface state of MOM, and which
+!> Pointers to various fields which may be used describe the surface state of MOM, and which
!! will be returned to a the calling program
type, public :: surface
real, allocatable, dimension(:,:) :: &
- SST, & !< The sea surface temperature in C.
- SSS, & !< The sea surface salinity in psu.
+ SST, & !< The sea surface temperature in C.
+ SSS, & !< The sea surface salinity in psu.
sfc_density, & !< The mixed layer density in kg m-3.
Hml, & !< The mixed layer depth in m.
u, & !< The mixed layer zonal velocity in m s-1.
v, & !< The mixed layer meridional velocity in m s-1.
sea_lev, & !< The sea level in m. If a reduced surface gravity is
!! used, that is compensated for in sea_lev.
+ melt_potential, & !< instantaneous amount of heat that can be used to melt sea ice,
+ !! in J m-2. This is computed w.r.t. surface freezing temperature.
ocean_mass, & !< The total mass of the ocean in kg m-2.
ocean_heat, & !< The total heat content of the ocean in C kg m-2.
ocean_salt, & !< The total salt content of the ocean in kgSalt m-2.
salt_deficit !< The salt needed to maintain the ocean column at a minimum
!! salinity of 0.01 PSU over the call to step_MOM, in kgSalt m-2.
- logical :: T_is_conT = .false. !< If true, the temperature variable SST is
- !! actually the conservative temperature, in degC.
- logical :: S_is_absS = .false. !< If true, the salinity variable SSS is
- !! actually the absolute salinity, in g/kg.
+ logical :: T_is_conT = .false. !< If true, the temperature variable SST is actually the
+ !! conservative temperature, in degC.
+ logical :: S_is_absS = .false. !< If true, the salinity variable SSS is actually the
+ !! absolute salinity, in g/kg.
real, pointer, dimension(:,:) :: &
- taux_shelf => NULL(), & !< The zonal and meridional stresses on the ocean
- tauy_shelf => NULL(), & !< under shelves, in Pa.
- frazil => NULL(), & !< The energy needed to heat the ocean column to the
- !! freezing point over the call to step_MOM, in J m-2.
- TempxPmE => NULL(), & !< The net inflow of water into the ocean times
- !! the temperature at which this inflow occurs during
- !! the call to step_MOM, in deg C kg m-2.
- !! This should be prescribed in the forcing fields,
- !! but as it often is not, this is a useful heat budget
- !! diagnostic.
- internal_heat => NULL() !< Any internal or geothermal heat sources that
- !! are applied to the ocean integrated over the call
- !! to step_MOM, in deg C kg m-2.
- type(coupler_2d_bc_type) :: &
- tr_fields !< A structure that may contain an array of named
- !! fields describing tracer-related quantities.
- !!! NOTE: ALL OF THE ARRAYS IN TR_FIELDS USE THE COUPLER'S INDEXING
- !!! CONVENTION AND HAVE NO HALOS! THIS IS DONE TO CONFORM TO
- !!! THE TREATMENT IN MOM4, BUT I DON'T LIKE IT!
- logical :: arrays_allocated = .false. !< A flag that indicates whether
- !! the surface type has had its memory allocated.
+ taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves, in Pa.
+ tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves, in Pa.
+ real, pointer, dimension(:,:) :: frazil => NULL()
+ !< The energy needed to heat the ocean column to the freezing point during the call
+ !! to step_MOM, in J m-2.
+ real, pointer, dimension(:,:) :: TempxPmE => NULL()
+ !< The net inflow of water into the ocean times the temperature at which this inflow
+ !! occurs during the call to step_MOM, in deg C kg m-2. This should be prescribed in the
+ !! forcing fields, but as it often is not, this is a useful heat budget diagnostic.
+ real, pointer, dimension(:,:) :: internal_heat => NULL()
+ !< Any internal or geothermal heat sources that are applied to the ocean integrated
+ !! over the call to step_MOM, in deg C kg m-2.
+ type(coupler_2d_bc_type) :: tr_fields !< A structure that may contain an
+ !! array of named fields describing tracer-related quantities.
+ !### NOTE: ALL OF THE ARRAYS IN TR_FIELDS USE THE COUPLER'S INDEXING CONVENTION AND HAVE NO
+ !### HALOS! THIS IS DONE TO CONFORM TO THE TREATMENT IN MOM4, BUT I DON'T LIKE IT! -RWH
+ logical :: arrays_allocated = .false. !< A flag that indicates whether the surface type
+ !! has had its memory allocated.
end type surface
-!> The thermo_var_ptrs structure contains pointers to an assortment of
-!! thermodynamic fields that may be available, including potential temperature,
-!! salinity, heat capacity, and the equation of state control structure.
+!> Pointers to an assortment of thermodynamic fields that may be available, including
+!! potential temperature, salinity, heat capacity, and the equation of state control structure.
type, public :: thermo_var_ptrs
! If allocated, the following variables have nz layers.
- real, pointer :: T(:,:,:) => NULL() !< Potential temperature in C.
- real, pointer :: S(:,:,:) => NULL() !< Salnity in psu or ppt.
+ real, pointer :: T(:,:,:) => NULL() !< Potential temperature in C.
+ real, pointer :: S(:,:,:) => NULL() !< Salnity in psu or ppt.
type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the
- !! equation of state to use.
+ !! equation of state to use.
real :: P_Ref !< The coordinate-density reference pressure in Pa.
!! This is the pressure used to calculate Rml from
!! T and S when eqn_of_state is associated.
@@ -90,210 +90,224 @@ module MOM_variables
!! actually the conservative temperature, in degC.
logical :: S_is_absS = .false. !< If true, the salinity variable tv%S is
!! actually the absolute salinity, in g/kg.
- real, pointer, dimension(:,:) :: &
! These arrays are accumulated fluxes for communication with other components.
- frazil => NULL(), & !< The energy needed to heat the ocean column to the
+ real, dimension(:,:), pointer :: frazil => NULL()
+ !< The energy needed to heat the ocean column to the
!! freezing point since calculate_surface_state was
!! last called, in units of J m-2.
- salt_deficit => NULL(), & !< The salt needed to maintain the ocean column
+ real, dimension(:,:), pointer :: salt_deficit => NULL()
+ !< The salt needed to maintain the ocean column
!! at a minumum salinity of 0.01 PSU since the last time
!! that calculate_surface_state was called, in units
!! of gSalt m-2.
- TempxPmE => NULL(), & !< The net inflow of water into the ocean times the
+ real, dimension(:,:), pointer :: TempxPmE => NULL()
+ !< The net inflow of water into the ocean times the
!! temperature at which this inflow occurs since the
!! last call to calculate_surface_state, in units of
!! deg C kg m-2. This should be prescribed in the
!! forcing fields, but as it often is not, this is a
!! useful heat budget diagnostic.
- internal_heat => NULL() !< Any internal or geothermal heat sources that
+ real, dimension(:,:), pointer :: internal_heat => NULL()
+ !< Any internal or geothermal heat sources that
!! have been applied to the ocean since the last call to
!! calculate_surface_state, in units of deg C kg m-2.
end type thermo_var_ptrs
-!> The ocean_internal_state structure contains pointers to all of the prognostic
-!! variables allocated in MOM_variables.F90 and MOM.F90. It is useful for
-!! sending these variables for diagnostics, and in preparation for ensembles
+!> Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM.F90.
+!!
+!! It is useful for sending these variables for diagnostics, and in preparation for ensembles
!! later on. All variables have the same names as the local (public) variables
!! they refer to in MOM.F90.
type, public :: ocean_internal_state
real, pointer, dimension(:,:,:) :: &
- u => NULL(), v => NULL(), h => NULL()
+ T => NULL(), & !< Pointer to the temperature state variable, in deg C
+ S => NULL(), & !< Pointer to the salinity state variable, in PSU or g/kg
+ u => NULL(), & !< Pointer to the zonal velocity, in m s-1
+ v => NULL(), & !< Pointer to the meridional velocity, in m s-1
+ h => NULL() !< Pointer to the layer thicknesses, in H (often m or kg m-2)
+ real, pointer, dimension(:,:,:) :: &
+ uh => NULL(), & !< Pointer to zonal transports, in H m2 s-1
+ vh => NULL() !< Pointer to meridional transports, in H m2 s-1
real, pointer, dimension(:,:,:) :: &
- uh => NULL(), vh => NULL(), &
- CAu => NULL(), CAv => NULL(), &
- PFu => NULL(), PFv => NULL(), diffu => NULL(), diffv => NULL(), &
- T => NULL(), S => NULL(), &
- pbce => NULL(), u_accel_bt => NULL(), v_accel_bt => NULL(), &
- u_av => NULL(), v_av => NULL(), u_prev => NULL(), v_prev => NULL()
+ CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration, in m s-2
+ CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration, in m s-2
+ PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration, in m s-2
+ PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration, in m s-2
+ diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity, in m s-2
+ diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity, in m s-2
+ pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement, in s-2
+ u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration, in m s-2
+ v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration, in m s-2
+ real, pointer, dimension(:,:,:) :: &
+ u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep, in m s-1
+ v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep, in m s-1
+ u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep, in m s-1
+ v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep, in m s-1
end type ocean_internal_state
-!> The accel_diag_ptrs structure contains pointers to arrays with accelerations,
-!! which can later be used for derived diagnostics, like energy balances.
+!> Pointers to arrays with accelerations, which can later be used for derived diagnostics, like energy balances.
type, public :: accel_diag_ptrs
-! Each of the following fields has nz layers.
- real, pointer :: diffu(:,:,:) => NULL() ! Accelerations due to along iso-
- real, pointer :: diffv(:,:,:) => NULL() ! pycnal viscosity, in m s-2.
- real, pointer :: CAu(:,:,:) => NULL() ! Coriolis and momentum advection
- real, pointer :: CAv(:,:,:) => NULL() ! accelerations, in m s-2.
- real, pointer :: PFu(:,:,:) => NULL() ! Accelerations due to pressure
- real, pointer :: PFv(:,:,:) => NULL() ! forces, in m s-2.
- real, pointer :: du_dt_visc(:,:,:) => NULL()! Accelerations due to vertical
- real, pointer :: dv_dt_visc(:,:,:) => NULL()! viscosity, in m s-2.
- real, pointer :: du_dt_dia(:,:,:) => NULL()! Accelerations due to diapycnal
- real, pointer :: dv_dt_dia(:,:,:) => NULL()! mixing, in m s-2.
- real, pointer :: du_other(:,:,:) => NULL() ! Velocity changes due to any other
- real, pointer :: dv_other(:,:,:) => NULL() ! processes that are not due to any
- ! explicit accelerations, in m s-1.
+ ! Each of the following fields has nz layers.
+ real, pointer, dimension(:,:,:) :: &
+ diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity, in m s-2.
+ diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity, in m s-2.
+ CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations, in m s-2.
+ CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations, in m s-2.
+ PFu => NULL(), & !< Zonal acceleration due to pressure forces, in m s-2.
+ PFv => NULL(), & !< Meridional acceleration due to pressure forces, in m s-2.
+ du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity, in m s-2.
+ dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity, in m s-2.
+ du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing, in m s-2.
+ dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing, in m s-2.
+ real, pointer, dimension(:,:,:) :: du_other => NULL()
+ !< Zonal velocity changes due to any other processes that are
+ !! not due to any explicit accelerations, in m s-1.
+ real, pointer, dimension(:,:,:) :: dv_other => NULL()
+ !< Meridional velocity changes due to any other processes that are
+ !! not due to any explicit accelerations, in m s-1.
! These accelerations are sub-terms included in the accelerations above.
- real, pointer :: gradKEu(:,:,:) => NULL() ! gradKEu = - d/dx(u2), in m s-2.
- real, pointer :: gradKEv(:,:,:) => NULL() ! gradKEv = - d/dy(u2), in m s-2.
- real, pointer :: rv_x_v(:,:,:) => NULL() ! rv_x_v = rv * v at u, in m s-2.
- real, pointer :: rv_x_u(:,:,:) => NULL() ! rv_x_u = rv * u at v, in m s-2.
+ real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2), in m s-2.
+ real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2), in m s-2.
+ real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u, in m s-2.
+ real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v, in m s-2.
end type accel_diag_ptrs
-!> The cont_diag_ptrs structure contains pointers to arrays with transports,
-!! which can later be used for derived diagnostics, like energy balances.
+!> Pointers to arrays with transports, which can later be used for derived diagnostics, like energy balances.
type, public :: cont_diag_ptrs
! Each of the following fields has nz layers.
- real, pointer :: uh(:,:,:) => NULL() ! Resolved layer thickness fluxes,
- real, pointer :: vh(:,:,:) => NULL() ! in m3 s-1 or kg s-1.
- real, pointer :: uhGM(:,:,:) => NULL() ! Thickness diffusion induced
- real, pointer :: vhGM(:,:,:) => NULL() ! volume fluxes in m3 s-1.
+ real, pointer, dimension(:,:,:) :: &
+ uh => NULL(), & !< Resolved zonal layer thickness fluxes, in m3 s-1 or kg s-1
+ vh => NULL(), & !< Resolved meridional layer thickness fluxes, in m3 s-1 or kg s-1
+ uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes in m3 s-1 or kg s-1
+ vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes in m3 s-1 or kg s-1
! Each of the following fields is found at nz+1 interfaces.
- real, pointer :: diapyc_vel(:,:,:) => NULL()! The net diapycnal velocity,
+ real, pointer :: diapyc_vel(:,:,:) => NULL() !< The net diapycnal velocity, in m s-1 or kg m-2 s-1
end type cont_diag_ptrs
-!> The vertvisc_type structure contains vertical viscosities, drag
-!! coefficients, and related fields.
+!> Vertical viscosities, drag coefficients, and related fields.
type, public :: vertvisc_type
real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion
!! that is captured in Kd_shear.
real, pointer, dimension(:,:) :: &
- bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the
- !! u-points, in m.
- bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the
- !! v-points, in m.
- kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the
- !! u-points, in m2 s-1.
- kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the
- !! v-points, in m2 s-1.
- ustar_BBL => NULL(), & !< The turbulence velocity in the bottom boundary
- !! layer at h points, in m s-1.
- TKE_BBL => NULL(), & !< A term related to the bottom boundary layer
- !! source of turbulent kinetic energy, currently
- !! in units of m3 s-3, but will later be changed
- !! to W m-2.
+ bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in Z.
+ bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in Z.
+ kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1.
+ kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1.
+ ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in Z s-1.
+ real, pointer, dimension(:,:) :: TKE_BBL => NULL()
+ !< A term related to the bottom boundary layer source of turbulent kinetic
+ !! energy, currently in units of m3 s-3, but will later be changed to W m-2.
+ real, pointer, dimension(:,:) :: &
taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves, in Pa.
- tauy_shelf => NULL(), & !< The meridional stresses on the ocean under shelves, in Pa.
- tbl_thick_shelf_u => NULL(), & !< Thickness of the viscous top boundary
- !< layer under ice shelves at u-points, in m.
- tbl_thick_shelf_v => NULL(), & !< Thickness of the viscous top boundary
- !< layer under ice shelves at v-points, in m.
- kv_tbl_shelf_u => NULL(), & !< Viscosity in the viscous top boundary layer
- !! under ice shelves at u-points, in m2 s-1.
- kv_tbl_shelf_v => NULL(), & !< Viscosity in the viscous top boundary layer
- !! under ice shelves at u-points, in m2 s-1.
- nkml_visc_u => NULL(), & !< The number of layers in the viscous surface
- !! mixed layer at u-points (nondimensional). This
- !! is not an integer because there may be
- !! fractional layers, and it is stored
- !! in terms of layers, not depth, to facilitate
- !! the movement of the viscous boundary layer with
- !! the flow.
- nkml_visc_v => NULL(), & !< The number of layers in the viscous surface
- !! mixed layer at v-points (nondimensional).
- MLD => NULL() !< Instantaneous active mixing layer depth (H units).
+ tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves, in Pa.
+ real, pointer, dimension(:,:) :: tbl_thick_shelf_u => NULL()
+ !< Thickness of the viscous top boundary layer under ice shelves at u-points, in Z.
+ real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL()
+ !< Thickness of the viscous top boundary layer under ice shelves at v-points, in Z.
+ real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL()
+ !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in Z2 s-1.
+ real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL()
+ !< Viscosity in the viscous top boundary layer under ice shelves at v-points, in Z2 s-1.
+ real, pointer, dimension(:,:) :: nkml_visc_u => NULL()
+ !< The number of layers in the viscous surface mixed layer at u-points (nondimensional).
+ !! This is not an integer because there may be fractional layers, and it is stored in
+ !! terms of layers, not depth, to facilitate the movement of the viscous boundary layer
+ !! with the flow.
+ real, pointer, dimension(:,:) :: nkml_visc_v => NULL()
+ !< The number of layers in the viscous surface mixed layer at v-points (nondimensional).
+ real, pointer, dimension(:,:) :: &
+ MLD => NULL() !< Instantaneous active mixing layer depth (H units).
real, pointer, dimension(:,:,:) :: &
- Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer
- !! at u-points, in m s-1.
- Ray_v => NULL(), & !< The Rayleigh drag velocity to be applied to each layer
- !! at v-points, in m s-1.
- Kd_extra_T => NULL(), & !< The extra diffusivity of temperature due to
- !! double diffusion relative to the diffusivity of
- !! density, in m2 s-1.
- Kd_extra_S => NULL(), & !< The extra diffusivity of salinity due to
- !! double diffusion relative to the diffusivity of
- !! density, in m2 s-1.
- ! One of Kd_extra_T and Kd_extra_S is always 0.
- ! Kd_extra_S is positive for salt fingering; Kd_extra_T
- ! is positive for double diffusive convection. These
- ! are only allocated if DOUBLE_DIFFUSION is true.
- Kd_shear => NULL(), &!< The shear-driven turbulent diapycnal diffusivity
- !! at the interfaces between each layer, in m2 s-1.
- Kv_shear => NULL(), &!< The shear-driven turbulent vertical viscosity
- !! at the interfaces between each layer, in m2 s-1.
- Kv_slow => NULL(), &!< The turbulent vertical viscosity component due to
- !! "slow" processes (e.g., tidal, background,
- !! convection etc).
- TKE_turb => NULL() !< The turbulent kinetic energy per unit mass defined
- !! at the interfaces between each layer, in m2 s-2.
- logical :: add_Kv_slow !< If True, adds Kv_slow when calculating the
- !! 'coupling coefficient' (a[k]) at the interfaces.
- !! This is done in find_coupling_coef.
+ Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in Z s-1.
+ Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in Z s-1.
+ real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL()
+ !< The extra diffusivity of temperature due to double diffusion relative to the
+ !! diffusivity of density, in Z2 s-1.
+ real, pointer, dimension(:,:,:) :: Kd_extra_S => NULL()
+ !< The extra diffusivity of salinity due to double diffusion relative to the
+ !! diffusivity of density, in Z2 s-1.
+ ! One of Kd_extra_T and Kd_extra_S is always 0. Kd_extra_S is positive for salt fingering;
+ ! Kd_extra_T is positive for double diffusive convection. They are only allocated if
+ ! DOUBLE_DIFFUSION is true.
+ real, pointer, dimension(:,:,:) :: Kd_shear => NULL()
+ !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers
+ !! in tracer columns, in Z2 s-1.
+ real, pointer, dimension(:,:,:) :: Kv_shear => NULL()
+ !< The shear-driven turbulent vertical viscosity at the interfaces between layers
+ !! in tracer columns, in Z2 s-1.
+ real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL()
+ !< The shear-driven turbulent vertical viscosity at the interfaces between layers in
+ !! corner columns, in Z2 s-1.
+ real, pointer, dimension(:,:,:) :: Kv_slow => NULL()
+ !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal,
+ !! background, convection etc), in Z2 s-1.
+ real, pointer, dimension(:,:,:) :: TKE_turb => NULL()
+ !< The turbulent kinetic energy per unit mass at the interfaces, in m2 s-2.
+ !! This may be at the tracer or corner points
+ logical :: add_Kv_slow !< If True, add Kv_slow when calculating the 'coupling coefficient' (a[k])
+ !! at the interfaces. This is done in find_coupling_coef.
end type vertvisc_type
-!> The BT_cont_type structure contains information about the summed layer
-!! transports and how they will vary as the barotropic velocity is changed.
+!> Container for information about the summed layer transports
+!! and how they will vary as the barotropic velocity is changed.
type, public :: BT_cont_type
- real, pointer, dimension(:,:) :: &
- FA_u_EE => NULL(), & ! The FA_u_XX variables are the effective open face
- FA_u_E0 => NULL(), & ! areas for barotropic transport through the zonal
- FA_u_W0 => NULL(), & ! faces, all in H m, with the XX indicating where
- FA_u_WW => NULL(), & ! the transport is from, with _EE drawing from points
- ! far to the east, _E0 from points nearby from the
- ! east, _W0 nearby from the west, and _WW from far to
- ! the west.
- uBT_WW => NULL(), & ! uBT_WW is the barotropic velocity, in m s-1, beyond
- ! which the marginal open face area is FA_u_WW.
- ! uBT_EE must be non-negative.
- uBT_EE => NULL(), & ! uBT_EE is the barotropic velocity, in m s-1, beyond
- ! which the marginal open face area is FA_u_EE.
- ! uBT_EE must be non-positive.
- FA_v_NN => NULL(), & ! The FA_v_XX variables are the effective open face
- FA_v_N0 => NULL(), & ! areas for barotropic transport through the meridional
- FA_v_S0 => NULL(), & ! faces, all in H m, with the XX indicating where
- FA_v_SS => NULL(), & ! the transport is from, with _NN drawing from points
- ! far to the north, _N0 from points nearby from the
- ! north, _S0 nearby from the south, and _SS from far
- ! to the south.
- vBT_SS => NULL(), & ! vBT_SS is the barotropic velocity, in m s-1, beyond
- ! which the marginal open face area is FA_v_SS.
- ! vBT_SS must be non-negative.
- vBT_NN => NULL() ! vBT_NN is the barotropic velocity, in m s-1, beyond
- ! which the marginal open face area is FA_v_NN.
- ! vBT_NN must be non-positive.
- real, pointer, dimension(:,:,:) :: &
- h_u => NULL(), & ! An effective thickness at zonal faces, in H.
- h_v => NULL() ! An effective thickness at meridional faces, in H.
- type(group_pass_type) :: pass_polarity_BT, pass_FA_uv ! For group halo updates
+ real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport
+ !! drawing from locations far to the east, in H m.
+ real, allocatable :: FA_u_E0(:,:) !< The effective open face area for zonal barotropic transport
+ !! drawing from nearby to the east, in H m.
+ real, allocatable :: FA_u_W0(:,:) !< The effective open face area for zonal barotropic transport
+ !! drawing from nearby to the west, in H m.
+ real, allocatable :: FA_u_WW(:,:) !< The effective open face area for zonal barotropic transport
+ !! drawing from locations far to the west, in H m.
+ real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity, in m s-1, beyond which the marginal
+ !! open face area is FA_u_WW. uBT_WW must be non-negative.
+ real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity, in m s-1, beyond which the marginal
+ !! open face area is FA_u_EE. uBT_EE must be non-positive.
+ real, allocatable :: FA_v_NN(:,:) !< The effective open face area for meridional barotropic transport
+ !! drawing from locations far to the north, in H m.
+ real, allocatable :: FA_v_N0(:,:) !< The effective open face area for meridional barotropic transport
+ !! drawing from nearby to the north, in H m.
+ real, allocatable :: FA_v_S0(:,:) !< The effective open face area for meridional barotropic transport
+ !! drawing from nearby to the south, in H m.
+ real, allocatable :: FA_v_SS(:,:) !< The effective open face area for meridional barotropic transport
+ !! drawing from locations far to the south, in H m.
+ real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, in m s-1, beyond which the marginal
+ !! open face area is FA_v_SS. vBT_SS must be non-negative.
+ real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, in m s-1, beyond which the marginal
+ !! open face area is FA_v_NN. vBT_NN must be non-positive.
+ real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces, in H.
+ real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces, in H.
+ type(group_pass_type) :: pass_polarity_BT !< Structure for polarity group halo updates
+ type(group_pass_type) :: pass_FA_uv !< Structure for face area group halo updates
end type BT_cont_type
contains
-
-!> This subroutine allocates the fields for the surface (return) properties of
-!! the ocean model. Unused fields are unallocated.
+!> Allocates the fields for the surface (return) properties of
+!! the ocean model. Unused fields are unallocated.
subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, &
- gas_fields_ocn)
+ gas_fields_ocn, use_meltpot)
type(ocean_grid_type), intent(in) :: G !< ocean grid structure
type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated.
logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables.
logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically
!! integrated fields.
type(coupler_1d_bc_type), &
- optional, intent(in) :: gas_fields_ocn !< If present, this type describes the ocean
+ optional, intent(in) :: gas_fields_ocn !< If present, this type describes the ocean
!! ocean and surface-ice fields that will participate
!! in the calculation of additional gas or other
!! tracer fluxes, and can be used to spawn related
!! internal variables in the ice model.
+ logical, optional, intent(in) :: use_meltpot !< If true, allocate the space for melt potential
- logical :: use_temp, alloc_integ
+ ! local variables
+ logical :: use_temp, alloc_integ, use_melt_potential
integer :: is, ie, js, je, isd, ied, jsd, jed
integer :: isdB, iedB, jsdB, jedB
@@ -303,6 +317,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, &
use_temp = .true. ; if (present(use_temperature)) use_temp = use_temperature
alloc_integ = .true. ; if (present(do_integrals)) alloc_integ = do_integrals
+ use_melt_potential = .false. ; if (present(use_meltpot)) use_melt_potential = use_meltpot
if (sfc_state%arrays_allocated) return
@@ -317,9 +332,12 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, &
allocate(sfc_state%u(IsdB:IedB,jsd:jed)) ; sfc_state%u(:,:) = 0.0
allocate(sfc_state%v(isd:ied,JsdB:JedB)) ; sfc_state%v(:,:) = 0.0
+ if (use_melt_potential) then
+ allocate(sfc_state%melt_potential(isd:ied,jsd:jed)) ; sfc_state%melt_potential(:,:) = 0.0
+ endif
+
if (alloc_integ) then
- ! Allocate structures for the vertically integrated ocean_mass, ocean_heat,
- ! and ocean_salt.
+ ! Allocate structures for the vertically integrated ocean_mass, ocean_heat, and ocean_salt.
allocate(sfc_state%ocean_mass(isd:ied,jsd:jed)) ; sfc_state%ocean_mass(:,:) = 0.0
if (use_temp) then
allocate(sfc_state%ocean_heat(isd:ied,jsd:jed)) ; sfc_state%ocean_heat(:,:) = 0.0
@@ -330,18 +348,19 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, &
if (present(gas_fields_ocn)) &
call coupler_type_spawn(gas_fields_ocn, sfc_state%tr_fields, &
- (/isd,is,ie,ied/), (/jsd,js,je,jed/), as_needed=.true.)
+ (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.)
sfc_state%arrays_allocated = .true.
end subroutine allocate_surface_state
-!> This subroutine deallocates the elements of a surface state type.
+!> Deallocates the elements of a surface state type.
subroutine deallocate_surface_state(sfc_state)
- type(surface), intent(inout) :: sfc_state !< ocean surface state type to be deallocated.
+ type(surface), intent(inout) :: sfc_state !< ocean surface state type to be deallocated here.
if (.not.sfc_state%arrays_allocated) return
+ if (allocated(sfc_state%melt_potential)) deallocate(sfc_state%melt_potential)
if (allocated(sfc_state%SST)) deallocate(sfc_state%SST)
if (allocated(sfc_state%SSS)) deallocate(sfc_state%SSS)
if (allocated(sfc_state%sfc_density)) deallocate(sfc_state%sfc_density)
@@ -360,8 +379,7 @@ subroutine deallocate_surface_state(sfc_state)
end subroutine deallocate_surface_state
-!> alloc_BT_cont_type allocates the arrays contained within a BT_cont_type and
-!! initializes them to 0.
+!> Allocates the arrays contained within a BT_cont_type and initializes them to 0.
subroutine alloc_BT_cont_type(BT_cont, G, alloc_faces)
type(BT_cont_type), pointer :: BT_cont !< The BT_cont_type whose elements will be allocated
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
@@ -397,9 +415,9 @@ subroutine alloc_BT_cont_type(BT_cont, G, alloc_faces)
end subroutine alloc_BT_cont_type
-!> dealloc_BT_cont_type deallocates the arrays contained within a BT_cont_type.
+!> Deallocates the arrays contained within a BT_cont_type.
subroutine dealloc_BT_cont_type(BT_cont)
- type(BT_cont_type), pointer :: BT_cont
+ type(BT_cont_type), pointer :: BT_cont !< The BT_cont_type whose elements will be deallocated.
if (.not.associated(BT_cont)) return
@@ -411,15 +429,14 @@ subroutine dealloc_BT_cont_type(BT_cont)
deallocate(BT_cont%FA_v_N0) ; deallocate(BT_cont%FA_v_NN)
deallocate(BT_cont%vBT_SS) ; deallocate(BT_cont%vBT_NN)
- if (associated(BT_cont%h_u)) deallocate(BT_cont%h_u)
- if (associated(BT_cont%h_v)) deallocate(BT_cont%h_v)
+ if (allocated(BT_cont%h_u)) deallocate(BT_cont%h_u)
+ if (allocated(BT_cont%h_v)) deallocate(BT_cont%h_v)
deallocate(BT_cont)
end subroutine dealloc_BT_cont_type
-!> MOM_thermovar_chksum does diagnostic checksums on various elements of a
-!! thermo_var_ptrs type for debugging.
+!> Diagnostic checksums on various elements of a thermo_var_ptrs type for debugging.
subroutine MOM_thermovar_chksum(mesg, tv, G)
character(len=*), intent(in) :: mesg !< A message that appears in the checksum lines
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90
index c03a811400..7b7feadb3c 100644
--- a/src/core/MOM_verticalGrid.F90
+++ b/src/core/MOM_verticalGrid.F90
@@ -1,3 +1,4 @@
+!> Provides a transparent vertical ocean grid type and supporting routines
module MOM_verticalGrid
! This file is part of MOM6. See LICENSE.md for the license.
@@ -10,70 +11,70 @@ module MOM_verticalGrid
#include
public verticalGridInit, verticalGridEnd
-public setVerticalGridAxes
+public setVerticalGridAxes, fix_restart_scaling
public get_flux_units, get_thickness_units, get_tr_flux_units
+!> Describes the vertical ocean grid, including unit conversion factors
type, public :: verticalGrid_type
! Commonly used parameters
integer :: ke !< The number of layers/levels in the vertical
- real :: max_depth !< The maximum depth of the ocean in meters.
- real :: g_Earth !< The gravitational acceleration in m s-2.
- real :: Rho0 !< The density used in the Boussinesq approximation or
- !! nominal density used to convert depths into mass
- !! units, in kg m-3.
+ real :: max_depth !< The maximum depth of the ocean in Z (often m).
+ real :: g_Earth !< The gravitational acceleration in m2 Z-1 s-2.
+ real :: Rho0 !< The density used in the Boussinesq approximation or nominal
+ !! density used to convert depths into mass units, in kg m-3.
! Vertical coordinate descriptions for diagnostics and I/O
- character(len=40) :: &
- zAxisUnits, & !< The units that vertical coordinates are written in
- zAxisLongName !< Coordinate name to appear in files,
- !! e.g. "Target Potential Density" or "Height"
- real ALLOCABLE_, dimension(NKMEM_) :: sLayer !< Coordinate values of layer centers
- real ALLOCABLE_, dimension(NK_INTERFACE_) :: sInterface !< Coordinate values on interfaces
+ character(len=40) :: zAxisUnits !< The units that vertical coordinates are written in
+ character(len=40) :: zAxisLongName !< Coordinate name to appear in files,
+ !! e.g. "Target Potential Density" or "Height"
+ real, allocatable, dimension(:) :: sLayer !< Coordinate values of layer centers
+ real, allocatable, dimension(:) :: sInterface !< Coordinate values on interfaces
integer :: direction = 1 !< Direction defaults to 1, positive up.
! The following variables give information about the vertical grid.
- logical :: Boussinesq !< If true, make the Boussinesq approximation.
- real :: Angstrom !< A one-Angstrom thickness in the model's thickness
- !! units. (This replaces the old macro EPSILON.)
- real :: Angstrom_z !< A one-Angstrom thickness in m.
- real :: H_subroundoff !< A thickness that is so small that it can be added to
- !! a thickness of Angstrom or larger without changing it
- !! at the bit level, in thickness units. If Angstrom is
- !! 0 or exceedingly small, this is negligible compared to
- !! a thickness of 1e-17 m.
- real ALLOCABLE_, dimension(NK_INTERFACE_) :: &
- g_prime, & !< The reduced gravity at each interface, in m s-2.
- Rlay !< The target coordinate value (potential density) in
- !! in each layer in kg m-3.
+ logical :: Boussinesq !< If true, make the Boussinesq approximation.
+ real :: Angstrom_H !< A one-Angstrom thickness in the model thickness units.
+ real :: Angstrom_Z !< A one-Angstrom thickness in the model depth units.
+ real :: Angstrom_m !< A one-Angstrom thickness in m.
+ real :: H_subroundoff !< A thickness that is so small that it can be added to a thickness of
+ !! Angstrom or larger without changing it at the bit level, in thickness units.
+ !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m.
+ real, allocatable, dimension(:) :: &
+ g_prime, & !< The reduced gravity at each interface, in m2 Z-1 s-2.
+ Rlay !< The target coordinate value (potential density) in each layer in kg m-3.
integer :: nkml = 0 !< The number of layers at the top that should be treated
!! as parts of a homogenous region.
integer :: nk_rho_varies = 0 !< The number of layers at the top where the
!! density does not track any target density.
- real :: H_to_kg_m2 !< A constant that translates thicknesses from the units
- !! of thickness to kg m-2.
- real :: kg_m2_to_H !< A constant that translates thicknesses from kg m-2 to
- !! the units of thickness.
- real :: m_to_H !< A constant that translates distances in m to the
- !! units of thickness.
- real :: H_to_m !< A constant that translates distances in the units of
- !! thickness to m.
- real :: H_to_Pa !< A constant that translates the units of thickness to
- !! to pressure in Pa.
+ real :: H_to_kg_m2 !< A constant that translates thicknesses from the units of thickness to kg m-2.
+ real :: kg_m2_to_H !< A constant that translates thicknesses from kg m-2 to the units of thickness.
+ real :: m_to_H !< A constant that translates distances in m to the units of thickness.
+ real :: H_to_m !< A constant that translates distances in the units of thickness to m.
+ real :: H_to_Pa !< A constant that translates the units of thickness to pressure in Pa.
+ real :: m_to_Z !< A constant that translates distances in m to the units of depth.
+ real :: Z_to_m !< A constant that translates distances in the units of depth to m.
+ real :: H_to_Z !< A constant that translates thickness units to the units of depth.
+ real :: Z_to_H !< A constant that translates depth units to thickness units.
+
+ real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files.
+ real :: m_to_H_restart = 0.0 !< A copy of the m_to_H that is used in restart files.
end type verticalGrid_type
contains
-!> Allocates and initializes the model's vertical grid structure.
+!> Allocates and initializes the ocean model vertical grid structure.
subroutine verticalGridInit( param_file, GV )
-! This routine initializes the verticalGrid_type structure (GV).
-! All memory is allocated but not necessarily set to meaningful values until later.
type(param_file_type), intent(in) :: param_file !< Parameter file handle/type
type(verticalGrid_type), pointer :: GV !< The container for vertical grid data
-! This include declares and sets the variable "version".
-#include "version_variable.h"
- integer :: nk, H_power
- real :: rescale_factor
+ ! This routine initializes the verticalGrid_type structure (GV).
+ ! All memory is allocated but not necessarily set to meaningful values until later.
+
+ ! Local variables
+ integer :: nk, H_power, Z_power
+ real :: H_rescale_factor, Z_rescale_factor
+ ! This include declares and sets the variable "version".
+# include "version_variable.h"
character(len=16) :: mdl = 'MOM_verticalGrid'
if (associated(GV)) call MOM_error(FATAL, &
@@ -94,7 +95,7 @@ subroutine verticalGridInit( param_file, GV )
units="kg m-3", default=1035.0)
call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, &
"If true, make the Boussinesq approximation.", default=.true.)
- call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_z, &
+ call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_m, &
"The minumum layer thickness, usually one-Angstrom.", &
units="m", default=1.0e-10)
call get_param(param_file, mdl, "H_RESCALE_POWER", H_power, &
@@ -103,20 +104,31 @@ subroutine verticalGridInit( param_file, GV )
units="nondim", default=0, debuggingParam=.true.)
if (abs(H_power) > 300) call MOM_error(FATAL, "verticalGridInit: "//&
"H_RESCALE_POWER is outside of the valid range of -300 to 300.")
- rescale_factor = 1.0
- if (H_power /= 0) rescale_factor = 2.0**H_power
+ H_rescale_factor = 1.0
+ if (H_power /= 0) H_rescale_factor = 2.0**H_power
if (.not.GV%Boussinesq) then
call get_param(param_file, mdl, "H_TO_KG_M2", GV%H_to_kg_m2,&
"A constant that translates thicknesses from the model's \n"//&
"internal units of thickness to kg m-2.", units="kg m-2 H-1", &
default=1.0)
- GV%H_to_kg_m2 = GV%H_to_kg_m2 * rescale_factor
+ GV%H_to_kg_m2 = GV%H_to_kg_m2 * H_rescale_factor
else
call get_param(param_file, mdl, "H_TO_M", GV%H_to_m, &
"A constant that translates the model's internal \n"//&
"units of thickness into m.", units="m H-1", default=1.0)
- GV%H_to_m = GV%H_to_m * rescale_factor
+ GV%H_to_m = GV%H_to_m * H_rescale_factor
endif
+ call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, &
+ "An integer power of 2 that is used to rescale the model's \n"//&
+ "intenal units of depths and heights. Valid values range from -300 to 300.", &
+ units="nondim", default=0, debuggingParam=.true.)
+ if (abs(Z_power) > 300) call MOM_error(FATAL, "verticalGridInit: "//&
+ "Z_RESCALE_POWER is outside of the valid range of -300 to 300.")
+ Z_rescale_factor = 1.0
+ if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power
+ GV%Z_to_m = 1.0 * Z_rescale_factor
+ GV%m_to_Z = 1.0 / Z_rescale_factor
+ GV%g_Earth = GV%g_Earth * GV%Z_to_m
#ifdef STATIC_MEMORY_
! Here NK_ is a macro, while nk is a variable.
call get_param(param_file, mdl, "NK", nk, &
@@ -135,39 +147,48 @@ subroutine verticalGridInit( param_file, GV )
GV%H_to_kg_m2 = GV%Rho0 * GV%H_to_m
GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2
GV%m_to_H = 1.0 / GV%H_to_m
- GV%Angstrom = GV%m_to_H * GV%Angstrom_z
+ GV%Angstrom_H = GV%m_to_H * GV%Angstrom_m
else
GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2
GV%m_to_H = GV%Rho0 * GV%kg_m2_to_H
GV%H_to_m = GV%H_to_kg_m2 / GV%Rho0
- GV%Angstrom = GV%Angstrom_z*1000.0*GV%kg_m2_to_H
+ GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H
endif
- GV%H_subroundoff = 1e-20 * max(GV%Angstrom,GV%m_to_H*1e-17)
- GV%H_to_Pa = GV%g_Earth * GV%H_to_kg_m2
+ GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17)
+ GV%H_to_Pa = (GV%g_Earth*GV%m_to_Z) * GV%H_to_kg_m2
+
+ GV%H_to_Z = GV%H_to_m * GV%m_to_Z
+ GV%Z_to_H = GV%Z_to_m * GV%m_to_H
+ GV%Angstrom_Z = GV%m_to_Z * GV%Angstrom_m
! Log derivative values.
- call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*rescale_factor)
+ call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor)
call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H)
call log_param(param_file, mdl, "THICKNESS to M rescaled by 2^n", GV%H_to_m)
- ALLOC_( GV%sInterface(nk+1) )
- ALLOC_( GV%sLayer(nk) )
- ALLOC_( GV%g_prime(nk+1) ) ; GV%g_prime(:) = 0.0
+ allocate( GV%sInterface(nk+1) )
+ allocate( GV%sLayer(nk) )
+ allocate( GV%g_prime(nk+1) ) ; GV%g_prime(:) = 0.0
! The extent of Rlay should be changed to nk?
- ALLOC_( GV%Rlay(nk+1) ) ; GV%Rlay(:) = 0.0
+ allocate( GV%Rlay(nk+1) ) ; GV%Rlay(:) = 0.0
end subroutine verticalGridInit
+!> Set the scaling factors for restart files to the scaling factors for this run.
+subroutine fix_restart_scaling(GV)
+ type(verticalGrid_type), intent(inout) :: GV !< The ocean's vertical grid structure
+
+ GV%m_to_Z_restart = GV%m_to_Z
+ GV%m_to_H_restart = GV%m_to_H
+end subroutine fix_restart_scaling
+
!> Returns the model's thickness units, usually m or kg/m^2.
function get_thickness_units(GV)
- character(len=48) :: get_thickness_units
+ character(len=48) :: get_thickness_units !< The vertical thickness units
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
-! This subroutine returns the appropriate units for thicknesses,
-! depending on whether the model is Boussinesq or not and the scaling for
-! the vertical thickness.
-
-! Arguments: G - The ocean's grid structure.
-! (ret) get_thickness_units - The model's vertical thickness units.
+ ! This subroutine returns the appropriate units for thicknesses,
+ ! depending on whether the model is Boussinesq or not and the scaling for
+ ! the vertical thickness.
if (GV%Boussinesq) then
get_thickness_units = "m"
@@ -178,14 +199,11 @@ end function get_thickness_units
!> Returns the model's thickness flux units, usually m^3/s or kg/s.
function get_flux_units(GV)
- character(len=48) :: get_flux_units
+ character(len=48) :: get_flux_units !< The thickness flux units
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
-! This subroutine returns the appropriate units for thickness fluxes,
-! depending on whether the model is Boussinesq or not and the scaling for
-! the vertical thickness.
-
-! Arguments: G - The ocean's grid structure.
-! (ret) get_flux_units - The model's thickness flux units.
+ ! This subroutine returns the appropriate units for thickness fluxes,
+ ! depending on whether the model is Boussinesq or not and the scaling for
+ ! the vertical thickness.
if (GV%Boussinesq) then
get_flux_units = "m3 s-1"
@@ -203,7 +221,7 @@ function get_tr_flux_units(GV, tr_units, tr_vol_conc_units, tr_mass_conc_units)
character(len=*), optional, intent(in) :: tr_units !< Units for a tracer, for example
!! Celsius or PSU.
character(len=*), optional, intent(in) :: tr_vol_conc_units !< The concentration units per unit
- !! volume, forexample if the units are
+ !! volume, for example if the units are
!! umol m-3, tr_vol_conc_units would
!! be umol.
character(len=*), optional, intent(in) :: tr_mass_conc_units !< The concentration units per unit
@@ -211,20 +229,9 @@ function get_tr_flux_units(GV, tr_units, tr_vol_conc_units, tr_mass_conc_units)
!! the units are mol kg-1,
!! tr_vol_conc_units would be mol.
-! This subroutine returns the appropriate units for thicknesses and fluxes,
-! depending on whether the model is Boussinesq or not and the scaling for
-! the vertical thickness.
-
-! Arguments: G - The ocean's grid structure.
-! One of the following three arguments must be present.
-! (in,opt) tr_units - Units for a tracer, for example Celsius or PSU.
-! (in,opt) tr_vol_conc_units - The concentration units per unit volume, for
-! example if the units are umol m-3,
-! tr_vol_conc_units would be umol.
-! (in,opt) tr_mass_conc_units - The concentration units per unit mass of sea
-! water, for example if the units are mol kg-1,
-! tr_vol_conc_units would be mol.
-! (ret) get_tr_flux_units - The model's flux units for a tracer.
+ ! This subroutine returns the appropriate units for thicknesses and fluxes,
+ ! depending on whether the model is Boussinesq or not and the scaling for
+ ! the vertical thickness.
integer :: cnt
cnt = 0
@@ -263,7 +270,6 @@ end function get_tr_flux_units
!> This sets the coordinate data for the "layer mode" of the isopycnal model.
subroutine setVerticalGridAxes( Rlay, GV )
- ! Arguments
type(verticalGrid_type), intent(inout) :: GV !< The container for vertical grid data
real, dimension(GV%ke), intent(in) :: Rlay !< The layer target density
! Local variables
@@ -286,12 +292,10 @@ end subroutine setVerticalGridAxes
!> Deallocates the model's vertical grid structure.
subroutine verticalGridEnd( GV )
-! Arguments: G - The ocean's grid structure.
- type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure
+ type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure
- DEALLOC_(GV%g_prime) ; DEALLOC_(GV%Rlay)
- DEALLOC_( GV%sInterface )
- DEALLOC_( GV%sLayer )
+ deallocate( GV%g_prime, GV%Rlay )
+ deallocate( GV%sInterface , GV%sLayer )
deallocate( GV )
end subroutine verticalGridEnd
diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90
index 10845e8cfa..fa31586659 100644
--- a/src/diagnostics/MOM_PointAccel.F90
+++ b/src/diagnostics/MOM_PointAccel.F90
@@ -1,31 +1,14 @@
+!> Debug accelerations at a given point
+!!
+!! The two subroutines in this file write out all of the terms
+!! in the u- or v-momentum balance at a given point. Usually
+!! these subroutines are called after the velocities exceed some
+!! threshold, in order to determine which term is culpable.
+!! often this is done for debugging purposes.
module MOM_PointAccel
! This file is part of MOM6. See LICENSE.md for the license.
-!***********************************************************************
-!* *
-!* The two subroutines in this file write out all of the terms *
-!* in the u- or v-momentum balance at a given point. Usually *
-!* these subroutines are called after the velocities exceed some *
-!* threshold, in order to determine which term is culpable. *
-!* often this is done for debugging purposes. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q, CoriolisBu *
-!* j+1 > o > o > At ^: v, PFv, CAv, vh, diffv, vbt, vhtr *
-!* j x ^ x ^ x At >: u, PFu, CAu, uh, diffu, ubt, uhtr *
-!* j > o > o > At o: h, bathyT, tr, T, S *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_mediator, only : diag_ctrl
use MOM_domains, only : pe_here
use MOM_error_handler, only : MOM_error, NOTE
@@ -44,32 +27,36 @@ module MOM_PointAccel
public write_u_accel, write_v_accel, PointAccel_init
+!> The control structure for the MOM_PointAccel module
type, public :: PointAccel_CS ; private
- character(len=200) :: u_trunc_file ! The complete path to files in which a
- character(len=200) :: v_trunc_file ! column's worth of accelerations are
- ! written if velocity truncations occur.
- integer :: u_file, v_file ! The unit numbers for opened u- or v- truncation
- ! files, or -1 if they have not yet been opened.
- integer :: cols_written ! The number of columns whose output has been
- ! written by this PE during the current run.
- integer :: max_writes ! The maximum number of times any PE can write out
- ! a column's worth of accelerations during a run.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(diag_ctrl), pointer :: diag ! A pointer to a structure of shareable
- ! ocean diagnostic fields.
+ character(len=200) :: u_trunc_file !< The complete path to the file in which a column's worth of
+ !! u-accelerations are written if u-velocity truncations occur.
+ character(len=200) :: v_trunc_file !< The complete path to the file in which a column's worth of
+ !! v-accelerations are written if v-velocity truncations occur.
+ integer :: u_file !< The unit number for an opened u-truncation files, or -1 if it has not yet been opened.
+ integer :: v_file !< The unit number for an opened v-truncation files, or -1 if it has not yet been opened.
+ integer :: cols_written !< The number of columns whose output has been
+ !! written by this PE during the current run.
+ integer :: max_writes !< The maximum number of times any PE can write out
+ !! a column's worth of accelerations during a run.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
! The following are pointers to many of the state variables and accelerations
! that are used to step the physical model forward. They all use the same
! names as the variables they point to in MOM.F90
real, pointer, dimension(:,:,:) :: &
- u_av => NULL(), v_av => NULL(), & ! Time average velocities in m s-1.
- u_prev => NULL(), v_prev => NULL(), & ! Previous velocities in m s-1.
- T => NULL(), S => NULL(), & ! Temperature and salinity in C and psu.
- pbce => NULL(), & ! pbce times eta gives the baroclinic
- ! pressure anomaly in each layer due to
- ! free surface height anomalies.
- ! pbce has units of m s-2.
- u_accel_bt => NULL(), & ! Barotropic acclerations in m s-2.
- v_accel_bt => NULL()
+ u_av => NULL(), & !< Time average u-velocity in m s-1.
+ v_av => NULL(), & !< Time average velocity in m s-1.
+ u_prev => NULL(), & !< Previous u-velocity in m s-1.
+ v_prev => NULL(), & !< Previous v-velocity in m s-1.
+ T => NULL(), & !< Temperature in deg C.
+ S => NULL(), & !< Salinity in ppt
+ u_accel_bt => NULL(), & !< Barotropic u-acclerations in m s-2.
+ v_accel_bt => NULL() !< Barotropic v-acclerations in m s-2.
+ real, pointer, dimension(:,:,:) :: pbce => NULL() !< pbce times eta gives the baroclinic
+ !! pressure anomaly in each layer due to free surface height anomalies.
+ !! pbce has units of m s-2.
end type PointAccel_CS
@@ -98,15 +85,11 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
real, optional, intent(in) :: str !< The surface wind stress integrated over a time
!! step, in m2 s-1.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, m.
+ optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
optional, intent(in) :: hv !< The layer thicknesses at velocity grid points,
!! from vertvisc, in m.
-
-! This subroutine writes to an output file all of the accelerations
-! that have been applied to a column of zonal velocities over the
-! previous timestep. This subroutine is called from vertvisc.
-
+ ! Local variables
real :: f_eff, CFL
real :: Angstrom
real :: truncvel, du
@@ -119,7 +102,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
logical :: prev_avail
integer :: file
- Angstrom = GV%Angstrom + GV%H_subroundoff
+ Angstrom = GV%Angstrom_H + GV%H_subroundoff
! if (.not.associated(CS)) return
nz = G%ke
@@ -232,7 +215,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
endif
if (present(a)) then
write(file,'(/,"a: ",$)')
- do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k); enddo
+ do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k)*GV%Z_to_m*dt; enddo
endif
if (present(hv)) then
write(file,'(/,"hvel: ",$)')
@@ -261,13 +244,13 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (hin(i+1,j+1,k)); enddo
- e(nz+1) = -G%bathyT(i,j)
+ e(nz+1) = -G%Zd_to_m*G%bathyT(i,j)
do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j,k) ; enddo
write(file,'(/,"e-: ",$)')
write(file,'(ES10.3," ",$)') e(ks)
do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo
- e(nz+1) = -G%bathyT(i+1,j)
+ e(nz+1) = -G%Zd_to_m*G%bathyT(i+1,j)
do k=nz,1,-1 ; e(K) = e(K+1) + hin(i+1,j,k) ; enddo
write(file,'(/,"e+: ",$)')
write(file,'(ES10.3," ",$)') e(ks)
@@ -344,7 +327,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
(0.5*CS%v_av(i+1,J,k)*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo
endif
- write(file,'(/,"D: ",2(ES10.3))') G%bathyT(i,j),G%bathyT(i+1,j)
+ write(file,'(/,"D: ",2(ES10.3))') G%Zd_to_m*G%bathyT(i,j),G%Zd_to_m*G%bathyT(i+1,j)
! From here on, the normalized accelerations are written.
if (prev_avail) then
@@ -430,34 +413,11 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
real, optional, intent(in) :: str !< The surface wind stress integrated over a time
!! step, in m2 s-1.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, m.
+ optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1.
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
optional, intent(in) :: hv !< The layer thicknesses at velocity grid points,
!! from vertvisc, in m.
-
-! This subroutine writes to an output file all of the accelerations
-! that have been applied to a column of meridional velocities over
-! the previous timestep. This subroutine is called from vertvisc.
-
-! Arguments: i - The zonal index of the column to be documented.
-! (in) J - The meridional index of the column to be documented.
-! (in) vm - The new meridional velocity, in m s-1.
-! (in) hin - The layer thickness, in m.
-! (in) ADp - A structure pointing to the various accelerations in
-! the momentum equations.
-! (in) CDp - A structure with pointers to various terms in the continuity
-! equations.
-! (in) dt - The model's dynamics time step.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! PointAccel_init.
-! (in) str - The surface wind stress integrated over a time
-! step, in m2 s-1.
-! (in) a - The layer coupling coefficients from vertvisc, m.
-! (in) hv - The layer thicknesses at velocity grid points, from
-! vertvisc, in m.
-
+ ! Local variables
real :: f_eff, CFL
real :: Angstrom
real :: truncvel, dv
@@ -470,7 +430,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
logical :: prev_avail
integer :: file
- Angstrom = GV%Angstrom + GV%H_subroundoff
+ Angstrom = GV%Angstrom_H + GV%H_subroundoff
! if (.not.associated(CS)) return
nz = G%ke
@@ -587,7 +547,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
endif
if (present(a)) then
write(file,'(/,"a: ",$)')
- do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k); enddo
+ do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k)*GV%Z_to_m*dt; enddo
endif
if (present(hv)) then
write(file,'(/,"hvel: ",$)')
@@ -615,13 +575,13 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
write(file,'(/,"h++: ",$)')
do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hin(i+1,j+1,k); enddo
- e(nz+1) = -G%bathyT(i,j)
+ e(nz+1) = -G%Zd_to_m*G%bathyT(i,j)
do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j,k); enddo
write(file,'(/,"e-: ",$)')
write(file,'(ES10.3," ",$)') e(ks)
do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo
- e(nz+1) = -G%bathyT(i,j+1)
+ e(nz+1) = -G%Zd_to_m*G%bathyT(i,j+1)
do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j+1,k) ; enddo
write(file,'(/,"e+: ",$)')
write(file,'(ES10.3," ",$)') e(ks)
@@ -698,7 +658,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
(0.5*CS%u_prev(I,j+1,k)*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo
endif
- write(file,'(/,"D: ",2(ES10.3))') G%bathyT(i,j),G%bathyT(i,j+1)
+ write(file,'(/,"D: ",2(ES10.3))') G%Zd_to_m*G%bathyT(i,j),G%Zd_to_m*G%bathyT(i,j+1)
! From here on, the normalized accelerations are written.
if (prev_avail) then
@@ -757,7 +717,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a
end subroutine write_v_accel
-! #@# This subroutine needs a doxygen description
+!> This subroutine initializes the parameters regulating how truncations are logged.
subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS)
type(ocean_internal_state), &
target, intent(in) :: MIS !< For "MOM Internal State" a set of pointers
@@ -773,17 +733,6 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS)
!! directory paths.
type(PointAccel_CS), pointer :: CS !< A pointer that is set to point to the
!! control structure for this module.
-
-! Arguments: MIS - For "MOM Internal State" a set of pointers to the fields and
-! accelerations that make up the ocean's physical state.
-! (in) Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in) dirs - A structure containing several relevant directory paths.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "MOM_PointAccel" ! This module's name.
@@ -826,4 +775,5 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS)
CS%u_file = -1 ; CS%v_file = -1 ; CS%cols_written = 0
end subroutine PointAccel_init
+
end module MOM_PointAccel
diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90
index 53105609ca..92ee5898d5 100644
--- a/src/diagnostics/MOM_debugging.F90
+++ b/src/diagnostics/MOM_debugging.F90
@@ -1,14 +1,13 @@
+!> Provides checksumming functions for debugging
+!!
+!! This module contains subroutines that perform various error checking and
+!! debugging functions for MOM6. This routine is similar to it counterpart in
+!! the SIS2 code, except for the use of the ocean_grid_type and by keeping them
+!! separate we retain the ability to set up MOM6 and SIS2 debugging separately.
module MOM_debugging
! This file is part of MOM6. See LICENSE.md for the license.
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
-! This module contains subroutines that perform various error checking and !
-! debugging functions for MOM6. This routine is similar to it counterpart in !
-! the SIS2 code, except for the use of the ocean_grid_type and by keeping them !
-! separate we retain the ability to set up MOM6 and SIS2 debugging separately. !
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
-
use MOM_checksums, only : hchksum, Bchksum, qchksum, uvchksum
use MOM_checksums, only : is_NaN, chksum, MOM_checksums_init
use MOM_coms, only : PE_here, root_PE, num_PEs, sum_across_PEs
@@ -28,47 +27,54 @@ module MOM_debugging
public :: check_column_integral, check_column_integrals
! These interfaces come from MOM_checksums.
-public :: hchksum, Bchksum, qchksum, is_NaN, chksum
-public :: uvchksum
+public :: hchksum, Bchksum, qchksum, is_NaN, chksum, uvchksum
+!> Check for consistency between the duplicated points of a C-grid vector
interface check_redundant
module procedure check_redundant_vC3d, check_redundant_vC2d
end interface check_redundant
+!> Check for consistency between the duplicated points of a C-grid vector
interface check_redundant_C
module procedure check_redundant_vC3d, check_redundant_vC2d
end interface check_redundant_C
+!> Check for consistency between the duplicated points of a B-grid vector or scalar
interface check_redundant_B
module procedure check_redundant_vB3d, check_redundant_vB2d
module procedure check_redundant_sB3d, check_redundant_sB2d
end interface check_redundant_B
+!> Check for consistency between the duplicated points of an A-grid vector or scalar
interface check_redundant_T
module procedure check_redundant_sT3d, check_redundant_sT2d
module procedure check_redundant_vT3d, check_redundant_vT2d
end interface check_redundant_T
+!> Do checksums on the components of a C-grid vector
interface vec_chksum
module procedure chksum_vec_C3d, chksum_vec_C2d
end interface vec_chksum
+!> Do checksums on the components of a C-grid vector
interface vec_chksum_C
module procedure chksum_vec_C3d, chksum_vec_C2d
end interface vec_chksum_C
+!> Do checksums on the components of a B-grid vector
interface vec_chksum_B
module procedure chksum_vec_B3d, chksum_vec_B2d
end interface vec_chksum_B
+!> Do checksums on the components of an A-grid vector
interface vec_chksum_A
module procedure chksum_vec_A3d, chksum_vec_A2d
end interface vec_chksum_A
-integer :: max_redundant_prints = 100
-integer :: redundant_prints(3) = 0
-logical :: debug = .false.
-logical :: debug_chksums = .true.
-logical :: debug_redundant = .true.
+! Note: these parameters are module data but ONLY used when debugging and
+! so can violate the thread-safe requirement of no module/global data.
+integer :: max_redundant_prints = 100 !< Maximum number of times to write redundant messages
+integer :: redundant_prints(3) = 0 !< Counters for controlling redundant printing
+logical :: debug = .false. !< Write out verbose debugging data
+logical :: debug_chksums = .true. !< Perform checksums on arrays
+logical :: debug_redundant = .true. !< Check redundant values on PE boundaries
contains
-! =====================================================================
-
!> MOM_debugging_init initializes the MOM_debugging module, and sets
!! the parameterts that control which checks are active for MOM6.
subroutine MOM_debugging_init(param_file)
@@ -94,6 +100,7 @@ subroutine MOM_debugging_init(param_file)
end subroutine MOM_debugging_init
+!> Check for consistency between the duplicated points of a 3-D C-grid vector
subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, &
direction)
character(len=*), intent(in) :: mesg !< An identifying message
@@ -107,14 +114,8 @@ subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, &
integer, optional, intent(in) :: js !< The starting j-index to check
integer, optional, intent(in) :: je !< The ending j-index to check
integer, optional, intent(in) :: direction !< the direction flag to be
- !! passed to pass_vector
-! Arguments: u_comp - The u-component of the vector being checked.
-! (in) v_comp - The v-component of the vector being checked.
-! (in) mesg - A message indicating what is being checked.
-! (in) G - The ocean's grid structure.
-! (in/opt) is, ie, js, je - the i- and j- range of indices to check.
-! (in/opt) direction - the direction flag to be passed to pass_vector.
-
+ !! passed to pass_vector
+ ! Local variables
character(len=24) :: mesg_k
integer :: k
@@ -129,6 +130,7 @@ subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, &
enddo
end subroutine check_redundant_vC3d
+!> Check for consistency between the duplicated points of a 2-D C-grid vector
subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, &
direction)
character(len=*), intent(in) :: mesg !< An identifying message
@@ -143,21 +145,15 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, &
integer, optional, intent(in) :: je !< The ending j-index to check
integer, optional, intent(in) :: direction !< the direction flag to be
!! passed to pass_vector
-! Arguments: u_comp - The u-component of the vector being checked.
-! (in) v_comp - The v-component of the vector being checked.
-! (in) mesg - A message indicating what is being checked.
-! (in) G - The ocean's grid structure.
-! (in/opt) is, ie, js, je - the i- and j- range of indices to check.
-! (in/opt) direction - the direction flag to be passed to pass_vector.
-
+ ! Local variables
real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed)
real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed)
real :: u_resym(G%IsdB:G%IedB,G%jsd:G%jed)
real :: v_resym(G%isd:G%ied,G%JsdB:G%JedB)
character(len=128) :: mesg2
-
integer :: i, j, is_ch, ie_ch, js_ch, je_ch
integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
+
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
@@ -210,6 +206,7 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, &
end subroutine check_redundant_vC2d
+!> Check for consistency between the duplicated points of a 3-D scalar at corner points
subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je)
character(len=*), intent(in) :: mesg !< An identifying message
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -218,11 +215,8 @@ subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je)
integer, optional, intent(in) :: ie !< The ending i-index to check
integer, optional, intent(in) :: js !< The starting j-index to check
integer, optional, intent(in) :: je !< The ending j-index to check
-! Arguments: array - The array being checked.
-! (in) mesg - A message indicating what is being checked.
-! (in) G - The ocean's grid structure.
-! (in/opt) is, ie, js, je - the i- and j- range of indices to check.
+ ! Local variables
character(len=24) :: mesg_k
integer :: k
@@ -237,7 +231,7 @@ subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je)
enddo
end subroutine check_redundant_sB3d
-
+!> Check for consistency between the duplicated points of a 2-D scalar at corner points
subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je)
character(len=*), intent(in) :: mesg !< An identifying message
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -246,17 +240,13 @@ subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je)
integer, optional, intent(in) :: ie !< The ending i-index to check
integer, optional, intent(in) :: js !< The starting j-index to check
integer, optional, intent(in) :: je !< The ending j-index to check
-! Arguments: array - The array being checked.
-! (in) mesg - A message indicating what is being checked.
-! (in) G - The ocean's grid structure.
-! (in/opt) is, ie, js, je - the i- and j- range of indices to check.
-
+ ! Local variables
real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed)
real :: a_resym(G%IsdB:G%IedB,G%JsdB:G%JedB)
character(len=128) :: mesg2
-
integer :: i, j, is_ch, ie_ch, js_ch, je_ch
integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
+
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
@@ -299,7 +289,7 @@ subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je)
end subroutine check_redundant_sB2d
-
+!> Check for consistency between the duplicated points of a 3-D B-grid vector
subroutine check_redundant_vB3d(mesg, u_comp, v_comp, G, is, ie, js, je, &
direction)
character(len=*), intent(in) :: mesg !< An identifying message
@@ -313,14 +303,8 @@ subroutine check_redundant_vB3d(mesg, u_comp, v_comp, G, is, ie, js, je, &
integer, optional, intent(in) :: js !< The starting j-index to check
integer, optional, intent(in) :: je !< The ending j-index to check
integer, optional, intent(in) :: direction !< the direction flag to be
- !! passed to pass_vector
-! Arguments: u_comp - The u-component of the vector being checked.
-! (in) v_comp - The v-component of the vector being checked.
-! (in) mesg - A message indicating what is being checked.
-! (in) G - The ocean's grid structure.
-! (in/opt) is, ie, js, je - the i- and j- range of indices to check.
-! (in/opt) direction - the direction flag to be passed to pass_vector.
-
+ !! passed to pass_vector
+ ! Local variables
character(len=24) :: mesg_k
integer :: k
@@ -335,6 +319,7 @@ subroutine check_redundant_vB3d(mesg, u_comp, v_comp, G, is, ie, js, je, &
enddo
end subroutine check_redundant_vB3d
+!> Check for consistency between the duplicated points of a 2-D B-grid vector
subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, &
direction)
character(len=*), intent(in) :: mesg !< An identifying message
@@ -349,21 +334,15 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, &
integer, optional, intent(in) :: je !< The ending j-index to check
integer, optional, intent(in) :: direction !< the direction flag to be
!! passed to pass_vector
-! Arguments: u_comp - The u-component of the vector being checked.
-! (in) v_comp - The v-component of the vector being checked.
-! (in) mesg - A message indicating what is being checked.
-! (in) G - The ocean's grid structure.
-! (in/opt) is, ie, js, je - the i- and j- range of indices to check.
-! (in/opt) direction - the direction flag to be passed to pass_vector.
-
+ ! Local variables
real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed)
real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed)
real :: u_resym(G%IsdB:G%IedB,G%JsdB:G%JedB)
real :: v_resym(G%IsdB:G%IedB,G%JsdB:G%JedB)
character(len=128) :: mesg2
-
integer :: i, j, is_ch, ie_ch, js_ch, je_ch
integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
+
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
@@ -417,6 +396,7 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, &
end subroutine check_redundant_vB2d
+!> Check for consistency between the duplicated points of a 3-D scalar at tracer points
subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je)
character(len=*), intent(in) :: mesg !< An identifying message
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -425,11 +405,7 @@ subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je)
integer, optional, intent(in) :: ie !< The ending i-index to check
integer, optional, intent(in) :: js !< The starting j-index to check
integer, optional, intent(in) :: je !< The ending j-index to check
-! Arguments: array - The array being checked.
-! (in) mesg - A message indicating what is being checked.
-! (in) G - The ocean's grid structure.
-! (in/opt) is, ie, js, je - the i- and j- range of indices to check.
-
+ ! Local variables
character(len=24) :: mesg_k
integer :: k
@@ -445,6 +421,7 @@ subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je)
end subroutine check_redundant_sT3d
+!> Check for consistency between the duplicated points of a 2-D scalar at tracer points
subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je)
character(len=*), intent(in) :: mesg !< An identifying message
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -453,11 +430,7 @@ subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je)
integer, optional, intent(in) :: ie !< The ending i-index to check
integer, optional, intent(in) :: js !< The starting j-index to check
integer, optional, intent(in) :: je !< The ending j-index to check
-! Arguments: array - The array being checked.
-! (in) mesg - A message indicating what is being checked.
-! (in) G - The ocean's grid structure.
-! (in/opt) is, ie, js, je - the i- and j- range of indices to check.
-
+ ! Local variables
real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed)
character(len=128) :: mesg2
@@ -492,7 +465,7 @@ subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je)
end subroutine check_redundant_sT2d
-
+!> Check for consistency between the duplicated points of a 3-D A-grid vector
subroutine check_redundant_vT3d(mesg, u_comp, v_comp, G, is, ie, js, je, &
direction)
character(len=*), intent(in) :: mesg !< An identifying message
@@ -507,13 +480,7 @@ subroutine check_redundant_vT3d(mesg, u_comp, v_comp, G, is, ie, js, je, &
integer, optional, intent(in) :: je !< The ending j-index to check
integer, optional, intent(in) :: direction !< the direction flag to be
!! passed to pass_vector
-! Arguments: u_comp - The u-component of the vector being checked.
-! (in) v_comp - The v-component of the vector being checked.
-! (in) mesg - A message indicating what is being checked.
-! (in) G - The ocean's grid structure.
-! (in/opt) is, ie, js, je - the i- and j- range of indices to check.
-! (in/opt) direction - the direction flag to be passed to pass_vector.
-
+ ! Local variables
character(len=24) :: mesg_k
integer :: k
@@ -528,6 +495,7 @@ subroutine check_redundant_vT3d(mesg, u_comp, v_comp, G, is, ie, js, je, &
enddo
end subroutine check_redundant_vT3d
+!> Check for consistency between the duplicated points of a 2-D A-grid vector
subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, &
direction)
character(len=*), intent(in) :: mesg !< An identifying message
@@ -542,13 +510,7 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, &
integer, optional, intent(in) :: je !< The ending j-index to check
integer, optional, intent(in) :: direction !< the direction flag to be
!! passed to pass_vector
-! Arguments: u_comp - The u-component of the vector being checked.
-! (in) v_comp - The v-component of the vector being checked.
-! (in) mesg - A message indicating what is being checked.
-! (in) G - The ocean's grid structure.
-! (in/opt) is, ie, js, je - the i- and j- range of indices to check.
-! (in/opt) direction - the direction flag to be passed to pass_vector.
-
+ ! Local variables
real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed)
real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed)
character(len=128) :: mesg2
@@ -597,9 +559,7 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, &
end subroutine check_redundant_vT2d
-! =====================================================================
-
-! This function does a checksum and redundant point check on a 3d C-grid vector.
+!> Do a checksum and redundant point check on a 3d C-grid vector.
subroutine chksum_vec_C3d(mesg, u_comp, v_comp, G, halos, scalars)
character(len=*), intent(in) :: mesg !< An identifying message
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -608,7 +568,7 @@ subroutine chksum_vec_C3d(mesg, u_comp, v_comp, G, halos, scalars)
integer, optional, intent(in) :: halos !< The width of halos to check (default 0)
logical, optional, intent(in) :: scalars !< If true this is a pair of
!! scalars that are being checked.
-
+ ! Local variables
logical :: are_scalars
are_scalars = .false. ; if (present(scalars)) are_scalars = scalars
@@ -625,7 +585,7 @@ subroutine chksum_vec_C3d(mesg, u_comp, v_comp, G, halos, scalars)
end subroutine chksum_vec_C3d
-! This function does a checksum and redundant point check on a 2d C-grid vector.
+!> Do a checksum and redundant point check on a 2d C-grid vector.
subroutine chksum_vec_C2d(mesg, u_comp, v_comp, G, halos, scalars)
character(len=*), intent(in) :: mesg !< An identifying message
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -634,7 +594,7 @@ subroutine chksum_vec_C2d(mesg, u_comp, v_comp, G, halos, scalars)
integer, optional, intent(in) :: halos !< The width of halos to check (default 0)
logical, optional, intent(in) :: scalars !< If true this is a pair of
!! scalars that are being checked.
-
+ ! Local variables
logical :: are_scalars
are_scalars = .false. ; if (present(scalars)) are_scalars = scalars
@@ -651,7 +611,7 @@ subroutine chksum_vec_C2d(mesg, u_comp, v_comp, G, halos, scalars)
end subroutine chksum_vec_C2d
-! This function does a checksum and redundant point check on a 3d B-grid vector.
+!> Do a checksum and redundant point check on a 3d B-grid vector.
subroutine chksum_vec_B3d(mesg, u_comp, v_comp, G, halos, scalars)
character(len=*), intent(in) :: mesg !< An identifying message
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -660,7 +620,7 @@ subroutine chksum_vec_B3d(mesg, u_comp, v_comp, G, halos, scalars)
integer, optional, intent(in) :: halos !< The width of halos to check (default 0)
logical, optional, intent(in) :: scalars !< If true this is a pair of
!! scalars that are being checked.
-
+ ! Local variables
logical :: are_scalars
are_scalars = .false. ; if (present(scalars)) are_scalars = scalars
@@ -678,7 +638,7 @@ subroutine chksum_vec_B3d(mesg, u_comp, v_comp, G, halos, scalars)
end subroutine chksum_vec_B3d
-! This function does a checksum and redundant point check on a 2d B-grid vector.
+! Do a checksum and redundant point check on a 2d B-grid vector.
subroutine chksum_vec_B2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric)
character(len=*), intent(in) :: mesg !< An identifying message
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -689,7 +649,7 @@ subroutine chksum_vec_B2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric)
!! scalars that are being checked.
logical, optional, intent(in) :: symmetric !< If true, do the checksums on the
!! full symmetric computational domain.
-
+ ! Local variables
logical :: are_scalars
are_scalars = .false. ; if (present(scalars)) are_scalars = scalars
@@ -707,7 +667,7 @@ subroutine chksum_vec_B2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric)
end subroutine chksum_vec_B2d
-! This function does a checksum and redundant point check on a 3d C-grid vector.
+!> Do a checksum and redundant point check on a 3d C-grid vector.
subroutine chksum_vec_A3d(mesg, u_comp, v_comp, G, halos, scalars)
character(len=*), intent(in) :: mesg !< An identifying message
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -716,7 +676,7 @@ subroutine chksum_vec_A3d(mesg, u_comp, v_comp, G, halos, scalars)
integer, optional, intent(in) :: halos !< The width of halos to check (default 0)
logical, optional, intent(in) :: scalars !< If true this is a pair of
!! scalars that are being checked.
-
+ ! Local variables
logical :: are_scalars
are_scalars = .false. ; if (present(scalars)) are_scalars = scalars
@@ -734,8 +694,7 @@ subroutine chksum_vec_A3d(mesg, u_comp, v_comp, G, halos, scalars)
end subroutine chksum_vec_A3d
-
-! This function does a checksum and redundant point check on a 2d C-grid vector.
+!> Do a checksum and redundant point check on a 2d C-grid vector.
subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars)
character(len=*), intent(in) :: mesg !< An identifying message
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -744,7 +703,7 @@ subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars)
integer, optional, intent(in) :: halos !< The width of halos to check (default 0)
logical, optional, intent(in) :: scalars !< If true this is a pair of
!! scalars that are being checked.
-
+ ! Local variables
logical :: are_scalars
are_scalars = .false. ; if (present(scalars)) are_scalars = scalars
@@ -762,9 +721,6 @@ subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars)
end subroutine chksum_vec_A2d
-
-! =====================================================================
-
!> This function returns the sum over computational domain of all
!! processors of hThick*stuff, where stuff is a 3-d array at tracer points.
function totalStuff(HI, hThick, areaT, stuff)
@@ -772,7 +728,8 @@ function totalStuff(HI, hThick, areaT, stuff)
real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights
real, dimension(HI%isd:,HI%jsd:), intent(in) :: areaT !< The array of cell areas in m2
real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: stuff !< The array of stuff to be summed
- real :: totalStuff
+ real :: totalStuff !< the globally integrated amoutn of stuff
+ ! Local variables
integer :: i, j, k, nz
nz = size(hThick,3)
@@ -784,12 +741,8 @@ function totalStuff(HI, hThick, areaT, stuff)
end function totalStuff
-! =====================================================================
-
!> This subroutine display the total thickness, temperature and salinity
!! as well as the change since the last call.
-!! NOTE: This subroutine uses "save" data which is not thread safe and is purely
-!! for extreme debugging without a proper debugger.
subroutine totalTandS(HI, hThick, areaT, temperature, salinity, mesg)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights
@@ -797,11 +750,10 @@ subroutine totalTandS(HI, hThick, areaT, temperature, salinity, mesg)
real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: temperature !< The temperature field to sum
real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: salinity !< The salinity field to sum
character(len=*), intent(in) :: mesg !< An identifying message
-
! NOTE: This subroutine uses "save" data which is not thread safe and is purely for
! extreme debugging without a proper debugger.
real, save :: totalH = 0., totalT = 0., totalS = 0.
-
+ ! Local variables
logical, save :: firstCall = .true.
real :: thisH, thisT, thisS, delH, delT, delS
integer :: i, j, k, nz
@@ -874,8 +826,6 @@ logical function check_column_integrals(nk_1, field_1, nk_2, field_2, missing_va
real, dimension(nk_2), intent(in) :: field_2 !< Second field to be summed
real, optional, intent(in) :: missing_value !< If column contains missing values,
!! mask them from the sum
-
-
! Local variables
real :: u1_sum, error1, u2_sum, error2, misval
integer :: k
diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90
index 4efed0628f..f8ea773f74 100644
--- a/src/diagnostics/MOM_diag_to_Z.F90
+++ b/src/diagnostics/MOM_diag_to_Z.F90
@@ -1,32 +1,14 @@
+!> Maps tracers and velocities into depth space for output as diagnostic quantities.
+!!
+!! Currently, a piecewise linear subgrid structure is used for tracers, while velocities can
+!! use either piecewise constant or piecewise linear structures.
module MOM_diag_to_Z
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, July 2006 *
-!* *
-!* This subroutine maps tracers and velocities into depth space *
-!* for output as diagnostic quantities. Currently, a piecewise *
-!* linear subgrid structure is used for tracers, while velocities can *
-!* use either piecewise constant or piecewise linear structures. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q, CoriolisBu *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, bathyT *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
use MOM_domains, only : pass_var
use MOM_coms, only : reproducing_sum
-use MOM_diag_mediator, only : post_data, post_data_1d_k, register_diag_field, safe_alloc_ptr
+use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
use MOM_diag_mediator, only : diag_ctrl, time_type, diag_axis_init
use MOM_diag_mediator, only : axes_grp, define_axes_group
use MOM_diag_mediator, only : ocean_register_diag
@@ -55,80 +37,90 @@ module MOM_diag_to_Z
public register_Zint_diag
public calc_Zint_diags
+!> The control structure for the MOM_diag_to_Z module
type, public :: diag_to_Z_CS ; private
! The following arrays are used to store diagnostics calculated in this
! module and unavailable outside of it.
real, pointer, dimension(:,:,:) :: &
- u_z => NULL(), & ! zonal velocity remapped to depth space (m/s)
- v_z => NULL(), & ! meridional velocity remapped to depth space (m/s)
- uh_z => NULL(), & ! zonal transport remapped to depth space (m3/s or kg/s)
- vh_z => NULL() ! meridional transport remapped to depth space (m3/s or kg/s)
-
- type(p3d) :: tr_z(MAX_FIELDS_) ! array of tracers, remapped to depth space
- type(p3d) :: tr_model(MAX_FIELDS_) ! pointers to an array of tracers
-
- real :: missing_vel = -1.0e34
- real :: missing_trans = -1.0e34
- real :: missing_value = -1.0e34
- real :: missing_tr(MAX_FIELDS_) = -1.0e34
-
- integer :: id_u_z = -1
- integer :: id_v_z = -1
- integer :: id_uh_Z = -1
- integer :: id_vh_Z = -1
- integer :: id_tr(MAX_FIELDS_) = -1
- integer :: id_tr_xyave(MAX_FIELDS_) = -1
- integer :: num_tr_used = 0
- integer :: nk_zspace = -1
-
- real, pointer :: Z_int(:) => NULL() ! interface depths of the z-space file (meter)
+ u_z => NULL(), & !< zonal velocity remapped to depth space (m/s)
+ v_z => NULL(), & !< meridional velocity remapped to depth space (m/s)
+ uh_z => NULL(), & !< zonal transport remapped to depth space (m3/s or kg/s)
+ vh_z => NULL() !< meridional transport remapped to depth space (m3/s or kg/s)
+ type(p3d) :: tr_z(MAX_FIELDS_) !< array of tracers, remapped to depth space
+ type(p3d) :: tr_model(MAX_FIELDS_) !< pointers to an array of tracers
+
+ real :: missing_vel = -1.0e34 !< Missing variable fill values for velocities
+ real :: missing_trans = -1.0e34 !< Missing variable fill values for transports
+ real :: missing_tr(MAX_FIELDS_) = -1.0e34 !< Missing variable fill values for tracers
+ real :: missing_value = -1.0e34 !< Missing variable fill values for other diagnostics
+
+ integer :: id_u_z = -1 !< Diagnostic ID for zonal velocity
+ integer :: id_v_z = -1 !< Diagnostic ID for meridional velocity
+ integer :: id_uh_Z = -1 !< Diagnostic ID for zonal transports
+ integer :: id_vh_Z = -1 !< Diagnostic ID for meridional transports
+ integer :: id_tr(MAX_FIELDS_) = -1 !< Diagnostic IDs for tracers
+ integer :: id_tr_xyave(MAX_FIELDS_) = -1 !< Diagnostic IDs for spatially averaged tracers
+
+ integer :: num_tr_used = 0 !< Th enumber of tracers in use.
+ integer :: nk_zspace = -1 !< The number of levels in the z-space output
+
+ real, pointer :: Z_int(:) => NULL() !< interface depths of the z-space file (meter)
+
+ !>@{ Axis groups for z-space diagnostic output
type(axes_grp) :: axesBz, axesTz, axesCuz, axesCvz
type(axes_grp) :: axesBzi, axesTzi, axesCuzi, axesCvzi
type(axes_grp) :: axesZ
+ !!@}
integer, dimension(1) :: axesz_out
- type(diag_ctrl), pointer :: diag ! structure to regulate diagnostic output timing
+ type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to
+ ! regulate the timing of diagnostic output.
end type diag_to_Z_CS
-integer, parameter :: NO_ZSPACE = -1
+integer, parameter :: NO_ZSPACE = -1 !< Flag to enable z-space?
contains
+!> Return the global horizontal mean in z-space
function global_z_mean(var,G,CS,tracer)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(diag_to_Z_CS), intent(in) :: CS
- real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace), intent(in) :: var
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(diag_to_Z_CS), pointer :: CS !< Control structure returned by
+ !! previous call to diag_to_Z_init.
+ real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace), &
+ intent(in) :: var !< An array with the variable to average
+ integer, intent(in) :: tracer !< The tracer index being worked on
+ ! Local variables
real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace) :: tmpForSumming, weight
- real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace) :: localVar, valid_point, depth_weight
real, dimension(CS%nk_zspace) :: global_z_mean, scalarij, weightij
real, dimension(CS%nk_zspace) :: global_temp_scalar, global_weight_scalar
- integer :: i, j, k, is, ie, js, je, nz, tracer
+ real :: valid_point, depth_weight
+ integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
nz = CS%nk_zspace
! Initialize local arrays
- valid_point = 1. ; depth_weight = 0.
tmpForSumming(:,:,:) = 0. ; weight(:,:,:) = 0.
- ! Local array copy of tracer field pointer
- localVar = var
-
- do k=1, nz ; do j=js,je ; do i=is, ie
+ do k=1,nz ; do j=js,je ; do i=is,ie
+ valid_point = 1.0
! Weight factor for partial bottom cells
- depth_weight(i,j,k) = min( max( (-1.*G%bathyT(i,j)), CS%Z_int(k+1) ) - CS%Z_int(k), 0.)
+ depth_weight = min( max( (-G%Zd_to_m*G%bathyT(i,j)), CS%Z_int(k+1) ) - CS%Z_int(k), 0.)
! Flag the point as invalid if it contains missing data, or is below the bathymetry
- if (var(i,j,k) == CS%missing_tr(tracer)) valid_point(i,j,k) = 0.
- if (depth_weight(i,j,k) == 0.) valid_point(i,j,k) = 0.
+ if (var(i,j,k) == CS%missing_tr(tracer)) valid_point = 0.
+ if (depth_weight == 0.) valid_point = 0.
- ! If the point is flagged, set the variable itsef to zero to avoid NaNs
- if (valid_point(i,j,k) == 0.) localVar(i,j,k) = 0.
+ weight(i,j,k) = depth_weight * ( (valid_point * (G%areaT(i,j) * G%mask2dT(i,j))) )
- weight(i,j,k) = depth_weight(i,j,k) * ( (valid_point(i,j,k) * (G%areaT(i,j) * G%mask2dT(i,j))) )
- tmpForSumming(i,j,k) = localVar(i,j,k) * weight(i,j,k)
+ ! If the point is flagged, set the variable itself to zero to avoid NaNs
+ if (valid_point == 0.) then
+ tmpForSumming(i,j,k) = 0.0
+ else
+ tmpForSumming(i,j,k) = var(i,j,k) * weight(i,j,k)
+ endif
enddo ; enddo ; enddo
global_temp_scalar = reproducing_sum(tmpForSumming,sums=scalarij)
@@ -146,32 +138,21 @@ end function global_z_mean
!> This subroutine maps tracers and velocities into depth space for diagnostics.
subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS)
- type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid
- !! structure.
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1.
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity,
- !! in m s-1.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H
- !! (usually m or kg m-2).
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_in !< Sea surface height
- !! (meter or kg/m2).
- real, dimension(:,:), pointer :: frac_shelf_h
- type(diag_to_Z_CS), pointer :: CS !< Control structure returned by
- !! previous call to
- !! diagnostics_init.
-
-! This subroutine maps tracers and velocities into depth space for diagnostics.
-
-! Arguments:
-! (in) u - zonal velocity component (m/s)
-! (in) v - meridional velocity component (m/s)
-! (in) h - layer thickness (meter or kg/m2)
-! (in) ssh_in - sea surface height (meter or kg/m2)
-! (in) G - ocean grid structure
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - control structure returned by previous call to diagnostics_init
-
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: u !< The zonal velocity, in m s-1.
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: v !< The meridional velocity, in m s-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(in) :: ssh_in !< Sea surface height in meters.
+ real, dimension(:,:), pointer :: frac_shelf_h !< The fraction of the cell area covered by
+ !! ice shelf, or unassocatiaed if there is no shelf
+ type(diag_to_Z_CS), pointer :: CS !< Control structure returned by a previous call
+ !! to diag_to_Z_init.
+ ! Local variables
! Note the deliberately reversed axes in h_f, u_f, v_f, and tr_f.
real :: ssh(SZI_(G),SZJ_(G)) ! copy of ssh_in (meter or kg/m2)
real :: e(SZK_(G)+2) ! z-star interface heights (meter or kg/m2)
@@ -209,7 +190,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS)
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
IsgB = G%IsgB ; IegB = G%IegB ; JsgB = G%JsgB ; JegB = G%JegB
nkml = max(GV%nkml, 1)
- Angstrom = GV%Angstrom
+ Angstrom = GV%Angstrom_H
ssh(:,:) = ssh_in
linear_velocity_profiles = .true.
! Update the halos
@@ -236,7 +217,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS)
! Remove all massless layers.
do I=Isq,Ieq
nk_valid(I) = 0
- D_pt(I) = 0.5*(G%bathyT(i+1,j)+G%bathyT(i,j))
+ D_pt(I) = 0.5*G%Zd_to_m*(G%bathyT(i+1,j)+G%bathyT(i,j))
if (ice_shelf) then
if (frac_shelf_h(i,j)+frac_shelf_h(i+1,j) > 0.) then ! under shelf
shelf_depth(I) = abs(0.5*(ssh(i+1,j)+ssh(i,j)))
@@ -333,7 +314,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS)
shelf_depth(:) = 0.0 ! initially all is open ocean
! Remove all massless layers.
do i=is,ie
- nk_valid(i) = 0 ; D_pt(i) = 0.5*(G%bathyT(i,j)+G%bathyT(i,j+1))
+ nk_valid(i) = 0 ; D_pt(i) = 0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i,j+1))
if (ice_shelf) then
if (frac_shelf_h(i,j)+frac_shelf_h(i,j+1) > 0.) then ! under shelf
shelf_depth(i) = abs(0.5*(ssh(i,j)+ssh(i,j+1)))
@@ -425,7 +406,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS)
shelf_depth(:) = 0.0 ! initially all is open ocean
! Remove all massless layers.
do i=is,ie
- nk_valid(i) = 0 ; D_pt(i) = G%bathyT(i,j)
+ nk_valid(i) = 0 ; D_pt(i) = G%Zd_to_m*G%bathyT(i,j)
if (ice_shelf) then
if (frac_shelf_h(i,j) > 0.) then ! under shelf
shelf_depth(i) = abs(ssh(i,j))
@@ -498,7 +479,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS)
if (CS%id_tr(m) > 0) call post_data(CS%id_tr(m), CS%tr_z(m)%p, CS%diag)
if (CS%id_tr_xyave(m) > 0) then
layer_ave = global_z_mean(CS%tr_z(m)%p,G,CS,m)
- call post_data_1d_k(CS%id_tr_xyave(m), layer_ave, CS%diag)
+ call post_data(CS%id_tr_xyave(m), layer_ave, CS%diag)
endif
enddo
endif
@@ -521,19 +502,8 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS)
!! subroutine.
type(diag_to_Z_CS), pointer :: CS !< Control structure returned by
!! previous call to
- !! diagnostics_init.
-
-! This subroutine maps horizontal transport into depth space for diagnostic output.
-
-! Arguments:
-! (in) uh_int - time integrated zonal transport (m3 or kg)
-! (in) vh_int - time integrated meridional transport (m3 or kg)
-! (in) h - layer thickness (meter or kg/m2)
-! (in) dt - time difference (sec) since last call to this routine
-! (in) G - ocean grid structure
-! (in) GV - The ocean's vertical grid structure
-! (in) CS - control structure returned by previous call to diagnostics_init
-
+ !! diag_to_Z_init.
+ ! Local variables
real, dimension(SZI_(G), SZJ_(G)) :: &
htot, & ! total layer thickness (meter or kg/m2)
dilate ! nondimensional factor by which to dilate layers to
@@ -586,13 +556,13 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS)
htot(i,j) = htot(i,j) + h(i,j,k)
enddo ; enddo ; enddo
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- dilate(i,j) = G%bathyT(i,j) / htot(i,j)
+ dilate(i,j) = G%Zd_to_m*G%bathyT(i,j) / htot(i,j)
enddo ; enddo
! zonal transport
if (CS%id_uh_Z > 0) then ; do j=js,je
do I=Isq,Ieq
- kz(I) = nk_z ; z_int_above(I) = -0.5*(G%bathyT(i,j)+G%bathyT(i+1,j))
+ kz(I) = nk_z ; z_int_above(I) = -0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i+1,j))
enddo
do k=nk_z,1,-1 ; do I=Isq,Ieq
uh_Z(I,k) = 0.0
@@ -627,7 +597,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS)
! meridional transport
if (CS%id_vh_Z > 0) then ; do J=Jsq,Jeq
do i=is,ie
- kz(i) = nk_z ; z_int_above(i) = -0.5*(G%bathyT(i,j)+G%bathyT(i,j+1))
+ kz(i) = nk_z ; z_int_above(i) = -0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i,j+1))
enddo
do k=nk_z,1,-1 ; do i=is,ie
vh_Z(i,k) = 0.0
@@ -675,7 +645,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS)
end subroutine calculate_Z_transport
-!> This subroutine determines the layers bounded by interfaces e that overlap
+!> Determines the layers bounded by interfaces e that overlap
!! with the depth range between Z_top and Z_bot, and the fractional weights
!! of each layer. It also calculates the normalized relative depths of the range
!! of each layer that overlaps that depth range.
@@ -690,31 +660,13 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z
integer, intent(inout) :: k_bot !< Indices of bottom layers that overlap with the
!! depth range.
real, dimension(:), intent(out) :: wt !< Relative weights of each layer from k_top to k_bot.
- real, dimension(:), intent(out) :: z1, z2 !< Depths of the top and bottom limits of the part of
+ real, dimension(:), intent(out) :: z1 !< Depth of the top limits of the part of
!! a layer that contributes to a depth level, relative to the cell center and normalized
!! by the cell thickness (nondim). Note that -1/2 <= z1 < z2 <= 1/2.
-
-! This subroutine determines the layers bounded by interfaces e that overlap
-! with the depth range between Z_top and Z_bot, and the fractional weights
-! of each layer. It also calculates the normalized relative depths of the range
-! of each layer that overlaps that depth range.
-
-! Note that by convention, e decreases with increasing k and Z_top > Z_bot.
-!
-! Arguments:
-! (in) e - column interface heights (meter or kg/m2)
-! (in) Z_top - top of range being mapped to (meter or kg/m2)
-! (in) Z_bot - bottom of range being mapped to (meter or kg/m2)
-! (in) k_max - number of valid layers
-! (in) k_start - layer at which to start searching
-! (out) k_top, k_bot - indices of top and bottom layers that
-! overlap with the depth range
-! (out) wt - relative weights of each layer from k_top to k_bot
-! (out) z1, z2 - depths of the top and bottom limits of
-! the part of a layer that contributes to a depth level,
-! relative to the cell center and normalized by the cell
-! thickness (nondim). Note that -1/2 <= z1 < z2 <= 1/2.
-
+ real, dimension(:), intent(out) :: z2 !< Depths of the bottom limit of the part of
+ !! a layer that contributes to a depth level, relative to the cell center and normalized
+ !! by the cell thickness (nondim). Note that -1/2 <= z1 < z2 <= 1/2.
+ ! Local variables
real :: Ih, e_c, tot_wt, I_totwt
integer :: k
@@ -726,20 +678,24 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z
! Note that by convention, e and Z_int decrease with increasing k.
if (e(K+1)<=Z_bot) then
wt(k) = 1.0 ; k_bot = k
- Ih = 1.0 / (e(K)-e(K+1))
+ Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1))
e_c = 0.5*(e(K)+e(K+1))
z1(k) = (e_c - MIN(e(K),Z_top)) * Ih
z2(k) = (e_c - Z_bot) * Ih
else
wt(k) = MIN(e(K),Z_top) - e(K+1) ; tot_wt = wt(k) ! These are always > 0.
- z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K),Z_top)) / (e(K)-e(K+1))
+ if (e(K) /= e(K+1)) then
+ z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K), Z_top)) / (e(K)-e(K+1))
+ else ; z1(k) = -0.5 ; endif
z2(k) = 0.5
k_bot = k_max
do k=k_top+1,k_max
if (e(K+1)<=Z_bot) then
k_bot = k
wt(k) = e(K) - Z_bot ; z1(k) = -0.5
- z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1))
+ if (e(K) /= e(K+1)) then
+ z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1))
+ else ; z2(k) = 0.5 ; endif
else
wt(k) = e(K) - e(K+1) ; z1(k) = -0.5 ; z2(k) = 0.5
endif
@@ -753,29 +709,20 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z
end subroutine find_overlap
-!> This subroutine determines a limited slope for val to be advected with
+!> This subroutine determines a limited slope for val to be advected with
!! a piecewise limited scheme.
subroutine find_limited_slope(val, e, slope, k)
real, dimension(:), intent(in) :: val !< A column of values that are being interpolated.
real, dimension(:), intent(in) :: e !< Column interface heights (meter or kg/m2).
real, intent(out) :: slope !< Normalized slope in the intracell distribution of val.
integer, intent(in) :: k !< Layer whose slope is being determined.
-
-! This subroutine determines a limited slope for val to be advected with
-! a piecewise limited scheme.
-
-! Arguments:
-! (in) val - a column of values that are being interpolated
-! (in) e - column interface heights (meter or kg/m2)
-! (in) slope - normalized slope in the intracell distribution of val
-! (in) k - layer whose slope is being determined
-
+ ! Local variables
real :: d1, d2
- if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then
+ d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2))
+ if (((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) .or. (d1*d2 <= 0.0)) then
slope = 0.0 ! ; curvature = 0.0
else
- d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2))
slope = (d1**2*(val(k+1) - val(k)) + d2**2*(val(k) - val(k-1))) * &
((e(K) - e(K+1)) / (d1*d2*(d1+d2)))
! slope = 0.5*(val(k+1) - val(k-1))
@@ -788,18 +735,18 @@ subroutine find_limited_slope(val, e, slope, k)
end subroutine find_limited_slope
-! #@# This subroutine needs a doxygen description
+!> This subroutine calculates interface diagnostics in z-space.
subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H
- !! (usually m or kg m-2).
- type(p3d), dimension(:), intent(in) :: in_ptrs
- integer, dimension(:), intent(in) :: ids
- integer, intent(in) :: num_diags
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid
- !! structure.
- type(diag_to_Z_CS), pointer :: CS
-
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
+ type(p3d), dimension(:), intent(in) :: in_ptrs !< Pointers to the diagnostics to be regridded
+ integer, dimension(:), intent(in) :: ids !< The diagnostic IDs of the diagnostics
+ integer, intent(in) :: num_diags !< The number of diagnostics to regrid
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ type(diag_to_Z_CS), pointer :: CS !< Control structure returned by
+ !! previous call to diag_to_Z_init.
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G),max(CS%nk_zspace+1,1),max(num_diags,1)) :: &
diag_on_Z ! diagnostics interpolated to depth space
real, dimension(SZI_(G),SZK_(G)+1) :: e
@@ -826,8 +773,8 @@ subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS)
do k=1,nk ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo
do i=is,ie
dilate(i) = 0.0
- if (htot(i)*GV%H_to_m > 0.5) dilate(i) = (G%bathyT(i,j) - 0.0) / htot(i)
- e(i,nk+1) = -G%bathyT(i,j)
+ if (htot(i)*GV%H_to_m > 0.5) dilate(i) = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i)
+ e(i,nk+1) = -G%Zd_to_m*G%bathyT(i,j)
enddo
do k=nk,1,-1 ; do i=is,ie
e(i,k) = e(i,k+1) + h(i,j,k) * dilate(i)
@@ -889,36 +836,23 @@ end subroutine calc_Zint_diags
!> This subroutine registers a tracer to be output in depth space.
subroutine register_Z_tracer(tr_ptr, name, long_name, units, Time, G, CS, standard_name, &
cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- target, intent(in) :: tr_ptr !< Tracer for translation to Z-space.
- character(len=*), intent(in) :: name !< name for the output tracer.
- character(len=*), intent(in) :: long_name !< Long name for the output tracer.
- character(len=*), intent(in) :: units !< Units of output tracer.
- character(len=*), optional, intent(in) :: standard_name
- type(time_type), intent(in) :: Time !< Current model time.
- type(diag_to_Z_CS), pointer :: CS !< Control struct returned by previous
- !! call to diagnostics_init.
- character(len=*), optional, intent(in) :: cmor_field_name !< cmor name of a field.
- character(len=*), optional, intent(in) :: cmor_long_name !< cmor long name of a field.
- character(len=*), optional, intent(in) :: cmor_units !< cmor units of a field.
- character(len=*), optional, intent(in) :: cmor_standard_name !< cmor standardized name
- !! associated with a field.
-
-! This subroutine registers a tracer to be output in depth space.
-! Arguments:
-! (in) tr_ptr - tracer for translation to Z-space
-! (in) name - name for the output tracer
-! (in) long_name - long name for the output tracer
-! (in) units - units of output tracer
-! (in) Time - current model time
-! (in) G - ocean grid structure
-! (in) CS - control struct returned by previous call to diagnostics_init
-! (in,opt) cmor_field_name - cmor name of a field
-! (in,opt) cmor_long_name - cmor long name of a field
-! (in,opt) cmor_units - cmor units of a field
-! (in,opt) cmor_standard_name - cmor standardized name associated with a field
-
+ target, intent(in) :: tr_ptr !< Tracer for translation to Z-space.
+ character(len=*), intent(in) :: name !< name for the output tracer.
+ character(len=*), intent(in) :: long_name !< Long name for the output tracer.
+ character(len=*), intent(in) :: units !< Units of output tracer.
+ character(len=*), optional, intent(in) :: standard_name !< The CMOR standard name of this variable.
+ type(time_type), intent(in) :: Time !< Current model time.
+ type(diag_to_Z_CS), pointer :: CS !< Control struct returned by previous
+ !! call to diag_to_Z_init.
+ character(len=*), optional, intent(in) :: cmor_field_name !< cmor name of a field.
+ character(len=*), optional, intent(in) :: cmor_long_name !< cmor long name of a field.
+ character(len=*), optional, intent(in) :: cmor_units !< cmor units of a field.
+ character(len=*), optional, intent(in) :: cmor_standard_name !< cmor standardized name
+ !! associated with a field.
+
+ ! Local variables
character(len=256) :: posted_standard_name
character(len=256) :: posted_cmor_units
character(len=256) :: posted_cmor_standard_name
@@ -960,28 +894,17 @@ end subroutine register_Z_tracer
!> This subroutine registers a tracer to be output in depth space.
subroutine register_Z_tracer_low(tr_ptr, name, long_name, units, standard_name, Time, G, CS)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- target, intent(in) :: tr_ptr !< Tracer for translation to Z-space.
- character(len=*), intent(in) :: name !< Name for the output tracer.
- character(len=*), intent(in) :: long_name !< Long name for output tracer.
- character(len=*), intent(in) :: units !< Units of output tracer.
- character(len=*), intent(in) :: standard_name
- type(time_type), intent(in) :: Time !< Current model time.
- type(diag_to_Z_CS), pointer :: CS !< Control struct returned by previous call to
- !! diagnostics_init.
-
-! This subroutine registers a tracer to be output in depth space.
-
-! Arguments:
-! (in) tr_ptr - tracer for translation to Z-space
-! (in) name - name for the output tracer
-! (in) long_name - long name for output tracer
-! (in) units - units of output tracer
-! (in) Time - current model time
-! (in) G - ocean grid structure
-! (in) CS - control struct returned by previous call to diagnostics_init
-
+ target, intent(in) :: tr_ptr !< Tracer for translation to Z-space.
+ character(len=*), intent(in) :: name !< Name for the output tracer.
+ character(len=*), intent(in) :: long_name !< Long name for output tracer.
+ character(len=*), intent(in) :: units !< Units of output tracer.
+ character(len=*), intent(in) :: standard_name !< The CMOR standard name of this variable.
+ type(time_type), intent(in) :: Time !< Current model time.
+ type(diag_to_Z_CS), pointer :: CS !< Control struct returned by previous call to
+ !! diag_to_Z_init.
+ ! Local variables
character(len=256) :: posted_standard_name
integer :: isd, ied, jsd, jed, nk, m, id_test
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nk = G%ke
@@ -1024,28 +947,19 @@ subroutine register_Z_tracer_low(tr_ptr, name, long_name, units, standard_name,
end subroutine register_Z_tracer_low
-! #@# This subroutine needs a doxygen comment.
+!> This subroutine sets parameters that control Z-space diagnostic output.
subroutine MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS)
type(time_type), intent(in) :: Time !< Current model time.
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(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
- !! parameters.
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters.
type(diag_ctrl), target, intent(inout) :: diag !< Struct to regulate diagnostic output.
type(diag_to_Z_CS), pointer :: CS !< Pointer to point to control structure for
- !! this module.
-
-! Arguments:
-! (in) Time - current model time
-! (in) G - ocean grid structure
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - struct indicating open file to parse for model param values
-! (in) diag - struct to regulate diagnostic output
-! (in/out) CS - pointer to point to control structure for this module
-
+ !! this module, which is allocated and
+ !! populated here.
! This include declares and sets the variable "version".
#include "version_variable.h"
-
+ ! Local variables
character(len=40) :: mdl = "MOM_diag_to_Z" ! module name
character(len=200) :: in_dir, zgrid_file ! strings for directory/file
character(len=48) :: flux_units, string
@@ -1134,19 +1048,15 @@ end subroutine MOM_diag_to_Z_init
!! up with the same information as this axis.
subroutine get_Z_depths(depth_file, int_depth_name, int_depth, cell_depth_name, &
z_axis_index, edge_index, nk_out)
- character(len=*), intent(in) :: depth_file
- character(len=*), intent(in) :: int_depth_name
- real, dimension(:), pointer :: int_depth
- character(len=*), intent(in) :: cell_depth_name
- integer, intent(out) :: z_axis_index
- integer, intent(out) :: edge_index
- integer, intent(out) :: nk_out
-
-! This subroutine reads the depths of the interfaces bounding the intended
-! layers from a NetCDF file. If no appropriate file is found, -1 is returned
-! as the number of layers in the output file. Also, a diag_manager axis is set
-! up with the same information as this axis.
-
+ character(len=*), intent(in) :: depth_file !< The file to read for the depths
+ character(len=*), intent(in) :: int_depth_name !< The interface depth variable name
+ real, dimension(:), pointer :: int_depth !< A pointer that will be allocated and
+ !! returned with the interface depths
+ character(len=*), intent(in) :: cell_depth_name !< The cell-center depth variable name
+ integer, intent(out) :: z_axis_index !< The cell-center z-axis diagnostic index handle
+ integer, intent(out) :: edge_index !< The interface z-axis diagnostic index handle
+ integer, intent(out) :: nk_out !< The number of layers in the output grid
+ ! Local variables
real, allocatable :: cell_depth(:)
character (len=200) :: units, long_name
integer :: ncid, status, intid, intvid, layid, layvid, k, ni
@@ -1253,8 +1163,9 @@ subroutine get_Z_depths(depth_file, int_depth_name, int_depth, cell_depth_name,
end subroutine get_Z_depths
+!> Deallocate memory associated with the MOM_diag_to_Z module
subroutine MOM_diag_to_Z_end(CS)
- type(diag_to_Z_CS), pointer :: CS
+ type(diag_to_Z_CS), pointer :: CS !< Control structure returned by a previous call to diag_to_Z_init.
integer :: m
if (associated(CS%u_z)) deallocate(CS%u_z)
@@ -1268,23 +1179,15 @@ end subroutine MOM_diag_to_Z_end
!> This subroutine registers a tracer to be output in depth space.
function ocean_register_diag_with_z(tr_ptr, vardesc_tr, G, Time, CS)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- target, intent(in) :: tr_ptr !< Tracer for translation to Z-space.
- type(vardesc), intent(in) :: vardesc_tr !< Variable descriptor.
- type(time_type), intent(in) :: Time !< Current model time.
- type(diag_to_Z_CS), pointer :: CS !< Control struct returned by a previous
- !! call to diagnostics_init.
- integer :: ocean_register_diag_with_z
-
-! This subroutine registers a tracer to be output in depth space.
-! Arguments:
-! (in) tr_ptr - tracer for translation to Z-space
-! (in) vardesc_tr - variable descriptor
-! (in) Time - current model time
-! (in) G - ocean grid structure
-! (in) CS - control struct returned by a previous call to diagnostics_init
-
+ target, intent(in) :: tr_ptr !< Tracer for translation to Z-space.
+ type(vardesc), intent(in) :: vardesc_tr !< Variable descriptor.
+ type(time_type), intent(in) :: Time !< Current model time.
+ type(diag_to_Z_CS), pointer :: CS !< Control struct returned by a previous
+ !! call to diag_to_Z_init.
+ integer :: ocean_register_diag_with_z !< The retuned Z-space diagnostic ID
+ ! Local variables
type(vardesc) :: vardesc_z
character(len=64) :: var_name ! A variable's name.
integer :: isd, ied, jsd, jed, nk, m, id_test
@@ -1332,18 +1235,20 @@ function ocean_register_diag_with_z(tr_ptr, vardesc_tr, G, Time, CS)
end function ocean_register_diag_with_z
+!> Register a diagnostic to be output in depth space.
function register_Z_diag(var_desc, CS, day, missing)
- integer :: register_Z_diag
- type(vardesc), intent(in) :: var_desc
- type(diag_to_Z_CS), pointer :: CS
- type(time_type), intent(in) :: day
- real, intent(in) :: missing
-
+ integer :: register_Z_diag !< The returned z-layer diagnostic index
+ type(vardesc), intent(in) :: var_desc !< A type with metadata for this diagnostic
+ type(diag_to_Z_CS), pointer :: CS !< Control structure returned by
+ !! previous call to diag_to_Z_init.
+ type(time_type), intent(in) :: day !< The current model time
+ real, intent(in) :: missing !< The missing value for this diagnostic
+ ! Local variables
character(len=64) :: var_name ! A variable's name.
character(len=48) :: units ! A variable's units.
character(len=240) :: longname ! A variable's longname.
character(len=8) :: hor_grid, z_grid ! Variable grid info.
- type(axes_grp), pointer :: axes
+ type(axes_grp), pointer :: axes => NULL()
call query_vardesc(var_desc, name=var_name, units=units, longname=longname, &
hor_grid=hor_grid, z_grid=z_grid, caller="register_Zint_diag")
@@ -1385,17 +1290,20 @@ function register_Z_diag(var_desc, CS, day, missing)
end function register_Z_diag
-function register_Zint_diag(var_desc, CS, day)
- integer :: register_Zint_diag
- type(vardesc), intent(in) :: var_desc
- type(diag_to_Z_CS), pointer :: CS
- type(time_type), intent(in) :: day
-
+!> Register a diagnostic to be output at depth space interfaces
+function register_Zint_diag(var_desc, CS, day, conversion)
+ integer :: register_Zint_diag !< The returned z-interface diagnostic index
+ type(vardesc), intent(in) :: var_desc !< A type with metadata for this diagnostic
+ type(diag_to_Z_CS), pointer :: CS !< Control structure returned by
+ !! previous call to diag_to_Z_init.
+ type(time_type), intent(in) :: day !< The current model time
+ real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file
+ ! Local variables
character(len=64) :: var_name ! A variable's name.
character(len=48) :: units ! A variable's units.
character(len=240) :: longname ! A variable's longname.
character(len=8) :: hor_grid ! Variable grid info.
- type(axes_grp), pointer :: axes
+ type(axes_grp), pointer :: axes => NULL()
call query_vardesc(var_desc, name=var_name, units=units, longname=longname, &
hor_grid=hor_grid, caller="register_Zint_diag")
@@ -1420,10 +1328,10 @@ function register_Zint_diag(var_desc, CS, day)
"register_Z_diag: unknown hor_grid component "//trim(hor_grid))
end select
- register_Zint_diag = register_diag_field("ocean_model_zold", trim(var_name),&
- axes, day, trim(longname), trim(units), missing_value=CS%missing_value)
+ register_Zint_diag = register_diag_field("ocean_model_zold", trim(var_name), &
+ axes, day, trim(longname), trim(units), missing_value=CS%missing_value, &
+ conversion=conversion)
end function register_Zint_diag
-
end module MOM_diag_to_Z
diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90
index b0d5d803e4..30101c91a0 100644
--- a/src/diagnostics/MOM_diagnostics.F90
+++ b/src/diagnostics/MOM_diagnostics.F90
@@ -1,31 +1,12 @@
+!> Calculates any requested diagnostic quantities
+!! that are not calculated in the various subroutines.
+!! Diagnostic quantities are requested by allocating them memory.
module MOM_diagnostics
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, February 2001 *
-!* *
-!* This subroutine calculates any requested diagnostic quantities *
-!* that are not calculated in the various subroutines. Diagnostic *
-!* quantities are requested by allocating them memory. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q, CoriolisBu *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, bathyT *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_coms, only : reproducing_sum
-use MOM_diag_mediator, only : post_data, post_data_1d_k, get_diag_time_end
+use MOM_diag_mediator, only : post_data, get_diag_time_end
use MOM_diag_mediator, only : register_diag_field, register_scalar_field
use MOM_diag_mediator, only : register_static_field, diag_register_area_ids
use MOM_diag_mediator, only : diag_ctrl, time_type, safe_alloc_ptr
@@ -60,6 +41,7 @@ module MOM_diagnostics
public register_transport_diags, post_transport_diagnostics
public MOM_diagnostics_init, MOM_diagnostics_end
+!> The control structure for the MOM_diagnostics module
type, public :: diagnostics_CS ; private
real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as
!! monotonic for the purposes of calculating the equivalent
@@ -67,54 +49,58 @@ module MOM_diagnostics
real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of
!! calculating the equivalent barotropic wave speed. (m)
- type(diag_ctrl), pointer :: diag ! structure to regulate diagnostics timing
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
! following arrays store diagnostics calculated here and unavailable outside.
! following fields have nz+1 levels.
real, pointer, dimension(:,:,:) :: &
- e => NULL(), & ! interface height (metre)
- e_D => NULL() ! interface height above bottom (metre)
+ e => NULL(), & !< interface height (metre)
+ e_D => NULL() !< interface height above bottom (metre)
! following fields have nz layers.
real, pointer, dimension(:,:,:) :: &
- du_dt => NULL(), & ! net i-acceleration in m/s2
- dv_dt => NULL(), & ! net j-acceleration in m/s2
- dh_dt => NULL(), & ! thickness rate of change in (m/s) or kg/(m2*s)
-
- h_Rlay => NULL(), & ! layer thicknesses in layered potential density
- ! coordinates, in m (Bouss) or kg/m2 (non-Bouss)
- uh_Rlay => NULL(), & ! zonal and meridional transports in layered
- vh_Rlay => NULL(), & ! potential rho coordinates: m3/s(Bouss) kg/s(non-Bouss)
- uhGM_Rlay => NULL(), & ! zonal and meridional Gent-McWilliams transports in layered
- vhGM_Rlay => NULL(), & ! potential density coordinates, m3/s (Bouss) kg/s(non-Bouss)
- p_ebt => NULL() ! Equivalent barotropic modal structure
+ du_dt => NULL(), & !< net i-acceleration in m/s2
+ dv_dt => NULL(), & !< net j-acceleration in m/s2
+ dh_dt => NULL(), & !< thickness rate of change in (m/s) or kg/(m2*s)
+ p_ebt => NULL() !< Equivalent barotropic modal structure
+
+ real, pointer, dimension(:,:,:) :: h_Rlay => NULL() !< Layer thicknesses in potential density
+ !! coordinates, in m (Bouss) or kg/m2 (non-Bouss)
+ real, pointer, dimension(:,:,:) :: uh_Rlay => NULL() !< Zonal transports in potential density
+ !! coordinates in m3/s (Bouss) or kg/s (non-Bouss)
+ real, pointer, dimension(:,:,:) :: vh_Rlay => NULL() !< Meridional transports in potential density
+ !! coordinates in m3/s (Bouss) or kg/s (non-Bouss)
+ real, pointer, dimension(:,:,:) :: uhGM_Rlay => NULL() !< Zonal Gent-McWilliams transports in potential density
+ !! coordinates, in m3/s (Bouss) or kg/s (non-Bouss)
+ real, pointer, dimension(:,:,:) :: vhGM_Rlay => NULL() !< Meridional Gent-McWilliams transports in potential density
+ !! coordinates, in m3/s (Bouss) or kg/s (non-Bouss)
! following fields are 2-D.
real, pointer, dimension(:,:) :: &
- cg1 => NULL(), & ! first baroclinic gravity wave speed, in m s-1
- Rd1 => NULL(), & ! first baroclinic deformation radius, in m
- cfl_cg1 => NULL(), & ! CFL for first baroclinic gravity wave speed, nondim
- cfl_cg1_x => NULL(), & ! i-component of CFL for first baroclinic gravity wave speed, nondim
- cfl_cg1_y => NULL() ! j-component of CFL for first baroclinic gravity wave speed, nondim
+ cg1 => NULL(), & !< First baroclinic gravity wave speed, in m s-1
+ Rd1 => NULL(), & !< First baroclinic deformation radius, in m
+ cfl_cg1 => NULL(), & !< CFL for first baroclinic gravity wave speed, nondim
+ cfl_cg1_x => NULL(), & !< i-component of CFL for first baroclinic gravity wave speed, nondim
+ cfl_cg1_y => NULL() !< j-component of CFL for first baroclinic gravity wave speed, nondim
! arrays to hold diagnostics in the layer-integrated energy budget.
! all except KE have units of m3 s-3 (when Boussinesq).
real, pointer, dimension(:,:,:) :: &
- KE => NULL(), & ! KE per unit mass, in m2 s-2
- dKE_dt => NULL(), & ! time derivative of the layer KE
- PE_to_KE => NULL(), & ! potential energy to KE term
- KE_CorAdv => NULL(), & ! KE source from the combined Coriolis and
- ! advection terms. The Coriolis source should be
- ! zero, but is not due to truncation errors. There
- ! should be near-cancellation of the global integral
- ! of this spurious Coriolis source.
- KE_adv => NULL(),& ! KE source from along-layer advection
- KE_visc => NULL(),& ! KE source from vertical viscosity
- KE_horvisc => NULL(),& ! KE source from horizontal viscosity
- KE_dia => NULL() ! KE source from diapycnal diffusion
-
- ! diagnostic IDs
+ KE => NULL(), & !< KE per unit mass, in m2 s-2
+ dKE_dt => NULL(), & !< time derivative of the layer KE
+ PE_to_KE => NULL(), & !< potential energy to KE term
+ KE_CorAdv => NULL(), & !< KE source from the combined Coriolis and advection terms.
+ !! The Coriolis source should be zero, but is not due to truncation
+ !! errors. There should be near-cancellation of the global integral
+ !! of this spurious Coriolis source.
+ KE_adv => NULL(),& !< KE source from along-layer advection
+ KE_visc => NULL(),& !< KE source from vertical viscosity
+ KE_horvisc => NULL(),& !< KE source from horizontal viscosity
+ KE_dia => NULL() !< KE source from diapycnal diffusion
+
+ !>@{ Diagnostic IDs
integer :: id_u = -1, id_v = -1, id_h = -1
integer :: id_e = -1, id_e_D = -1
integer :: id_du_dt = -1, id_dv_dt = -1
@@ -143,25 +129,28 @@ module MOM_diagnostics
integer :: id_pbo = -1
integer :: id_thkcello = -1, id_rhoinsitu = -1
integer :: id_rhopot0 = -1, id_rhopot2 = -1
- integer :: id_h_pre_sync = -1
+ integer :: id_h_pre_sync = -1 !!@}
+ !> The control structure for calculating wave speed.
type(wave_speed_CS), pointer :: wave_speed_CSp => NULL()
- ! pointers used in calculation of time derivatives
- type(p3d) :: var_ptr(MAX_FIELDS_)
- type(p3d) :: deriv(MAX_FIELDS_)
- type(p3d) :: prev_val(MAX_FIELDS_)
- integer :: nlay(MAX_FIELDS_)
- integer :: num_time_deriv = 0
+ type(p3d) :: var_ptr(MAX_FIELDS_) !< pointers to variables used in the calculation
+ !! of time derivatives
+ type(p3d) :: deriv(MAX_FIELDS_) !< Time derivatives of various fields
+ type(p3d) :: prev_val(MAX_FIELDS_) !< Previous values of variables used in the calculation
+ !! of time derivatives
+ !< previous values of variables used in calculation of time derivatives
+ integer :: nlay(MAX_FIELDS_) !< The number of layers in each diagnostics
+ integer :: num_time_deriv = 0 !< The number of time derivative diagnostics
- ! for group halo pass
- type(group_pass_type) :: pass_KE_uv
+ type(group_pass_type) :: pass_KE_uv !< A handle used for group halo passes
end type diagnostics_CS
!> A structure with diagnostic IDs of the surface and integrated variables
type, public :: surface_diag_IDs ; private
- ! 2-d surface and bottom fields
+ !>@{ Diagnostic IDs for 2-d surface and bottom flux and state fields
+ !Diagnostic IDs for 2-d surface and bottom fields
integer :: id_zos = -1, id_zossq = -1
integer :: id_volo = -1, id_speed = -1
integer :: id_ssh = -1, id_ssh_ga = -1
@@ -169,21 +158,21 @@ module MOM_diagnostics
integer :: id_sss = -1, id_sss_sq = -1, id_sssabs = -1
integer :: id_ssu = -1, id_ssv = -1
- ! heat and salt flux fields
+ ! Diagnostic IDs for heat and salt flux fields
integer :: id_fraz = -1
integer :: id_salt_deficit = -1
integer :: id_Heat_PmE = -1
integer :: id_intern_heat = -1
+ !!@}
end type surface_diag_IDs
!> A structure with diagnostic IDs of mass transport related diagnostics
type, public :: transport_diag_IDs ; private
- ! Diagnostics for tracer horizontal transport
+ !>@{ Diagnostics for tracer horizontal transport
integer :: id_uhtr = -1, id_umo = -1, id_umo_2d = -1
integer :: id_vhtr = -1, id_vmo = -1, id_vmo_2d = -1
- integer :: id_dynamics_h = -1, id_dynamics_h_tendency = -1
-
+ integer :: id_dynamics_h = -1, id_dynamics_h_tendency = -1 !!@}
end type transport_diag_IDs
@@ -200,11 +189,11 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- intent(in) :: uh !< Transport through zonal faces = u*h*dy,
- !! in H m2 s-1, i.e. m3/s(Bouss) or kg/s(non-Bouss).
+ intent(in) :: uh !< Transport through zonal faces = u*h*dy, in H m2 s-1.
+ !! I.e. units are m3/s(Bouss) or kg/s(non-Bouss).
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- intent(in) :: vh !< Transport through meridional faces = v*h*dx,
- !! in H m2 s-1, i.e. m3/s(Bouss) or kg/s(non-Bouss).
+ intent(in) :: vh !< Transport through meridional faces = v*h*dx, in H m2 s-1.
+ !! I.e. units are m3/s(Bouss) or kg/s(non-Bouss).
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables.
type(accel_diag_ptrs), intent(in) :: ADp !< structure with pointers to
@@ -295,19 +284,19 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag)
if (associated(CS%e)) then
- call find_eta(h, tv, GV%g_Earth, G, GV, CS%e, eta_bt)
+ call find_eta(h, tv, G, GV, CS%e, eta_bt, eta_to_m=1.0)
if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag)
endif
if (associated(CS%e_D)) then
if (associated(CS%e)) then
do k=1,nz+1 ; do j=js,je ; do i=is,ie
- CS%e_D(i,j,k) = CS%e(i,j,k) + G%bathyT(i,j)
+ CS%e_D(i,j,k) = CS%e(i,j,k) + G%Zd_to_m*G%bathyT(i,j)
enddo ; enddo ; enddo
else
- call find_eta(h, tv, GV%g_Earth, G, GV, CS%e_D, eta_bt)
+ call find_eta(h, tv, G, GV, CS%e_D, eta_bt, eta_to_m=1.0)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
- CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%bathyT(i,j)
+ CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%Zd_to_m*G%bathyT(i,j)
enddo ; enddo ; enddo
endif
@@ -335,7 +324,14 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
! diagnose thickness/volumes of grid cells (meter)
if (CS%id_thkcello>0 .or. CS%id_volcello>0) then
if (GV%Boussinesq) then ! thkcello = h for Boussinesq
- if (CS%id_thkcello > 0) call post_data(CS%id_thkcello, GV%H_to_m*h, CS%diag)
+ if (CS%id_thkcello > 0) then ; if (GV%H_to_m == 1.0) then
+ call post_data(CS%id_thkcello, h, CS%diag)
+ else
+ do k=1,nz; do j=js,je ; do i=is,ie
+ work_3d(i,j,k) = GV%H_to_m*h(i,j,k)
+ enddo ; enddo ; enddo
+ call post_data(CS%id_thkcello, work_3d, CS%diag)
+ endif ; endif
if (CS%id_volcello > 0) then ! volcello = h*area for Boussinesq
do k=1,nz; do j=js,je ; do i=is,ie
work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * G%areaT(i,j)
@@ -355,7 +351,7 @@ 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%g_Earth*GV%H_to_kg_m2)*h(i,j,k)
+ pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k)
enddo
! Store in-situ density (kg/m3) in work_3d
call calculate_density(tv%T(:,j,k),tv%S(:,j,k), pressure_1d, &
@@ -364,7 +360,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
work_3d(i,j,k) = (GV%H_to_kg_m2*h(i,j,k)) / work_3d(i,j,k)
enddo
do i=is,ie ! Pressure for EOS at the bottom interface (Pa)
- pressure_1d(i) = pressure_1d(i) + 0.5*(GV%g_Earth*GV%H_to_kg_m2)*h(i,j,k)
+ pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k)
enddo
enddo ! k
enddo ! j
@@ -445,13 +441,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
! layer mean potential temperature
if (CS%id_temp_layer_ave>0) then
temp_layer_ave = global_layer_mean(tv%T, h, G, GV)
- call post_data_1d_k(CS%id_temp_layer_ave, temp_layer_ave, CS%diag)
+ call post_data(CS%id_temp_layer_ave, temp_layer_ave, CS%diag)
endif
! layer mean salinity
if (CS%id_salt_layer_ave>0) then
salt_layer_ave = global_layer_mean(tv%S, h, G, GV)
- call post_data_1d_k(CS%id_salt_layer_ave, salt_layer_ave, CS%diag)
+ call post_data(CS%id_salt_layer_ave, salt_layer_ave, CS%diag)
endif
call calculate_vertical_integrals(h, tv, p_surf, G, GV, CS)
@@ -819,9 +815,9 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS)
endif
if (CS%id_col_ht > 0) then
- call find_eta(h, tv, GV%g_Earth, G, GV, z_top)
+ call find_eta(h, tv, G, GV, z_top, eta_to_m=1.0)
do j=js,je ; do i=is,ie
- z_bot(i,j) = z_top(i,j) + G%bathyT(i,j)
+ z_bot(i,j) = z_top(i,j) + G%Zd_to_m*G%bathyT(i,j)
enddo ; enddo
call post_data(CS%id_col_ht, z_bot, CS%diag)
endif
@@ -830,7 +826,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, 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 / GV%g_Earth
+ IG_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z)
! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo
do j=js,je ; do i=is,ie ; z_bot(i,j) = 0.0 ; enddo ; enddo
do k=1,nz
@@ -839,7 +835,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS)
z_bot(i,j) = z_top(i,j) - GV%H_to_m*h(i,j,k)
enddo ; enddo
call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), &
- z_top, z_bot, 0.0, GV%H_to_kg_m2, GV%g_Earth, &
+ z_top, z_bot, 0.0, GV%H_to_kg_m2, (GV%g_Earth*GV%m_to_Z), &
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
@@ -864,7 +860,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, 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) = mass(i,j) * GV%g_Earth
+ btm_pres(i,j) = mass(i,j) * (GV%g_Earth*GV%m_to_Z)
if (associated(p_surf)) then
btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j)
endif
@@ -877,42 +873,28 @@ end subroutine calculate_vertical_integrals
!> This subroutine calculates terms in the mechanical energy budget.
subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS)
- type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid
- !! structure.
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1.
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity,
- !! in m s-1.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H
- !! (usually m or kg m-2).
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Transport through zonal
- !! faces=u*h*dy: m3/s (Bouss)
- !! kg/s(non-Bouss).
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Transport through merid
- !! faces=v*h*dx: m3/s (Bouss)
- !! kg/s(non-Bouss).
- type(accel_diag_ptrs), intent(in) :: ADp !< Structure pointing to
- !! accelerations in momentum
- !! equation.
- type(cont_diag_ptrs), intent(in) :: CDp !< Structure pointing to terms
- !! in continuity equations.
- type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by
- !! a previous call to
- !! diagnostics_init.
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: u !< The zonal velocity, in m s-1.
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: v !< The meridional velocity, in m s-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: uh !< Transport through zonal faces=u*h*dy, in H m2 s-1.
+ !! I.e. units are m3/s (Bouss) or kg/s(non-Bouss).
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: vh !< Transport through merid faces=v*h*dx, in H m2 s-1.
+ !! I.e. units are m3/s (Bouss) or kg/s(non-Bouss).
+ type(accel_diag_ptrs), intent(in) :: ADp !< Structure pointing to accelerations in momentum equation.
+ type(cont_diag_ptrs), intent(in) :: CDp !< Structure pointing to terms in continuity equations.
+ type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a previous call to
+ !! diagnostics_init.
! This subroutine calculates terms in the mechanical energy budget.
-! Arguments:
-! (in) u - zonal velocity component (m/s)
-! (in) v - meridional velocity componnent (m/s)
-! (in) h - layer thickness: metre(Bouss) of kg/m2(non-Bouss)
-! (in) uh - transport through zonal faces=u*h*dy: m3/s (Bouss) kg/s(non-Bouss)
-! (in) vh - transport through merid faces=v*h*dx: m3/s (Bouss) kg/s(non-Bouss)
-! (in) ADp - structure pointing to accelerations in momentum equation
-! (in) CDp - structure pointing to terms in continuity equations
-! (in) G - ocean grid structure
-! (in) CS - control structure returned by a previous call to diagnostics_init
-
+ ! Local variables
real :: KE_u(SZIB_(G),SZJ_(G))
real :: KE_v(SZI_(G),SZJB_(G))
real :: KE_h(SZI_(G),SZJ_(G))
@@ -1091,16 +1073,11 @@ end subroutine calculate_energy_diagnostics
subroutine register_time_deriv(f_ptr, deriv_ptr, CS)
real, dimension(:,:,:), target :: f_ptr !< Field whose derivative is taken.
real, dimension(:,:,:), target :: deriv_ptr !< Field in which the calculated time derivatives
- !! placed.
+ !! will be placed.
type(diagnostics_CS), pointer :: CS !< Control structure returned by previous call to
!! diagnostics_init.
-! This subroutine registers fields to calculate a diagnostic time derivative.
-! Arguments:
-! (target) f_ptr - field whose derivative is taken
-! (in) deriv_ptr - field in which the calculated time derivatives placed
-! (in) num_lay - number of layers in this field
-! (in) CS - control structure returned by previous call to diagnostics_init
+ ! This subroutine registers fields to calculate a diagnostic time derivative.
integer :: m
@@ -1126,18 +1103,12 @@ end subroutine register_time_deriv
!> This subroutine calculates all registered time derivatives.
subroutine calculate_derivs(dt, G, CS)
- real, intent(in) :: dt !< The time interval over which differences occur,
- !! in s.
+ real, intent(in) :: dt !< The time interval over which differences occur, in s.
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to
!! diagnostics_init.
! This subroutine calculates all registered time derivatives.
-! Arguments:
-! (in) dt - time interval in s over which differences occur
-! (in) G - ocean grid structure.
-! (in) CS - control structure returned by previous call to diagnostics_init
-
integer i, j, k, m
real Idt
@@ -1159,12 +1130,12 @@ end subroutine calculate_derivs
subroutine post_surface_dyn_diags(IDs, G, diag, sfc_state, ssh)
type(surface_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs.
type(ocean_grid_type), intent(in) :: G !< ocean grid structure
- type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output
+ type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output
type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state
real, dimension(SZI_(G),SZJ_(G)), &
- intent(in) :: ssh !< Time mean surface height without corrections for
- !! ice displacement (m)
+ intent(in) :: ssh !< Time mean surface height without corrections for ice displacement (m)
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array
integer :: i, j, is, ie, js, je
@@ -1202,11 +1173,9 @@ subroutine post_surface_thermo_diags(IDs, G, GV, diag, dt_int, sfc_state, tv, &
type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
real, dimension(SZI_(G),SZJ_(G)), &
- intent(in) :: ssh !< Time mean surface height without corrections for
- !! ice displacement (m)
- real, dimension(SZI_(G),SZJ_(G)), &
- intent(in) :: ssh_ibc !< Time mean surface height with corrections for
- !! ice displacement and the inverse barometer (m)
+ intent(in) :: ssh !< Time mean surface height without corrections for ice displacement (m)
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections
+ !! for ice displacement and the inverse barometer (m)
real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array
real, dimension(SZI_(G),SZJ_(G)) :: &
@@ -1247,7 +1216,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, diag, dt_int, sfc_state, tv, &
! post total volume of the liquid ocean
if (IDs%id_volo > 0) then
do j=js,je ; do i=is,ie
- work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + G%bathyT(i,j))
+ work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + G%Zd_to_m*G%bathyT(i,j))
enddo ; enddo
volo = global_area_integral(work_2d, G)
call post_data(IDs%id_volo, volo, diag)
@@ -1340,12 +1309,10 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d
diag_to_Z_CSp, Reg)
type(ocean_grid_type), intent(inout) :: G !< ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- intent(in) :: uhtr !< Accumulated zonal thickness fluxes used
- !! to advect tracers (m3 or kg)
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- intent(in) :: vhtr !< Accumulated meridional thickness fluxes
- !! used to advect tracers (m3 or kg)
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< Accumulated zonal thickness fluxes
+ !! used to advect tracers (m3 or kg)
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< Accumulated meridional thickness fluxes
+ !! used to advect tracers (m3 or kg)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
intent(in) :: h !< The updated layer thicknesses, in H
type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs.
@@ -1857,10 +1824,13 @@ subroutine write_static_fields(G, GV, tv, diag)
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output
+
! Local variables
real :: tmp_h(SZI_(G),SZJ_(G))
integer :: id, i, j
+ tmp_h(:,:) = 0.0
+
id = register_static_field('ocean_model', 'geolat', diag%axesT1, &
'Latitude of tracer (T) points', 'degrees_north')
if (id > 0) call post_data(id, G%geoLatT, diag, .true.)
@@ -1937,7 +1907,16 @@ subroutine write_static_fields(G, GV, tv, diag)
cmor_standard_name='sea_floor_depth_below_geoid',&
area=diag%axesT1%id_area, &
x_cell_method='mean', y_cell_method='mean', area_cell_method='mean')
- if (id > 0) call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT)
+ if (id > 0) then
+ if (G%Zd_to_m == 1.0) then
+ call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT)
+ else
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ tmp_h(i,j) = G%bathyT(i,j) * G%Zd_to_m
+ enddo ; enddo
+ call post_data(id, tmp_h, diag, .true., mask=G%mask2dT)
+ endif
+ endif
id = register_static_field('ocean_model', 'wet', diag%axesT1, &
'0 if land, 1 if ocean at tracer points', 'none', area=diag%axesT1%id_area)
@@ -1991,6 +1970,14 @@ subroutine write_static_fields(G, GV, tv, diag)
'Open zonal grid spacing at v points (meter)', 'm', interp_method='none')
if (id > 0) call post_data(id, G%dx_Cv, diag, .true.)
+ id = register_static_field('ocean_model', 'sin_rot', diag%axesT1, &
+ 'sine of the clockwise angle of the ocean grid north to true north', 'none')
+ if (id > 0) call post_data(id, G%sin_rot, diag, .true.)
+
+ id = register_static_field('ocean_model', 'cos_rot', diag%axesT1, &
+ 'cosine of the clockwise angle of the ocean grid north to true north', 'none')
+ if (id > 0) call post_data(id, G%cos_rot, diag, .true.)
+
! This static diagnostic is from CF 1.8, and is the fraction of a cell
! covered by ocean, given as a percentage (poorly named).
@@ -2000,8 +1987,9 @@ subroutine write_static_fields(G, GV, tv, diag)
cmor_long_name='Sea Area Fraction', &
x_cell_method='mean', y_cell_method='mean', area_cell_method='mean')
if (id > 0) then
- tmp_h(:,:) = 0.
- tmp_h(G%isc:G%iec,G%jsc:G%jec) = 100. * G%mask2dT(G%isc:G%iec,G%jsc:G%jec)
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ tmp_h(i,j) = 100. * G%mask2dT(i,j)
+ enddo ; enddo
call post_data(id, tmp_h, diag, .true.)
endif
@@ -2035,14 +2023,6 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, CS)
!! module.
! This subroutine sets up diagnostics upon which other diagnostics depend.
-! Arguments:
-! (in) MIS - For "MOM Internal State" a set of pointers to the fields and
-! accelerations making up ocean internal physical state.
-! (inout) ADp - structure pointing to accelerations in momentum equation
-! (inout) CDp - structure pointing to terms in continuity equation
-! (in) G - ocean grid structure
-! (in) CS - pointer to the control structure for this module
-
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90
index 8e6cd8b8f1..91a4dd96ab 100644
--- a/src/diagnostics/MOM_sum_output.F90
+++ b/src/diagnostics/MOM_sum_output.F90
@@ -1,42 +1,8 @@
+!> Reports integrated quantities for monitoring the model state
module MOM_sum_output
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, April 1994 - June 2002 *
-!* *
-!* This file contains the subroutine (write_energy) that writes *
-!* horizontally integrated quantities, such as energies and layer *
-!* volumes, and other summary information to an output file. Some *
-!* of these quantities (APE or resting interface height) are defined *
-!* relative to the global histogram of topography. The subroutine *
-!* that compiles that histogram (depth_list_setup) is also included *
-!* in this file. *
-!* *
-!* In addition, if the number of velocity truncations since the *
-!* previous call to write_energy exceeds maxtrunc or the total energy *
-!* exceeds a very large threshold, a fatal termination is triggered. *
-!* *
-!* This file also contains a few miscelaneous initialization *
-!* calls to FMS-related modules. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, bathyT *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs
use MOM_coms, only : reproducing_sum, EFP_to_real, real_to_EFP
use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=)
@@ -66,55 +32,52 @@ module MOM_sum_output
public write_energy, accumulate_net_input, MOM_sum_output_init
-!-----------------------------------------------------------------------
-
-integer, parameter :: NUM_FIELDS = 17
+integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields
+!> A list of depths and corresponding globally integrated ocean area at each
+!! depth and the ocean volume below each depth.
type :: Depth_List
- real :: depth ! A depth, in m.
- real :: area ! The cross-sectional area of the ocean at that depth, in m2.
- real :: vol_below ! The ocean volume below that depth, in m3.
+ real :: depth !< A depth, in m.
+ real :: area !< The cross-sectional area of the ocean at that depth, in m2.
+ real :: vol_below !< The ocean volume below that depth, in m3.
end type Depth_List
+!> The control structure for the MOM_sum_output module
type, public :: sum_output_CS ; private
- type(Depth_List), pointer, dimension(:) :: DL => NULL() ! The sorted depth list.
- integer :: list_size ! =niglobal*njglobal length of sorting vector
-
- integer ALLOCABLE_, dimension(NKMEM_) :: lH
- ! This saves the entry in DL with a volume just
- ! less than the volume of fluid below the
- ! interface.
- logical :: do_APE_calc ! If true, calculate the available potential
- ! energy of the interfaces. Disabling this
- ! reduces the memory footprint of high-PE-count
- ! models dramatically.
- logical :: read_depth_list ! Read the depth list from a file if it exists
- ! and write it if it doesn't.
- character(len=200) :: depth_list_file ! The name of the depth list file.
- real :: D_list_min_inc ! The minimum increment, in m, between the
- ! depths of the entries in the depth-list file,
- ! 0 by default.
- logical :: use_temperature ! If true, temperature and salinity are state
- ! variables.
- real :: fresh_water_input ! The total mass of fresh water added by
- ! surface fluxes since the last time that
- real :: mass_prev ! The total ocean mass the last time that
- ! write_energy was called, in kg.
- real :: salt_prev ! The total amount of salt in the ocean the last
- ! time that write_energy was called, in PSU kg.
- real :: net_salt_input ! The total salt added by surface fluxes since
- ! the last time that write_energy was called,
- ! in PSU kg.
- real :: heat_prev ! The total amount of heat in the ocean the last
- ! time that write_energy was called, in Joules.
- real :: net_heat_input ! The total heat added by surface fluxes since
- ! the last time that write_energy was called,
- ! in Joules.
- type(EFP_type) :: &
- fresh_water_in_EFP, & ! These are extended fixed point versions of the
- net_salt_in_EFP, & ! correspondingly named variables above.
- net_heat_in_EFP, heat_prev_EFP, salt_prev_EFP, mass_prev_EFP
- real :: dt ! The baroclinic dynamics time step, in s.
+ type(Depth_List), pointer, dimension(:) :: DL => NULL() !< The sorted depth list.
+ integer :: list_size !< length of sorting vector <= niglobal*njglobal
+
+ integer, allocatable, dimension(:) :: lH
+ !< This saves the entry in DL with a volume just
+ !! less than the volume of fluid below the interface.
+ logical :: do_APE_calc !< If true, calculate the available potential energy of the
+ !! interfaces. Disabling this reduces the memory footprint of
+ !! high-PE-count models dramatically.
+ logical :: read_depth_list !< Read the depth list from a file if it exists
+ !! and write it if it doesn't.
+ character(len=200) :: depth_list_file !< The name of the depth list file.
+ real :: D_list_min_inc !< The minimum increment, in m, between the depths of the
+ !! entries in the depth-list file, 0 by default.
+ logical :: use_temperature !< If true, temperature and salinity are state variables.
+ real :: fresh_water_input !< The total mass of fresh water added by surface fluxes
+ !! since the last time that write_energy was called, in kg.
+ real :: mass_prev !< The total ocean mass the last time that
+ !! write_energy was called, in kg.
+ real :: salt_prev !< The total amount of salt in the ocean the last
+ !! time that write_energy was called, in PSU kg.
+ real :: net_salt_input !< The total salt added by surface fluxes since the last
+ !! time that write_energy was called, in PSU kg.
+ real :: heat_prev !< The total amount of heat in the ocean the last
+ !! time that write_energy was called, in Joules.
+ real :: net_heat_input !< The total heat added by surface fluxes since the last
+ !! the last time that write_energy was called, in Joules.
+ type(EFP_type) :: fresh_water_in_EFP !< An extended fixed point version of fresh_water_input
+ type(EFP_type) :: net_salt_in_EFP !< An extended fixed point version of net_salt_input
+ type(EFP_type) :: net_heat_in_EFP !< An extended fixed point version of net_heat_input
+ type(EFP_type) :: heat_prev_EFP !< An extended fixed point version of heat_prev
+ type(EFP_type) :: salt_prev_EFP !< An extended fixed point version of salt_prev
+ type(EFP_type) :: mass_prev_EFP !< An extended fixed point version of mass_prev
+ real :: dt !< The baroclinic dynamics time step, in s.
type(time_type) :: energysavedays !< The interval between writing the energies
!! and other integral quantities of the run.
@@ -129,27 +92,25 @@ module MOM_sum_output
!! of calls to write_energy and revert to the standard
!! energysavedays interval
- real :: timeunit ! The length of the units for the time
- ! axis, in s.
- logical :: date_stamped_output ! If true, use dates (not times) in messages to stdout.
- type(time_type) :: Start_time ! The start time of the simulation.
+ real :: timeunit !< The length of the units for the time axis, in s.
+ logical :: date_stamped_output !< If true, use dates (not times) in messages to stdout.
+ type(time_type) :: Start_time !< The start time of the simulation.
! Start_time is set in MOM_initialization.F90
- integer, pointer :: ntrunc ! The number of times the velocity has been
- ! truncated since the last call to write_energy.
- real :: max_Energy ! The maximum permitted energy per unit mass
- ! If there is more energy than this, the model
- ! should stop, in m2 s-2.
- integer :: maxtrunc ! The number of truncations per energy save
- ! interval at which the run is stopped.
- logical :: write_stocks ! If true, write the integrated tracer amounts
- ! to stdout when the energy files are written.
- integer :: previous_calls = 0 ! The number of times write_energy has been called.
- integer :: prev_n = 0 ! The value of n from the last call.
- integer :: fileenergy_nc ! NetCDF id of the energy file.
- integer :: fileenergy_ascii ! The unit number of the ascii version of the energy file.
+ integer, pointer :: ntrunc => NULL() !< The number of times the velocity has been
+ !! truncated since the last call to write_energy.
+ real :: max_Energy !< The maximum permitted energy per unit mass. If there is
+ !! more energy than this, the model should stop, in m2 s-2.
+ integer :: maxtrunc !< The number of truncations per energy save
+ !! interval at which the run is stopped.
+ logical :: write_stocks !< If true, write the integrated tracer amounts
+ !! to stdout when the energy files are written.
+ integer :: previous_calls = 0 !< The number of times write_energy has been called.
+ integer :: prev_n = 0 !< The value of n from the last call.
+ integer :: fileenergy_nc !< NetCDF id of the energy file.
+ integer :: fileenergy_ascii !< The unit number of the ascii version of the energy file.
type(fieldtype), dimension(NUM_FIELDS+MAX_FIELDS_) :: &
- fields ! fieldtype variables for the output fields.
- character(len=200) :: energyfile ! The name of the energy file with path.
+ fields !< fieldtype variables for the output fields.
+ character(len=200) :: energyfile !< The name of the energy file with path.
end type sum_output_CS
contains
@@ -167,15 +128,7 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, &
type(time_type), intent(in) :: Input_start_time !< The start time of the simulation.
type(Sum_output_CS), pointer :: CS !< A pointer that is set to point to the
!! control structure for this module.
-! Arguments: G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) directory - The directory where the energy file goes.
-! (in/out) ntrnc - The integer that stores the number of times the velocity
-! has been truncated since the last call to write_energy.
-! (in) Input_start_time - The start time of the simulation.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
+ ! Local variables
real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS.
real :: Rho_0, maxvel
! This include declares and sets the variable "version".
@@ -267,7 +220,7 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, &
CS%depth_list_file = trim(slasher(directory))//trim(CS%depth_list_file)
endif
- ALLOC_(CS%lH(G%ke))
+ allocate(CS%lH(G%ke))
call depth_list_setup(G, CS)
else
CS%list_size = 0
@@ -304,8 +257,7 @@ subroutine MOM_sum_output_end(CS)
!! previous call to MOM_sum_output_init.
if (associated(CS)) then
if (CS%do_APE_calc) then
- DEALLOC_(CS%lH)
- deallocate(CS%DL)
+ deallocate(CS%lH, CS%DL)
endif
deallocate(CS)
@@ -335,7 +287,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc
type(ocean_OBC_type), &
optional, pointer :: OBC !< Open boundaries control structure.
type(time_type), optional, intent(in) :: dt_forcing !< The forcing time step
-
+ ! Local variables
real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces, in m.
real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT, in m2.
real :: KE(SZK_(G)) ! The total kinetic energy of a layer, in J.
@@ -426,7 +378,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc
integer :: pe_num
integer :: iyear, imonth, iday, ihour, iminute, isecond, itick ! For call to get_date()
logical :: local_open_BC
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
! A description for output of each of the fields.
type(vardesc) :: vars(NUM_FIELDS+MAX_FIELDS_)
@@ -546,7 +498,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc
enddo ; enddo ; enddo
mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP)
- call find_eta(h, tv, GV%g_Earth, G, GV, eta)
+ call find_eta(h, tv, G, GV, eta, eta_to_m=1.0)
do k=1,nz ; do j=js,je ; do i=is,ie
tmp1(i,j,k) = (eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j)
enddo ; enddo ; enddo
@@ -688,10 +640,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc
hbelow = 0.0
do k=nz,1,-1
hbelow = hbelow + h(i,j,k) * H_to_m
- hint = H_0APE(K) + (hbelow - G%bathyT(i,j))
- hbot = H_0APE(K) - G%bathyT(i,j)
+ hint = H_0APE(K) + (hbelow - G%Zd_to_m*G%bathyT(i,j))
+ hbot = H_0APE(K) - G%Zd_to_m*G%bathyT(i,j)
hbot = (hbot + ABS(hbot)) * 0.5
- PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%g_prime(K)) * &
+ PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%m_to_Z*GV%g_prime(K)) * &
(hint * hint - hbot * hbot)
enddo
enddo ; enddo
@@ -700,8 +652,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc
hbelow = 0.0
do k=nz,1,-1
hint = H_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs.
- hbot = max(H_0APE(K) - G%bathyT(i,j), 0.0)
- PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * &
+ hbot = max(H_0APE(K) - G%Zd_to_m*G%bathyT(i,j), 0.0)
+ PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%m_to_Z*GV%g_prime(K))) * &
(hint * hint - hbot * hbot)
enddo
enddo ; enddo
@@ -960,7 +912,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call
!! to MOM_sum_output_init.
-
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
FW_in, & ! The net fresh water input, integrated over a timestep in kg.
salt_in, & ! The total salt added by surface fluxes, integrated
@@ -1078,11 +1030,7 @@ subroutine depth_list_setup(G, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(Sum_output_CS), pointer :: CS !< The control structure returned by a
!! previous call to MOM_sum_output_init.
-! This subroutine sets up an ordered list of depths, along with the
-! cross sectional areas at each depth and the volume of fluid deeper
-! than each depth. This might be read from a previously created file
-! or it might be created anew. (For now only new creation occurs.
-
+ ! Local variables
integer :: k
if (CS%read_depth_list) then
@@ -1111,7 +1059,7 @@ subroutine create_depth_list(G, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(Sum_output_CS), pointer :: CS !< The control structure set up in MOM_sum_output_init,
!! in which the ordered depth list is stored.
-
+ ! Local variables
real, dimension(G%Domain%niglobal*G%Domain%njglobal + 1) :: &
Dlist, & !< The global list of bottom depths, in m.
AreaList !< The global list of cell areas, in m2.
@@ -1140,7 +1088,7 @@ subroutine create_depth_list(G, CS)
i_global = i + G%idg_offset - (G%isg-1)
list_pos = (j_global-1)*G%Domain%niglobal + i_global
- Dlist(list_pos) = G%bathyT(i,j)
+ Dlist(list_pos) = G%Zd_to_m*G%bathyT(i,j)
Arealist(list_pos) = G%mask2dT(i,j)*G%areaT(i,j)
enddo ; enddo
@@ -1238,9 +1186,7 @@ subroutine write_depth_list(G, CS, filename, list_size)
!! previous call to MOM_sum_output_init.
character(len=*), intent(in) :: filename !< The path to the depth list file to write.
integer, intent(in) :: list_size !< The size of the depth list.
-
-! This subroutine writes out the depth list to the specified file.
-
+ ! Local variables
real, allocatable :: tmp(:)
integer :: ncid, dimid(1), Did, Aid, Vid, status, k
@@ -1320,9 +1266,7 @@ subroutine read_depth_list(G, CS, filename)
type(Sum_output_CS), pointer :: CS !< The control structure returned by a
!! previous call to MOM_sum_output_init.
character(len=*), intent(in) :: filename !< The path to the depth list file to read.
-
-! This subroutine reads in the depth list to the specified file
-! and allocates and sets up CS%DL and CS%list_size .
+ ! Local variables
character(len=32) :: mdl
character(len=240) :: var_name, var_msg
real, allocatable :: tmp(:)
@@ -1404,4 +1348,20 @@ subroutine read_depth_list(G, CS, filename)
end subroutine read_depth_list
+!> \namespace mom_sum_output
+!!
+!! By Robert Hallberg, April 1994 - June 2002
+!!
+!! This file contains the subroutine (write_energy) that writes
+!! horizontally integrated quantities, such as energies and layer
+!! volumes, and other summary information to an output file. Some
+!! of these quantities (APE or resting interface height) are defined
+!! relative to the global histogram of topography. The subroutine
+!! that compiles that histogram (depth_list_setup) is also included
+!! in this file.
+!!
+!! In addition, if the number of velocity truncations since the
+!! previous call to write_energy exceeds maxtrunc or the total energy
+!! exceeds a very large threshold, a fatal termination is triggered.
+
end module MOM_sum_output
diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90
index 9244b33738..e8d58e502b 100644
--- a/src/diagnostics/MOM_wave_speed.F90
+++ b/src/diagnostics/MOM_wave_speed.F90
@@ -29,7 +29,7 @@ module MOM_wave_speed
!! wave speed. This parameter controls the default behavior of
!! wave_speed() which can be overridden by optional arguments.
real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of
- !! calculating the equivalent barotropic wave speed. (m)
+ !! calculating the equivalent barotropic wave speed. (Z)
!! This parameter controls the default behavior of wave_speed() which
!! can be overridden by optional arguments.
type(remapping_CS) :: remapping_CS !< Used for vertical remapping when calculating equivalent barotropic
@@ -58,7 +58,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
!! for the purposes of calculating vertical modal structure.
real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as
!! monotonic for the purposes of calculating vertical
- !! modal structure.
+ !! modal structure, in m.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
optional, intent(out) :: modal_structure !< Normalized model structure (non-dim)
@@ -66,7 +66,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
real, dimension(SZK_(G)+1) :: &
dRho_dT, dRho_dS, &
pres, T_int, S_int, &
- gprime ! The reduced gravity across each interface, in m s-2.
+ gprime ! The reduced gravity across each interface, in m2 Z-1 s-2.
real, dimension(SZK_(G)) :: &
Igl, Igu ! The inverse of the reduced gravity across an interface times
! the thickness of the layer below (Igl) or above (Igu) it,
@@ -78,15 +78,15 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
real det, ddet, detKm1, detKm2, ddetKm1, ddetKm2
real :: lam, dlam, lam0
real :: min_h_frac
- real :: H_to_pres
- real :: H_to_m ! Local copy of a unit conversion factor.
+ real :: H_to_pres ! A conversion factor from thickesses (in Z) to pressure (in Pa)
real, dimension(SZI_(G)) :: &
htot, hmin, & ! Thicknesses in m.
H_here, HxT_here, HxS_here, HxR_here
real :: speed2_tot
real :: I_Hnew, drxh_sum
+ real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths, in Z2 m-2.
real, parameter :: tol1 = 0.0001, tol2 = 0.001
- real, pointer, dimension(:,:,:) :: T, S
+ real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL()
real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1.
real :: rescale, I_rescale
integer :: kf(SZI_(G))
@@ -109,12 +109,14 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed
endif ; endif
+ L2_to_Z2 = GV%m_to_Z**2
+
l_use_ebt_mode = CS%use_ebt_mode
if (present(use_ebt_mode)) l_use_ebt_mode = use_ebt_mode
l_mono_N2_column_fraction = CS%mono_N2_column_fraction
if (present(mono_N2_column_fraction)) l_mono_N2_column_fraction = mono_N2_column_fraction
- l_mono_N2_depth = CS%mono_N2_depth
- if (present(mono_N2_depth)) l_mono_N2_depth = mono_N2_depth
+ l_mono_N2_depth = GV%m_to_Z*CS%mono_N2_depth
+ if (present(mono_N2_depth)) l_mono_N2_depth = GV%m_to_Z*mono_N2_depth
calc_modal_structure = l_use_ebt_mode
if (present(modal_structure)) calc_modal_structure = .true.
if (calc_modal_structure) then
@@ -124,18 +126,17 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
endif
S => tv%S ; T => tv%T
- g_Rho0 = GV%g_Earth/GV%Rho0
+ g_Rho0 = GV%g_Earth / GV%Rho0
use_EOS = associated(tv%eqn_of_state)
H_to_pres = GV%g_Earth * GV%Rho0
- H_to_m = GV%H_to_m
rescale = 1024.0**4 ; I_rescale = 1.0/rescale
min_h_frac = tol1 / real(nz)
!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,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 H_to_pres,H_to_m,cg1,g_Rho0,rescale,I_rescale) &
+!$OMP H_to_pres,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2) &
!$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,Tc,Sc,I_Hnew,gprime, &
@@ -148,7 +149,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
! at the top). This also transposes the row order so that columns can
! be worked upon one at a time.
do i=is,ie ; htot(i) = 0.0 ; enddo
- do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*H_to_m ; enddo ; enddo
+ do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo
do i=is,ie
hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0
@@ -156,20 +157,20 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
enddo
if (use_EOS) then
do k=1,nz ; do i=is,ie
- if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then
+ if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then
Hf(kf(i),i) = H_here(i)
Tf(kf(i),i) = HxT_here(i) / H_here(i)
Sf(kf(i),i) = HxS_here(i) / H_here(i)
kf(i) = kf(i) + 1
! Start a new layer
- H_here(i) = h(i,j,k)*H_to_m
- HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k)
- HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k)
+ H_here(i) = h(i,j,k)*GV%H_to_Z
+ HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k)
+ HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k)
else
- H_here(i) = H_here(i) + h(i,j,k)*H_to_m
- HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k)
- HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k)
+ H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z
+ HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k)
+ HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k)
endif
enddo ; enddo
do i=is,ie ; if (H_here(i) > 0.0) then
@@ -179,16 +180,16 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
endif ; enddo
else
do k=1,nz ; do i=is,ie
- if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then
+ if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then
Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i)
kf(i) = kf(i) + 1
! Start a new layer
- H_here(i) = h(i,j,k)*H_to_m
- HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k)
+ H_here(i) = h(i,j,k)*GV%H_to_Z
+ HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k)
else
- H_here(i) = H_here(i) + h(i,j,k)*H_to_m
- HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k)
+ H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z
+ HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k)
endif
enddo ; enddo
do i=is,ie ; if (H_here(i) > 0.0) then
@@ -312,26 +313,29 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
speed2_tot = 0.0
if (l_use_ebt_mode) then
Igu(1) = 0. ! Neumann condition for pressure modes
- sum_hc = Hc(1)*GV%H_to_m
- N2min = gprime(2)/Hc(1)
+ sum_hc = Hc(1)*GV%H_to_m !### I believe this conversion factor to be wrong. -RWH
+ N2min = L2_to_Z2*gprime(2)/Hc(1)
do k=2,kc
hw = 0.5*(Hc(k-1)+Hc(k))
gp = gprime(K)
if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then
- if (G%bathyT(i,j)-sum_hcN2min*hw) then
+ if (G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%bathyT(i,j) .and. &
+ L2_to_Z2*gp > N2min*hw) then
! Filters out regions where N2 increases with depth but only in a lower fraction of water column
- gp = N2min/hw
- elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. gp>N2min*hw) then
+ gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH
+ !### This should be gp = GV%Z_to_m**2* (N2min*hw)
+ elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. L2_to_Z2*gp>N2min*hw) then
! Filters out regions where N2 increases with depth but only below a certain depth
- gp = N2min/hw
+ gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH
+ !### This should be gp = GV%Z_to_m**2* (N2min*hw)
else
- N2min = gp/hw
+ N2min = L2_to_Z2 * gp/hw
endif
endif
Igu(k) = 1.0/(gp*Hc(k))
Igl(k-1) = 1.0/(gp*Hc(k-1))
speed2_tot = speed2_tot + gprime(k)*(Hc(k-1)+Hc(k))*0.707
- sum_hc = sum_hc + Hc(k)*GV%H_to_m
+ sum_hc = sum_hc + Hc(k)*GV%H_to_m !### I believe this conversion factor to be wrong. -RWH
enddo
!Igl(kc) = 0. ! Neumann condition for pressure modes
Igl(kc) = 2.*Igu(kc) ! Dirichlet condition for pressure modes
@@ -448,9 +452,9 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
mode_struct(1:kc)=0.
endif
! Note that remapping_core_h requires that the same units be used
- ! for both the source and target grid thicknesses.
- call remapping_core_h(CS%remapping_CS, kc, Hc, mode_struct, &
- nz, GV%H_to_m*h(i,j,:), modal_structure(i,j,:))
+ ! for both the source and target grid thicknesses, here in H.
+ call remapping_core_h(CS%remapping_CS, kc, GV%Z_to_H*Hc(:), mode_struct, &
+ nz, h(i,j,:), modal_structure(i,j,:), 1.0e-30*GV%m_to_H, 1.0e-10*GV%m_to_H)
endif
else
cg1(i,j) = 0.0
@@ -505,7 +509,7 @@ subroutine tdma6(n, a, b, c, lam, y)
do k = n-1, 1, -1
y(k) = ( yy(k) - c(k) * y(k+1) ) * beta(k)
enddo
-end subroutine
+end subroutine tdma6
!> Calculates the wave speeds for the first few barolinic modes.
subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos)
@@ -555,7 +559,7 @@ subroutine wave_speeds(h, tv, G, GV, 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 :: H_to_pres
+ real :: H_to_pres ! A conversion factor from thickesses (in Z) to pressure (in Pa)
real :: H_to_m ! Local copy of a unit conversion factor.
real, dimension(SZI_(G)) :: &
htot, hmin, & ! Thicknesses in m.
@@ -566,7 +570,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos)
! factor used in setting speed2_min
real :: I_Hnew, drxh_sum
real, parameter :: tol1 = 0.0001, tol2 = 0.001
- real, pointer, dimension(:,:,:) :: T, S
+ real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL()
real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1.
integer :: kf(SZI_(G))
integer, parameter :: max_itt = 10
@@ -595,7 +599,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos)
endif ; endif
S => tv%S ; T => tv%T
- g_Rho0 = GV%g_Earth/GV%Rho0
+ g_Rho0 = GV%g_Earth / GV%Rho0
use_EOS = associated(tv%eqn_of_state)
H_to_pres = GV%g_Earth * GV%Rho0
@@ -619,7 +623,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos)
! at the top). This also transposes the row order so that columns can
! be worked upon one at a time.
do i=is,ie ; htot(i) = 0.0 ; enddo
- do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*H_to_m ; enddo ; enddo
+ do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo
do i=is,ie
hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0
@@ -627,20 +631,20 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos)
enddo
if (use_EOS) then
do k=1,nz ; do i=is,ie
- if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then
+ if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then
Hf(kf(i),i) = H_here(i)
Tf(kf(i),i) = HxT_here(i) / H_here(i)
Sf(kf(i),i) = HxS_here(i) / H_here(i)
kf(i) = kf(i) + 1
! Start a new layer
- H_here(i) = h(i,j,k)*H_to_m
- HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k)
- HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k)
+ H_here(i) = h(i,j,k)*GV%H_to_Z
+ HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k)
+ HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k)
else
- H_here(i) = H_here(i) + h(i,j,k)*H_to_m
- HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k)
- HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k)
+ H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z
+ HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k)
+ HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k)
endif
enddo ; enddo
do i=is,ie ; if (H_here(i) > 0.0) then
@@ -650,16 +654,16 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos)
endif ; enddo
else
do k=1,nz ; do i=is,ie
- if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then
+ if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then
Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i)
kf(i) = kf(i) + 1
! Start a new layer
- H_here(i) = h(i,j,k)*H_to_m
- HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k)
+ H_here(i) = h(i,j,k)*GV%H_to_Z
+ HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k)
else
- H_here(i) = H_here(i) + h(i,j,k)*H_to_m
- HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k)
+ H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z
+ HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k)
endif
enddo ; enddo
do i=is,ie ; if (H_here(i) > 0.0) then
@@ -786,7 +790,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos)
do K=2,kc
Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1))
z_int(K) = z_int(K-1) + Hc(k-1)
- N2(K) = gprime(K)/(0.5*(Hc(k)+Hc(k-1)))
+ N2(K) = GV%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1)))
speed2_tot = speed2_tot + gprime(K)*(Hc(k-1)+Hc(k))
enddo
! Set stratification for surface and bottom (setting equal to nearest interface for now)
@@ -794,11 +798,8 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos)
! Calcualte depth at bottom
z_int(kc+1) = z_int(kc)+Hc(kc)
! check that thicknesses sum to total depth
- if (abs(z_int(kc+1)-htot(i)) > 1.e-10) then
- call MOM_error(WARNING, "wave_structure: mismatch in total depths")
- print *, "kc=", kc
- print *, "z_int(kc+1)=", z_int(kc+1)
- print *, "htot(i)=", htot(i)
+ if (abs(z_int(kc+1)-htot(i)) > 1.e-12*htot(i)) then
+ call MOM_error(FATAL, "wave_structure: mismatch in total depths")
endif
! Define the diagonals of the tridiagonal matrix
@@ -954,19 +955,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos)
call MOM_error(WARNING, "wave_speed: root not found "// &
" after sub_it_max subdivisions of original"// &
" interval.")
- !if (ig == 144 .and. jg == 5) then
- !print *, "xbl=",xbl
- !print *, "xbr=",xbr
- !print *, "Wave_speed: kc=",kc
- !print *, 'Wave_speed: z_int(ig,jg)=', z_int(1:kc+1)
- !print *, 'Wave_speed: N2(ig,jg)=', N2(1:kc+1)
- !print *, 'Wave_speed: gprime=', gprime(1:kc+1)
- !print *, 'Wave_speed: htot=', htot(i)
- !print *, 'Wave_speed: cn1=', cn(i,j,1)
- !print *, 'Wave_speed: numint=', numint
- !print *, 'Wave_speed: nrootsfound=', nrootsfound
- !stop
- !endif
endif ! sub_it == sub_it_max
enddo ! sub_it-loop-------------------------------------------------
endif ! det_l*ddet_l < 0.0
@@ -979,20 +967,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos)
! oops, lamMax not large enough - could add code to increase (BDM)
! set unfound modes to zero for now (BDM)
cn(i,j,nrootsfound+2:nmodes) = 0.0
- !if (ig == 83 .and. jg == 2) then
- ! call MOM_error(WARNING, "wave_speed: not all modes found "// &
- ! " within search range: increase numint.")
- ! print *, "Increase lamMax at ig=",ig," jg=",jg
- ! print *, "where lamMax=", lamMax
- ! print *, 'numint=', numint
- ! print *, "nrootsfound=", nrootsfound
- ! print *, "xbl=",xbl
- ! print *, "xbr=",xbr
- !print *, "kc=",kc
- !print *, 'z_int(ig,jg)=', z_int(1:kc+1)
- !print *, 'N2(ig,jg)=', N2(1:kc+1)
- !stop
- !endif
else
! else shift interval and keep looking until nmodes or numint is reached
det_l = det_r
@@ -1132,9 +1106,9 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_
if (.not.associated(CS)) call MOM_error(FATAL, &
"wave_speed_set_param called with an associated control structure.")
- if (present(use_ebt_mode)) CS%use_ebt_mode=use_ebt_mode
- if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction=mono_N2_column_fraction
- if (present(mono_N2_depth)) CS%mono_N2_depth=mono_N2_depth
+ if (present(use_ebt_mode)) CS%use_ebt_mode = use_ebt_mode
+ if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction = mono_N2_column_fraction
+ if (present(mono_N2_depth)) CS%mono_N2_depth = mono_N2_depth
end subroutine wave_speed_set_param
diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90
index b0a889b722..735690eb81 100644
--- a/src/diagnostics/MOM_wave_structure.F90
+++ b/src/diagnostics/MOM_wave_structure.F90
@@ -1,31 +1,14 @@
+!> Vertical structure functions for first baroclinic mode wave speed
module MOM_wave_structure
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Benjamin Mater & Robert Hallberg, 2015 *
-!* *
-!* The subroutine in this module calculates the vertical structure *
-!* functions of the first baroclinic mode internal wave speed. *
-!* Calculation of interface values is the same as done in *
-!* MOM_wave_speed by Hallberg, 2008. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v, vh, vav *
-!* j x ^ x ^ x At >: u, uh, uav *
-!* j > o > o > At o: h *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
+! By Benjamin Mater & Robert Hallberg, 2015
+
+! The subroutine in this module calculates the vertical structure
+! functions of the first baroclinic mode internal wave speed.
+! Calculation of interface values is the same as done in
+! MOM_wave_speed by Hallberg, 2008.
use MOM_debugging, only : isnan => is_NaN
use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl
@@ -43,36 +26,62 @@ module MOM_wave_structure
public wave_structure, wave_structure_init
+!> The control structure for the MOM_wave_structure module
type, public :: wave_structure_CS ; !private
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
real, allocatable, dimension(:,:,:) :: w_strct
- ! Vertical structure of vertical velocity (normalized), in m s-1.
+ !< Vertical structure of vertical velocity (normalized), in m s-1.
real, allocatable, dimension(:,:,:) :: u_strct
- ! Vertical structure of horizontal velocity (normalized), in m s-1.
+ !< Vertical structure of horizontal velocity (normalized), in m s-1.
real, allocatable, dimension(:,:,:) :: W_profile
- ! Vertical profile of w_hat(z), where
- ! w(x,y,z,t) = w_hat(z)*exp(i(kx+ly-freq*t)) is the full time-
- ! varying vertical velocity with w_hat(z) = W0*w_strct(z), in m s-1.
+ !< Vertical profile of w_hat(z), where
+ !! w(x,y,z,t) = w_hat(z)*exp(i(kx+ly-freq*t)) is the full time-
+ !! varying vertical velocity with w_hat(z) = W0*w_strct(z), in m s-1.
real, allocatable, dimension(:,:,:) :: Uavg_profile
- ! Vertical profile of the magnitude of horizontal velocity,
- ! (u^2+v^2)^0.5, averaged over a period, in m s-1.
+ !< Vertical profile of the magnitude of horizontal velocity,
+ !! (u^2+v^2)^0.5, averaged over a period, in m s-1.
real, allocatable, dimension(:,:,:) :: z_depths
- ! Depths of layer interfaces, in m.
+ !< Depths of layer interfaces, in m.
real, allocatable, dimension(:,:,:) :: N2
- ! Squared buoyancy frequency at each interface
+ !< Squared buoyancy frequency at each interface, in S-2.
integer, allocatable, dimension(:,:):: num_intfaces
- ! Number of layer interfaces (including surface and bottom)
- real :: int_tide_source_x ! X Location of generation site
- ! for internal tide for testing (BDM)
- real :: int_tide_source_y ! Y Location of generation site
- ! for internal tide for testing (BDM)
+ !< Number of layer interfaces (including surface and bottom)
+ real :: int_tide_source_x !< X Location of generation site
+ !! for internal tide for testing (BDM)
+ real :: int_tide_source_y !< Y Location of generation site
+ !! for internal tide for testing (BDM)
end type wave_structure_CS
contains
!> This subroutine determines the internal wave velocity structure for any mode.
+!!
+!! This subroutine solves for the eigen vector [vertical structure, e(k)] associated with
+!! the first baroclinic mode speed [i.e., smallest eigen value (lam = 1/c^2)] of the
+!! system d2e/dz2 = -(N2/cn2)e, or (A-lam*I)e = 0, where A = -(1/N2)(d2/dz2), lam = 1/c^2,
+!! and I is the identity matrix. 2nd order discretization in the vertical lets this system
+!! be represented as
+!!
+!! -Igu(k)*e(k-1) + (Igu(k)+Igl(k)-lam)*e(k) - Igl(k)*e(k+1) = 0.0
+!!
+!! with rigid lid boundary conditions e(1) = e(nz+1) = 0.0 giving
+!!
+!! (Igu(2)+Igl(2)-lam)*e(2) - Igl(2)*e(3) = 0.0
+!! -Igu(nz)*e(nz-1) + (Igu(nz)+Igl(nz)-lam)*e(nz) = 0.0
+!!
+!! where, upon noting N2 = reduced gravity/layer thickness, we get
+!! Igl(k) = 1.0/(gprime(k)*H(k)) ; Igu(k) = 1.0/(gprime(k)*H(k-1))
+!!
+!! The eigen value for this system is approximated using "wave_speed." This subroutine uses
+!! these eigen values (mode speeds) to estimate the corresponding eigen vectors (velocity
+!! structure) using the "inverse iteration with shift" method. The algorithm is
+!!
+!! Pick a starting vector reasonably close to mode structure and with unit magnitude, b_guess
+!! For n=1,2,3,...
+!! Solve (A-lam*I)e = e_guess for e
+!! Set e_guess=e/|e| and repeat, with each iteration refining the estimate of e
subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid
@@ -95,50 +104,11 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
logical,optional, intent(in) :: full_halos !< If true, do the calculation
!! over the entire computational
!! domain.
-
-! This subroutine determines the internal wave velocity structure for any mode.
-! Arguments: h - Layer thickness, in m or kg m-2.
-! (in) tv - A structure containing the thermobaric variables.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) cn - The (non-rotational) mode internal gravity wave speed, in m s-1.
-! (in) ModeNum - mode number
-! (in) freq - intrinsic wave frequency, in s-1
-! (in) CS - The control structure returned by a previous call to
-! wave_structure_init.
-! (in,opt) En - Internal wave energy density, in Jm-2
-! (in,opt) full_halos - If true, do the calculation over the entire
-! computational domain.
-!
-! This subroutine solves for the eigen vector [vertical structure, e(k)] associated with
-! the first baroclinic mode speed [i.e., smallest eigen value (lam = 1/c^2)] of the
-! system d2e/dz2 = -(N2/cn2)e, or (A-lam*I)e = 0, where A = -(1/N2)(d2/dz2), lam = 1/c^2,
-! and I is the identity matrix. 2nd order discretization in the vertical lets this system
-! be represented as
-!
-! -Igu(k)*e(k-1) + (Igu(k)+Igl(k)-lam)*e(k) - Igl(k)*e(k+1) = 0.0
-!
-! with rigid lid boundary conditions e(1) = e(nz+1) = 0.0 giving
-!
-! (Igu(2)+Igl(2)-lam)*e(2) - Igl(2)*e(3) = 0.0
-! -Igu(nz)*e(nz-1) + (Igu(nz)+Igl(nz)-lam)*e(nz) = 0.0
-!
-! where, upon noting N2 = reduced gravity/layer thickness, we get
-! Igl(k) = 1.0/(gprime(k)*H(k)) ; Igu(k) = 1.0/(gprime(k)*H(k-1))
-!
-! The eigen value for this system is approximated using "wave_speed." This subroutine uses
-! these eigen values (mode speeds) to estimate the corresponding eigen vectors (velocity
-! structure) using the "inverse iteration with shift" method. The algorithm is
-!
-! Pick a starting vector reasonably close to mode structure and with unit magnitude, b_guess
-! For n=1,2,3,...
-! Solve (A-lam*I)e = e_guess for e
-! Set e_guess=e/|e| and repeat, with each iteration refining the estimate of e
-
+ ! Local variables
real, dimension(SZK_(G)+1) :: &
dRho_dT, dRho_dS, &
pres, T_int, S_int, &
- gprime ! The reduced gravity across each interface, in m s-2.
+ gprime ! The reduced gravity across each interface, in m2 Z-1 s-2.
real, dimension(SZK_(G)) :: &
Igl, Igu ! The inverse of the reduced gravity across an interface times
! the thickness of the layer below (Igl) or above (Igu) it,
@@ -153,15 +123,14 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
real :: lam
real :: min_h_frac
real :: H_to_pres
- real :: H_to_m ! Local copy of a unit conversion factor.
real, dimension(SZI_(G)) :: &
- hmin, & ! Thicknesses in m.
+ hmin, & ! Thicknesses in Z.
H_here, HxT_here, HxS_here, HxR_here
real :: speed2_tot
real :: I_Hnew, drxh_sum
real, parameter :: tol1 = 0.0001, tol2 = 0.001
- real, pointer, dimension(:,:,:) :: T, S
- real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1.
+ real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL()
+ real :: g_Rho0 ! G_Earth/Rho0 in m5 Z-1 s-2 kg-1.
real :: rescale, I_rescale
integer :: kf(SZI_(G))
integer, parameter :: max_itt = 1 ! number of times to iterate in solving for eigenvector
@@ -182,6 +151,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
real :: w2avg ! average of squared vertical velocity structure funtion
real :: int_dwdz2, int_w2, int_N2w2, KE_term, PE_term, W0
! terms in vertically averaged energy equation
+ real :: gp_unscaled ! A version of gprime rescaled to units of m s-2.
real, dimension(SZK_(G)-1) :: lam_z ! product of eigen value and gprime(k); one value for each
! interface (excluding surface and bottom)
real, dimension(SZK_(G)-1) :: a_diag, b_diag, c_diag
@@ -208,11 +178,10 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
Pi = (4.0*atan(1.0))
S => tv%S ; T => tv%T
- g_Rho0 = GV%g_Earth/GV%Rho0
+ g_Rho0 = GV%g_Earth /GV%Rho0
use_EOS = associated(tv%eqn_of_state)
H_to_pres = GV%g_Earth * GV%Rho0
- H_to_m = GV%H_to_m
rescale = 1024.0**4 ; I_rescale = 1.0/rescale
min_h_frac = tol1 / real(nz)
@@ -222,7 +191,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
! at the top). This also transposes the row order so that columns can
! be worked upon one at a time.
do i=is,ie ; htot(i,j) = 0.0 ; enddo
- do k=1,nz ; do i=is,ie ; htot(i,j) = htot(i,j) + h(i,j,k)*H_to_m ; enddo ; enddo
+ do k=1,nz ; do i=is,ie ; htot(i,j) = htot(i,j) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo
do i=is,ie
hmin(i) = htot(i,j)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0
@@ -230,20 +199,20 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
enddo
if (use_EOS) then
do k=1,nz ; do i=is,ie
- if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then
+ if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then
Hf(kf(i),i) = H_here(i)
Tf(kf(i),i) = HxT_here(i) / H_here(i)
Sf(kf(i),i) = HxS_here(i) / H_here(i)
kf(i) = kf(i) + 1
! Start a new layer
- H_here(i) = h(i,j,k)*H_to_m
- HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k)
- HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k)
+ H_here(i) = h(i,j,k)*GV%H_to_Z
+ HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k)
+ HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k)
else
- H_here(i) = H_here(i) + h(i,j,k)*H_to_m
- HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k)
- HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k)
+ H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z
+ HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k)
+ HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k)
endif
enddo ; enddo
do i=is,ie ; if (H_here(i) > 0.0) then
@@ -253,16 +222,16 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
endif ; enddo
else
do k=1,nz ; do i=is,ie
- if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then
+ if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then
Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i)
kf(i) = kf(i) + 1
! Start a new layer
- H_here(i) = h(i,j,k)*H_to_m
- HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k)
+ H_here(i) = h(i,j,k)*GV%H_to_Z
+ HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k)
else
- H_here(i) = H_here(i) + h(i,j,k)*H_to_m
- HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k)
+ H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z
+ HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k)
endif
enddo ; enddo
do i=is,ie ; if (H_here(i) > 0.0) then
@@ -398,20 +367,20 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
do K=2,kc
Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1))
z_int(K) = z_int(K-1) + Hc(k-1)
- N2(K) = gprime(K)/(0.5*(Hc(k)+Hc(k-1)))
+ N2(K) = GV%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1)))
enddo
! Set stratification for surface and bottom (setting equal to nearest interface for now)
N2(1) = N2(2) ; N2(kc+1) = N2(kc)
! Calcualte depth at bottom
z_int(kc+1) = z_int(kc)+Hc(kc)
! check that thicknesses sum to total depth
- if (abs(z_int(kc+1)-htot(i,j)) > 1.e-10) then
- call MOM_error(WARNING, "wave_structure: mismatch in total depths")
- print *, "kc=", kc
- print *, "z_int(kc+1)=", z_int(kc+1)
- print *, "htot(i,j)=", htot(i,j)
+ if (abs(z_int(kc+1)-htot(i,j)) > 1.e-14*htot(i,j)) then
+ call MOM_error(FATAL, "wave_structure: mismatch in total depths")
endif
+ ! Note that many of the calcluation from here on revert to using vertical
+ ! distances in m, not Z.
+
! Populate interior rows of tridiagonal matrix; must multiply through by
! gprime to get tridiagonal matrix to the symmetrical form:
! [-1/H(k-1)]e(k-1) + [1/H(k-1)+1/H(k)-lam_z]e(k) + [-1/H(k)]e(k+1) = 0,
@@ -419,30 +388,33 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
! Frist, populate interior rows
do K=3,kc-1
row = K-1 ! indexing for TD matrix rows
- lam_z(row) = lam*gprime(K)
- a_diag(row) = gprime(K)*(-Igu(K))
- b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row)
- c_diag(row) = gprime(K)*(-Igl(K))
+ gp_unscaled = GV%m_to_Z*gprime(K)
+ lam_z(row) = lam*gp_unscaled
+ a_diag(row) = gp_unscaled*(-Igu(K))
+ b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row)
+ c_diag(row) = gp_unscaled*(-Igl(K))
if (isnan(lam_z(row)))then ; print *, "Wave_structure: lam_z(row) is NAN" ; endif
if (isnan(a_diag(row)))then ; print *, "Wave_structure: a(k) is NAN" ; endif
if (isnan(b_diag(row)))then ; print *, "Wave_structure: b(k) is NAN" ; endif
if (isnan(c_diag(row)))then ; print *, "Wave_structure: c(k) is NAN" ; endif
enddo
! Populate top row of tridiagonal matrix
- K=2 ; row = K-1
- lam_z(row) = lam*gprime(K)
+ K=2 ; row = K-1 ;
+ gp_unscaled = GV%m_to_Z*gprime(K)
+ lam_z(row) = lam*gp_unscaled
a_diag(row) = 0.0
- b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row)
- c_diag(row) = gprime(K)*(-Igl(K))
+ b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row)
+ c_diag(row) = gp_unscaled*(-Igl(K))
! Populate bottom row of tridiagonal matrix
K=kc ; row = K-1
- lam_z(row) = lam*gprime(K)
- a_diag(row) = gprime(K)*(-Igu(K))
- b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row)
+ gp_unscaled = GV%m_to_Z*gprime(K)
+ lam_z(row) = lam*gp_unscaled
+ a_diag(row) = gp_unscaled*(-Igu(K))
+ b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row)
c_diag(row) = 0.0
! Guess a vector shape to start with (excludes surface and bottom)
- e_guess(1:kc-1) = sin(z_int(2:kc)/htot(i,j)*Pi)
+ e_guess(1:kc-1) = sin((z_int(2:kc)/htot(i,j)) *Pi)
e_guess(1:kc-1) = e_guess(1:kc-1)/sqrt(sum(e_guess(1:kc-1)**2))
! Perform inverse iteration with tri-diag solver
@@ -471,11 +443,12 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
!(including surface and bottom)
w2avg = 0.0
do k=1,nzm-1
- dz(k) = Hc(k)
+ dz(k) = GV%Z_to_m*Hc(k)
w2avg = w2avg + 0.5*(w_strct(K)**2+w_strct(K+1)**2)*dz(k)
enddo
- w2avg = w2avg/htot(i,j)
- w_strct = w_strct/sqrt(htot(i,j)*w2avg*I_a_int)
+ !### Some mathematical cancellations could occur in the next two lines.
+ w2avg = w2avg / htot(i,j)
+ w_strct = w_strct / sqrt(htot(i,j)*w2avg*I_a_int)
! Calculate vertical structure function of u (i.e. dw/dz)
do K=2,nzm-1
@@ -525,45 +498,13 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
endif
! Store values in control structure
- CS%w_strct(i,j,1:nzm) = w_strct
- CS%u_strct(i,j,1:nzm) = u_strct
- CS%W_profile(i,j,1:nzm) = W_profile
- CS%Uavg_profile(i,j,1:nzm)= Uavg_profile
- CS%z_depths(i,j,1:nzm) = z_int
- CS%N2(i,j,1:nzm) = N2
+ CS%w_strct(i,j,1:nzm) = w_strct(:)
+ CS%u_strct(i,j,1:nzm) = u_strct(:)
+ CS%W_profile(i,j,1:nzm) = W_profile(:)
+ CS%Uavg_profile(i,j,1:nzm)= Uavg_profile(:)
+ CS%z_depths(i,j,1:nzm) = GV%Z_to_m*z_int(:)
+ CS%N2(i,j,1:nzm) = N2(:)
CS%num_intfaces(i,j) = nzm
-
- !----for debugging; delete later----
- !if (ig == ig_stop .and. jg == jg_stop) then
- !print *, 'cn(ig,jg)=', cn(i,j)
- !print *, "e_guess=", e_guess(1:kc-1)
- !print *, "|e_guess|=", sqrt(sum(e_guess(1:kc-1)**2))
- !print *, 'f0=', sqrt(f2)
- !print *, 'freq=', freq
- !print *, 'Kh=', sqrt(Kmag2)
- !print *, 'Wave_structure: z_int(ig,jg)=', z_int(1:nzm)
- !print *, 'Wave_structure: N2(ig,jg)=', N2(1:nzm)
- !print *, 'gprime=', gprime(1:nzm)
- !print *, '1/Hc=', 1/Hc
- !print *, 'Wave_structure: a_diag(ig,jg)=', a_diag(1:kc-1)
- !print *, 'Wave_structure: b_diag(ig,jg)=', b_diag(1:kc-1)
- !print *, 'Wave_structure: c_diag(ig,jg)=', c_diag(1:kc-1)
- !print *, 'Wave_structure: lam_z(ig,jg)=', lam_z(1:kc-1)
- !print *, 'Wave_structure: w_strct(ig,jg)=', w_strct(1:nzm)
- !print *, 'En(i,j)=', En(i,j)
- !print *, 'Wave_structure: W_profile(ig,jg)=', W_profile(1:nzm)
- !print *,'int_dwdz2 =',int_dwdz2
- !print *,'int_w2 =',int_w2
- !print *,'int_N2w2 =',int_N2w2
- !print *,'KEterm=',KE_term
- !print *,'PEterm=',PE_term
- !print *, 'W0=',W0
- !print *,'Uavg_profile=',Uavg_profile(1:nzm)
- !open(unit=1,file='out_N2',form='formatted') ; write(1,*) N2 ; close(1)
- !open(unit=2,file='out_z',form='formatted') ; write(2,*) z_int ; close(2)
- !endif
- !-----------------------------------
-
else
! If not enough layers, default to zero
nzm = kc+1
@@ -595,8 +536,8 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos)
end subroutine wave_structure
-!> This subroutine solves a tri-diagonal system Ax=y using either the standard
-!! Thomas algorithim (TDMA_T) or its more stable variant that invokes the
+!> Solves a tri-diagonal system Ax=y using either the standard
+!! Thomas algorithm (TDMA_T) or its more stable variant that invokes the
!! "Hallberg substitution" (TDMA_H).
subroutine tridiag_solver(a, b, c, h, y, method, x)
real, dimension(:), intent(in) :: a !< lower diagonal with first entry equal to zero.
@@ -612,28 +553,10 @@ subroutine tridiag_solver(a, b, c, h, y, method, x)
real, dimension(:), intent(in) :: y !< vector of known values on right hand side.
character(len=*), intent(in) :: method !< A string describing the algorithm to use
real, dimension(:), intent(out) :: x !< vector of unknown values to solve for.
-
-! This subroutine solves a tri-diagonal system Ax=y using either the standard
-! Thomas algorithim (TDMA_T) or its more stable variant that invokes the
-! "Hallberg substitution" (TDMA_H).
-!
-! Arguments:
-! (in) a - lower diagonal with first entry equal to zero
-! (in) b - middle diagonal
-! (in) c - upper diagonal with last entry equal to zero
-! (in) h - vector of values that have already been added to b; used for
-! systems of the form (e.g. average layer thickness in vertical diffusion case):
-! [ -alpha(k-1/2) ] * e(k-1) +
-! [ alpha(k-1/2) + alpha(k+1/2) + h(k) ] * e(k) +
-! [ -alpha(k+1/2) ] * e(k+1) = y(k)
-! where a(k)=[-alpha(k-1/2)], b(k)=[alpha(k-1/2)+alpha(k+1/2) + h(k)],
-! and c(k)=[-alpha(k+1/2)]. Only used with TDMA_H method.
-! (in) y - vector of known values on right hand side
-! (out) x - vector of unknown values to solve for
-
+ ! Local variables
integer :: nrow ! number of rows in A matrix
- real, allocatable, dimension(:,:) :: A_check ! for solution checking
- real, allocatable, dimension(:) :: y_check ! for solution checking
+! real, allocatable, dimension(:,:) :: A_check ! for solution checking
+! real, allocatable, dimension(:) :: y_check ! for solution checking
real, allocatable, dimension(:) :: c_prime, y_prime, q, alpha
! intermediate values for solvers
real :: Q_prime, beta ! intermediate values for solver
@@ -645,8 +568,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x)
allocate(y_prime(nrow))
allocate(q(nrow))
allocate(alpha(nrow))
- allocate(A_check(nrow,nrow))
- allocate(y_check(nrow))
+! allocate(A_check(nrow,nrow))
+! allocate(y_check(nrow))
if (method == 'TDMA_T') then
! Standard Thomas algoritim (4th variant).
@@ -696,7 +619,7 @@ subroutine tridiag_solver(a, b, c, h, y, method, x)
! symmetric, diagonally dominant matrix, with h>0.
! Need to add a check for these conditions.
do k=1,nrow-1
- if (abs(a(k+1)-c(k)) > 1.e-10) then
+ if (abs(a(k+1)-c(k)) > 1.e-10*(abs(a(k+1))+abs(c(k)))) then
call MOM_error(WARNING, "tridiag_solver: matrix not symmetric; need symmetry when invoking TDMA_H")
endif
enddo
@@ -719,8 +642,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x)
Q_prime = beta*(h(k)+alpha(k-1)*Q_prime)
enddo
if ((h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) == 0.0)then
- call MOM_error(WARNING, "Tridiag_solver: this system is not stable; overriding beta(nrow).")
- beta = 1/(1e-15) ! place holder for unstable systems - delete later
+ call MOM_error(FATAL, "Tridiag_solver: this system is not stable.") ! ; overriding beta(nrow)
+ ! This has hard-coded dimensions: beta = 1/(1e-15) ! place holder for unstable systems - delete later
else
beta = 1/(h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow))
endif
@@ -734,27 +657,21 @@ subroutine tridiag_solver(a, b, c, h, y, method, x)
!print *, 'x=',x(1:nrow)
endif
- deallocate(c_prime,y_prime,q,alpha,A_check,y_check)
+ deallocate(c_prime,y_prime,q,alpha)
+! deallocate(A_check,y_check)
end subroutine tridiag_solver
-
+!> Allocate memory associated with the wave structure module and read parameters.
subroutine wave_structure_init(Time, G, param_file, diag, CS)
- type(time_type), intent(in) :: Time !< The current model time.
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
- !! parameters.
- type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate
- !! diagnostic output.
- type(wave_structure_CS), pointer :: CS !< A pointer that is set to point to the
- !! control structure for this module.
-! Arguments: Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
+ type(time_type), intent(in) :: Time !< The current model time.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
+ !! parameters.
+ type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate
+ !! diagnostic output.
+ type(wave_structure_CS), pointer :: CS !< A pointer that is set to point to the
+ !! control structure for this module.
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "MOM_wave_structure" ! This module's name.
@@ -790,5 +707,4 @@ subroutine wave_structure_init(Time, G, param_file, diag, CS)
end subroutine wave_structure_init
-
end module MOM_wave_structure
diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90
index 2df645c338..9a823d23eb 100644
--- a/src/equation_of_state/MOM_EOS.F90
+++ b/src/equation_of_state/MOM_EOS.F90
@@ -61,10 +61,13 @@ module MOM_EOS
module procedure calculate_spec_vol_scalar, calculate_spec_vol_array
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
end interface calculate_density_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
module procedure calculate_density_second_derivs_scalar, calculate_density_second_derivs_array
end interface calculate_density_second_derivs
@@ -81,42 +84,42 @@ module MOM_EOS
!! of the freezing point.
logical :: EOS_quadrature !< If true, always use the generic (quadrature)
!! code for the integrals of density.
- logical :: Compressible = .true. !< If true, in situ density is a function
- !! of pressure.
+ 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, in kg m-3.
- real :: dRho_dT !< The partial derivatives of density with temperature
- real :: dRho_dS !< and salinity, in kg m-3 K-1 and kg m-3 psu-1.
+ real :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3.
+ real :: dRho_dT !< The partial derivatives of density with temperature
+ real :: dRho_dS !< and salinity, in kg m-3 K-1 and kg m-3 psu-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 in deg C.
- real :: dTFr_dS !< The derivative of freezing point with salinity, in deg C PSU-1.
- real :: dTFr_dp !< The derivative of freezing point with pressure, in deg C Pa-1.
+ real :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 in deg C.
+ real :: dTFr_dS !< The derivative of freezing point with salinity, in deg C PSU-1.
+ real :: dTFr_dp !< The derivative of freezing point with pressure, in deg C Pa-1.
- logical :: test_EOS = .true.
+! logical :: test_EOS = .true. ! If true, test the equation of state
end type EOS_type
! The named integers that might be stored in eqn_of_state_type%form_of_EOS.
-integer, parameter, public :: EOS_LINEAR = 1
-integer, parameter, public :: EOS_UNESCO = 2
-integer, parameter, public :: EOS_WRIGHT = 3
-integer, parameter, public :: EOS_TEOS10 = 4
-integer, parameter, public :: EOS_NEMO = 5
-
-character*(10), parameter :: EOS_LINEAR_STRING = "LINEAR"
-character*(10), parameter :: EOS_UNESCO_STRING = "UNESCO"
-character*(10), parameter :: EOS_WRIGHT_STRING = "WRIGHT"
-character*(10), parameter :: EOS_TEOS10_STRING = "TEOS10"
-character*(10), parameter :: EOS_NEMO_STRING = "NEMO"
-character*(10), parameter :: EOS_DEFAULT = EOS_WRIGHT_STRING
-
-integer, parameter :: TFREEZE_LINEAR = 1
-integer, parameter :: TFREEZE_MILLERO = 2
-integer, parameter :: TFREEZE_TEOS10 = 3
-character*(10), parameter :: TFREEZE_LINEAR_STRING = "LINEAR"
-character*(10), parameter :: TFREEZE_MILLERO_STRING = "MILLERO_78"
-character*(10), parameter :: TFREEZE_TEOS10_STRING = "TEOS10"
-character*(10), parameter :: TFREEZE_DEFAULT = TFREEZE_LINEAR_STRING
+integer, parameter, public :: EOS_LINEAR = 1 !< A named integer specifying an equation of state
+integer, parameter, public :: EOS_UNESCO = 2 !< A named integer specifying an equation of state
+integer, parameter, public :: EOS_WRIGHT = 3 !< A named integer specifying an equation of state
+integer, parameter, public :: EOS_TEOS10 = 4 !< A named integer specifying an equation of state
+integer, parameter, public :: EOS_NEMO = 5 !< A named integer specifying an equation of state
+
+character*(10), parameter :: EOS_LINEAR_STRING = "LINEAR" !< A string for specifying the equation of state
+character*(10), parameter :: EOS_UNESCO_STRING = "UNESCO" !< A string for specifying the equation of state
+character*(10), parameter :: EOS_WRIGHT_STRING = "WRIGHT" !< A string for specifying the equation of state
+character*(10), parameter :: EOS_TEOS10_STRING = "TEOS10" !< A string for specifying the equation of state
+character*(10), parameter :: EOS_NEMO_STRING = "NEMO" !< A string for specifying the equation of state
+character*(10), parameter :: EOS_DEFAULT = EOS_WRIGHT_STRING !< The default equation of state
+
+integer, parameter :: TFREEZE_LINEAR = 1 !< A named integer specifying a freezing point expression
+integer, parameter :: TFREEZE_MILLERO = 2 !< A named integer specifying a freezing point expression
+integer, parameter :: TFREEZE_TEOS10 = 3 !< A named integer specifying a freezing point expression
+character*(10), parameter :: TFREEZE_LINEAR_STRING = "LINEAR" !< A string for specifying the freezing point expression
+character*(10), parameter :: TFREEZE_MILLERO_STRING = "MILLERO_78" !< A string for specifying
+ !! freezing point expression
+character*(10), parameter :: TFREEZE_TEOS10_STRING = "TEOS10" !< A string for specifying the freezing point expression
+character*(10), parameter :: TFREEZE_DEFAULT = TFREEZE_LINEAR_STRING !< The default freezing point expression
contains
@@ -547,39 +550,40 @@ end subroutine calculate_compress
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)
- !> The horizontal index structure
- type(hor_index_type), intent(in) :: HI
- !> Potential temperature referenced to the surface (degC)
- real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), intent(in) :: T
- !> Salinity (PSU)
- real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), intent(in) :: S
- !> Pressure at the top of the layer in Pa.
- real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), intent(in) :: p_t
- !> Pressure at the bottom of the layer in Pa.
- real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), intent(in) :: p_b
- !> 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) :: alpha_ref
- !> Equation of state structure
- type(EOS_type), pointer :: EOS
- !> The change in the geopotential anomaly across the layer, in m2 s-2.
- real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), intent(out) :: dza
- !> The integral in pressure through the layer of the geopotential anomaly
- !! relative to the anomaly at the bottom of the layer, in Pa m2 s-2.
- real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), optional, intent(out) :: intp_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, in m2 s-2.
- real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), optional, intent(out) :: intx_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, in m2 s-2.
- real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), optional, intent(out) :: inty_dza
- !> The width of halo points on which to calculate dza.
- integer, optional, intent(in) :: halo_size
+ type(hor_index_type), intent(in) :: HI !< The horizontal index structure
real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
- optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa
+ intent(in) :: T !< Potential temperature referenced to the surface (degC)
+ 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 in Pa.
+ real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
+ intent(in) :: p_b !< Pressure at the bottom of the layer in 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.
+ type(EOS_type), pointer :: EOS !< Equation of state structure
+ real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
+ intent(out) :: dza !< The change in the geopotential anomaly across
+ !! the layer, in 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, in 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, in 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, in 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 in 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 (Pa?)
logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting
!! to interpolate T/S for top and bottom integrals.
@@ -614,45 +618,41 @@ end subroutine int_specific_vol_dp
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)
- !> Ocean horizontal index structures for the input arrays
- type(hor_index_type), intent(in) :: HII
- !> Ocean horizontal index structures for the output arrays
- type(hor_index_type), intent(in) :: HIO
- !> Potential temperature referenced to the surface (degC)
- real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), intent(in) :: T
- !> Salinity (PSU)
- real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), intent(in) :: S
- !> Height at the top of the layer in m.
- real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), intent(in) :: z_t
- !> Height at the bottom of the layer in m.
- real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), intent(in) :: z_b
- !> A mean density, in kg m-3, that is subtracted out to reduce the magnitude
- !! of each of the integrals. (The pressure is calculated as p~=-z*rho_0*G_e.)
- real, intent(in) :: rho_ref
- !> A density, in 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_0
- !> The Earth's gravitational acceleration, in m s-2.
- real, intent(in) :: G_e
- !> Equation of state structure
- type(EOS_type), pointer :: EOS
- !> The change in the pressure anomaly across the layer, in Pa.
- real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), intent(out) :: dpa
- !> The integral through the thickness of the layer of the pressure anomaly
- !! relative to the anomaly at the top of the layer, in Pa m.
- real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), optional, intent(out) :: intz_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, in Pa.
- real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), optional, intent(out) :: intx_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, in Pa.
- real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), optional, intent(out) :: 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
+ real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
+ intent(in) :: T !< Potential temperature referenced to the surface (degC)
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- optional, intent(in) :: bathyT !< The depth of the bathymetry in m
- real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the
- !! same units as z_t
+ intent(in) :: S !< Salinity (PSU)
+ 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).
+ real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
+ intent(in) :: z_b !< Height at the bottom of the layer in Z.
+ real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to
+ !! reduce the magnitude of each of the integrals.
+ real, intent(in) :: rho_0 !< A density, in 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, in m2 Z-1 s-2.
+ type(EOS_type), pointer :: EOS !< Equation of state structure
+ real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
+ intent(out) :: dpa !< The change in the pressure anomaly across the layer, in 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, in 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, in 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, in Pa.
+ real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
+ optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z.
+ real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z.
logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to
- !! interpolate T/S for top and bottom integrals.
+ !! interpolate T/S for top and bottom integrals.
if (.not.associated(EOS)) call MOM_error(FATAL, &
"int_density_dz called with an unassociated EOS_type EOS.")
@@ -792,17 +792,23 @@ end subroutine EOS_init
!> Manually initialized an EOS type (intended for unit testing of routines which need a specific EOS)
subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, &
Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp)
- type(EOS_type), pointer :: EOS
- integer, optional, intent(in ) :: form_of_EOS
- integer, optional, intent(in ) :: form_of_TFreeze
- logical, optional, intent(in ) :: EOS_quadrature
- logical, optional, intent(in ) :: Compressible
- real , optional, intent(in ) :: Rho_T0_S0
- real , optional, intent(in ) :: drho_dT
- real , optional, intent(in ) :: dRho_dS
- real , optional, intent(in ) :: TFr_S0_P0
- real , optional, intent(in ) :: dTFr_dS
- real , optional, intent(in ) :: dTFr_dp
+ type(EOS_type), pointer :: EOS !< Equation of state structure
+ integer, optional, intent(in) :: form_of_EOS !< A coded integer indicating the equation of state to use.
+ integer, optional, intent(in) :: form_of_TFreeze !< A coded integer indicating the expression for
+ !! the potential temperature of the freezing point.
+ logical, optional, intent(in) :: EOS_quadrature !< If true, always use the generic (quadrature)
+ !! code for the integrals of density.
+ logical, optional, intent(in) :: Compressible !< If true, in situ density is a function of pressure.
+ real , optional, intent(in) :: Rho_T0_S0 !< Density at T=0 degC and S=0 ppt (kg m-3)
+ real , optional, intent(in) :: drho_dT !< Partial derivative of density with temperature
+ !! 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 in deg C.
+ real , optional, intent(in) :: dTFr_dS !< The derivative of freezing point with salinity,
+ !! in deg C PSU-1.
+ real , optional, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure,
+ !! in deg C 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
@@ -840,7 +846,8 @@ subroutine EOS_use_linear(Rho_T0_S0, dRho_dT, dRho_dS, EOS, use_quadrature)
real, intent(in) :: Rho_T0_S0 !< Density at T=0 degC and S=0 ppt (kg m-3)
real, intent(in) :: dRho_dT !< Partial derivative of density with temperature (kg m-3 degC-1)
real, intent(in) :: dRho_dS !< Partial derivative of density with salinity (kg m-3 ppt-1)
- logical, optional, intent(in) :: use_quadrature !< Partial derivative of density with salinity (kg m-3 ppt-1)
+ logical, optional, intent(in) :: use_quadrature !< If true, always use the generic (quadrature)
+ !! code for the integrals of density.
type(EOS_type), pointer :: EOS !< Equation of state structure
if (.not.associated(EOS)) call MOM_error(FATAL, &
@@ -869,16 +876,16 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO,
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
intent(in) :: S !< Salinity of the layer in PSU.
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- intent(in) :: z_t !< Height at the top of the layer in m.
+ intent(in) :: z_t !< Height at the top of the layer in depth units (Z).
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- intent(in) :: z_b !< Height at the bottom of the layer in m.
+ intent(in) :: z_b !< Height at the bottom of the layer in Z.
real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is
!! subtracted out to reduce the magnitude
!! of each of the integrals.
real, intent(in) :: rho_0 !< A density, in 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, in m s-2.
+ real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2.
type(EOS_type), pointer :: EOS !< Equation of state structure
real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
intent(out) :: dpa !< The change in the pressure anomaly
@@ -886,7 +893,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO,
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, in Pa m.
+ !! anomaly at the top of the layer, in 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
@@ -896,9 +903,8 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO,
!! the pressure anomaly at the top and bottom of the
!! layer divided by the y grid spacing, in Pa.
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- optional, intent(in) :: bathyT !< The depth of the bathymetry in m
- real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the
- !! same units as z_t
+ optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z.
+ real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z.
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)
@@ -906,16 +912,16 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO,
real :: w_left, w_right
real, parameter :: C1_90 = 1.0/90.0 ! Rational constants.
real :: GxRho, I_Rho
- real :: dz ! The layer thickness, in m.
- real :: hWght ! A pressure-thickness below topography, in m.
- real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m.
- real :: iDenom ! The inverse of the denominator in the wieghts, in m-2.
+ real :: dz ! The layer thickness, in Z.
+ real :: hWght ! A pressure-thickness below topography, in Z.
+ real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z.
+ real :: iDenom ! The inverse of the denominator in the weights, in Z-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 wieghts of the left and right columns, 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 integrals of density with height at the
- ! 5 sub-column locations, in m2 s-2.
+ real :: intz(5) ! The gravitational acceleration times the integrals of density
+ ! with height at the 5 sub-column locations, in 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,35 +1052,51 @@ end subroutine int_density_dz_generic
! ==========================================================================
!> Compute pressure gradient force integrals by quadrature for the case where
!! 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)
- type(hor_index_type), intent(in) :: HII, HIO
+ 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), &
+ intent(in) :: T_t !< Potential temperatue at the cell top (degC)
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- intent(in) :: T_t, T_b, S_t, S_b
+ intent(in) :: T_b !< Potential temperatue at the cell bottom (degC)
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- intent(in) :: z_t !< The geometric height at the top
- !! of the layer, usually in m
+ intent(in) :: S_t !< Salinity at the cell top (ppt)
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- intent(in) :: z_b !< The geometric height at the bpttom
- !! of the layer, usually in m
- real, intent(in) :: rho_ref, rho_0, G_e
- real, intent(in) :: dz_subroundoff !< A miniscule thickness
- !! change with the same units as z_t
+ intent(in) :: S_b !< Salinity at the cell bottom (ppt)
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- intent(in) :: bathyT !< The depth of the bathymetry in m
- type(EOS_type), pointer :: EOS !< Equation of state structure
+ intent(in) :: z_t !< The geometric height at the top of the layer,
+ !! in depth units (Z), usually m.
+ real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
+ intent(in) :: z_b !< The geometric height at the bottom of the layer in Z.
+ real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to
+ !! reduce the magnitude of each of the integrals.
+ real, intent(in) :: rho_0 !< A density, in 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, in m2 Z-1 s-2.
+ real, intent(in) :: dz_subroundoff !< A miniscule thickness
+ !! change with the same units as z_t
+ real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
+ intent(in) :: bathyT !< The depth of the bathymetry in units of Z.
+ type(EOS_type), pointer :: EOS !< Equation of state structure
real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
- intent(out) :: dpa
+ intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa.
real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
- optional, intent(out) :: intz_dpa
+ 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, in Pa Z.
real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), &
- optional, intent(out) :: intx_dpa
+ 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, in Pa.
real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), &
- optional, intent(out) :: inty_dpa
- logical, optional, intent(in) :: useMassWghtInterp
+ 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, in Pa.
+ logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to
+ !! interpolate T/S for top and bottom integrals.
! This subroutine calculates (by numerical quadrature) integrals of
! pressure anomalies across layers, which are required for calculating the
! finite-volume form pressure accelerations in a Boussinesq model. The one
@@ -1085,53 +1107,34 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, &
! It is assumed that the salinity and temperature profiles are linear in the
! vertical. The top and bottom values within each layer are provided and
! a linear interpolation is used to compute intermediate values.
-!
-! Arguments: T - potential temperature relative to the surface in C
-! (the 't' and 'b' subscripts refer to the values at
-! the top and the bottom of each layer)
-! (in) S - salinity in PSU.
-! (the 't' and 'b' subscripts refer to the values at
-! the top and the bottom of each layer)
-! (in) z_t - height at the top of the layer in m.
-! (in) z_b - height at the top of the layer in m.
-! (in) rho_ref - A mean density, in 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.)
-! (in) rho_0 - A density, in kg m-3, that is used to calculate the pressure
-! (as p~=-z*rho_0*G_e) used in the equation of state.
-! (in) G_e - The Earth's gravitational acceleration, in m s-2.
-! (in) G - The ocean's grid structure.
-! (in) form_of_eos - integer that selects the eqn of state.
-! (out) dpa - The change in the pressure anomaly across the layer,
-! in Pa.
-! (out,opt) intz_dpa - The integral through the thickness of the layer of the
-! pressure anomaly relative to the anomaly at the top of
-! the layer, in Pa m.
-! (out,opt) 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, in Pa.
-! (out,opt) 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, in Pa.
-! (in,opt) useMassWghtInterp - If true, uses mass weighting to interpolate
-! T/S for top and bottom integrals.
-
- real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2)))
- real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2)))
- real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2)))
- real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2)))
- real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1)))
- real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1)))
- real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1)))
- real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1)))
- real :: wt_t(5), wt_b(5)
- real :: rho_anom
- real :: w_left, w_right, intz(5)
- real, parameter :: C1_90 = 1.0/90.0 ! Rational constants.
- real :: GxRho, I_Rho
- real :: dz(HIO%iscB:HIO%iecB+1), dz_x(5,HIO%iscB:HIO%iecB), dz_y(5,HIO%isc:HIO%iec)
- real :: weight_t, weight_b, hWght, massWeightToggle
- real :: Ttl, Tbl, Ttr, Tbr, Stl, Sbl, Str, Sbr, hL, hR, iDenom
+
+ ! Local variables
+ real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Temperatures along a line of subgrid locations, in degC
+ real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Salinities along a line of subgrid locations, in ppt
+ real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Pressures along a line of subgrid locations, in Pa
+ real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Densities along a line of subgrid locations, in kg m-3
+ real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Temperatures at an array of subgrid locations, in degC
+ real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Salinities at an array of subgrid locations, in ppt
+ real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Pressures at an array of subgrid locations, in Pa
+ real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Densities at an array of subgrid locations, in kg m-3
+ real :: wt_t(5), wt_b(5) ! Top and bottom weights, ND.
+ real :: rho_anom ! A density anomaly in kg m-3.
+ real :: w_left, w_right ! Left and right weights, ND.
+ real :: intz(5) ! The gravitational acceleration times the integrals of density
+ ! with height at the 5 sub-column locations, in Pa.
+ real, parameter :: C1_90 = 1.0/90.0 ! A rational constant, ND.
+ real :: GxRho ! Gravitational acceleration times density, in kg m-1 Z-1 s-2.
+ real :: I_Rho ! The inverse of the reference density, in m3 kg-1.
+ real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points in Z.
+ real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations, in Z.
+ real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations, in Z.
+ real :: weight_t, weight_b ! Nondimensional wieghts 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, in degC.
+ real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners, in ppt.
+ real :: hWght ! A topographically limited thicknes weight, in Z.
+ real :: hL, hR ! Thicknesses to the left and right, in Z.
+ real :: iDenom ! The denominator of the thickness weight expressions, in Z-2.
integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n
integer :: iin, jin, ioff, joff
integer :: pos
@@ -1352,20 +1355,21 @@ 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)
+ 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)
real, intent(in) :: S_b !< Salinity at the cell bottom (ppt)
- real, intent(in) :: z_t !< Absolute height of top of cell (m) (Boussinesq ????)
- real, intent(in) :: z_b !< Absolute height of bottom of cell (m)
+ real, intent(in) :: z_t !< Absolute height of top of cell (Z) (Boussinesq ????)
+ real, intent(in) :: z_b !< Absolute height of bottom of cell (Z)
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 (m/s2)
+ real, intent(in) :: G_e !< Gravitational acceleration (m2 Z-1 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 (m)
+ real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt (Z)
+ real, optional, intent(in) :: z_tol !< The tolerance in finding z_out, in Z.
! 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
@@ -1391,7 +1395,8 @@ 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
+ Pa_tol = GxRho * 1.e-5 ! 1e-5 has diimensions of m, but should be converted to the units of z.
+ if (present(z_tol)) Pa_tol = GxRho * z_tol
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 )
@@ -1423,8 +1428,17 @@ 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, intent(in) :: T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos
- type(EOS_type), pointer :: EOS !< Equation of state structure
+ 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, usually in m
+ real, intent(in) :: z_b !< The geometric height at the bottom of the layer, usually in m
+ real, intent(in) :: rho_ref !< A mean density, in 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, in m s-2.
+ real, intent(in) :: pos !< The fractional vertical position, nondim, 0 to 1.
+ type(EOS_type), pointer :: EOS !< Equation of state structure
! Local variables
real, parameter :: C1_90 = 1.0/90.0 ! Rational constants.
real :: dz, top_weight, bottom_weight, rho_ave
@@ -1452,26 +1466,51 @@ end function frac_dp_at_pos
! ==========================================================================
-! Compute pressure gradient force integrals for the case where T and S
-! are parabolic profiles
-! ==========================================================================
+!> 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)
- type(hor_index_type), intent(in) :: HII, HIO
+ 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), &
- intent(in) :: T, T_t, T_b, S, S_t, S_b, z_t, z_b
- real, intent(in) :: rho_ref, rho_0, G_e
+ intent(in) :: T !< Potential temperature referenced to the surface (degC)
+ real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
+ intent(in) :: T_t !< Potential temperatue at the cell top (degC)
+ real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
+ intent(in) :: T_b !< Potential temperatue at the cell bottom (degC)
+ real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
+ intent(in) :: S !< Salinity (PSU)
+ real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
+ intent(in) :: S_t !< Salinity at the cell top (ppt)
+ 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 in m.
+ real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
+ intent(in) :: z_b !< Height at the bottom of the layer in m.
+ real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to
+ !! reduce the magnitude of each of the integrals.
+ real, intent(in) :: rho_0 !< A density, in 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, in m s-2.
type(EOS_type), pointer :: EOS !< Equation of state structure
real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
- intent(out) :: dpa
+ intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa.
real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
- optional, intent(out) :: intz_dpa
- real, dimension(HIO%IsdB:HIO%IedB,HIO%JsdB:HIO%JedB), &
- optional, intent(out) :: intx_dpa
+ 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, in Pa m.
+ 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, in Pa.
real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), &
- optional, intent(out) :: inty_dpa
+ 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, in Pa.
+
! 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
@@ -1706,14 +1745,12 @@ end subroutine int_density_dz_generic_ppm
! =============================================================================
-! Compute integral of quadratic function
-! =============================================================================
-subroutine compute_integral_quadratic ( x, y, f, integral )
-
- ! Arguments
- real, intent(in), dimension(4) :: x, y
- real, intent(in), dimension(9) :: f
- real, intent(out) :: integral
+!> Compute the integral of the quadratic function
+subroutine compute_integral_quadratic( x, y, f, integral )
+ real, dimension(4), intent(in) :: x !< The x-position of the corners
+ real, dimension(4), intent(in) :: y !< The y-position of the corners
+ real, dimension(9), intent(in) :: f !< The function at the quadrature points
+ real, intent(out) :: integral !< The returned integral
! Local variables
integer :: i, k
@@ -1791,16 +1828,17 @@ end subroutine compute_integral_quadratic
! =============================================================================
-! Evaluation of the four bilinear shape fn and their gradients at (xi,eta)
-! =============================================================================
-subroutine evaluate_shape_bilinear ( xi, eta, phi, dphidxi, dphideta )
-
- ! Arguments
- real, intent(in) :: xi, eta
- real, dimension(4), intent(out) :: phi, dphidxi, dphideta
-
- ! The shape functions within the parent element are defined as shown
- ! here:
+!> Evaluation of the four bilinear shape fn and their gradients at (xi,eta)
+subroutine evaluate_shape_bilinear( xi, eta, phi, dphidxi, dphideta )
+ real, intent(in) :: xi !< The x position to evaluate
+ real, intent(in) :: eta !< The z position to evaluate
+ real, dimension(4), intent(out) :: phi !< The weights of the four corners at this point
+ real, dimension(4), intent(out) :: dphidxi !< The x-gradient of the weights of the four
+ !! corners at this point
+ real, dimension(4), intent(out) :: dphideta !< The z-gradient of the weights of the four
+ !! corners at this point
+
+ ! The shape functions within the parent element are defined as shown here:
!
! (-1,1) 2 o------------o 1 (1,1)
! | |
@@ -1829,16 +1867,20 @@ end subroutine evaluate_shape_bilinear
! =============================================================================
-! Evaluation of the nine quadratic shape fn and their gradients at (xi,eta)
-! =============================================================================
+!> Evaluation of the nine quadratic shape fn weights and their gradients at (xi,eta)
subroutine evaluate_shape_quadratic ( xi, eta, phi, dphidxi, dphideta )
! Arguments
- real, intent(in) :: xi, eta
- real, dimension(9), intent(out) :: phi, dphidxi, dphideta
-
- ! The quadratic shape functions within the parent element are
- ! defined as shown here:
+ real, intent(in) :: xi !< The x position to evaluate
+ real, intent(in) :: eta !< The z position to evaluate
+ real, dimension(9), intent(out) :: phi !< The weights of the 9 bilinear quadrature points
+ !! at this point
+ real, dimension(9), intent(out) :: dphidxi !< The x-gradient of the weights of the 9 bilinear
+ !! quadrature points corners at this point
+ real, dimension(9), intent(out) :: dphideta !< The z-gradient of the weights of the 9 bilinear
+ !! quadrature points corners at this point
+
+ ! The quadratic shape functions within the parent element are defined as shown here:
!
! 5 (0,1)
! (-1,1) 2 o------o------o 1 (1,1)
@@ -1851,9 +1893,9 @@ subroutine evaluate_shape_quadratic ( xi, eta, phi, dphidxi, dphideta )
! 7 (0,-1)
!
- phi = 0.0
- dphidxi = 0.0
- dphideta = 0.0
+ phi(:) = 0.0
+ dphidxi(:) = 0.0
+ dphideta(:) = 0.0
phi(1) = 0.25 * xi * ( 1 + xi ) * eta * ( 1 + eta )
phi(2) = - 0.25 * xi * ( 1 - xi ) * eta * ( 1 + eta )
@@ -1946,10 +1988,10 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, &
! real :: dp_90(2:4) ! The pressure change through a layer divided by 90, in Pa.
real :: hWght ! A pressure-thickness below topography, in Pa.
real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa.
- real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2.
+ real :: iDenom ! The inverse of the denominator in the weights, in 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 wieghts of the left and right columns, 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, in m2 s-2.
@@ -2143,10 +2185,10 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref,
real :: dp_90(2:4) ! The pressure change through a layer divided by 90, in Pa.
real :: hWght ! A pressure-thickness below topography, in Pa.
real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa.
- real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2.
+ real :: iDenom ! The inverse of the denominator in the weights, in 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 wieghts of the left and right columns, 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, in m2 s-2.
@@ -2310,21 +2352,18 @@ 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
- !> The horizontal index structure
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
-
- !> Potential temperature referenced to the surface (degC)
- real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: T
- !> Salinity (PSU)
- real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: S
- !> Pressure at the top of the layer in Pa.
- real, dimension(:), intent(in) :: press
- !> Equation of state structure
- type(EOS_type), pointer :: EOS
- !> 3d mask
- real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: mask_z
- integer, intent(in) :: kd
- !
+
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(SZI_(G),SZJ_(G), SZK_(G)), &
+ intent(inout) :: T !< Potential temperature referenced to the surface (degC)
+ real, dimension(SZI_(G),SZJ_(G), SZK_(G)), &
+ intent(inout) :: S !< Salinity (PSU)
+ real, dimension(:), intent(in) :: press !< Pressure at the top of the layer in Pa.
+ type(EOS_type), pointer :: EOS !< Equation of state structure
+ real, dimension(SZI_(G),SZJ_(G), SZK_(G)), &
+ intent(in) :: mask_z !< 3d mask regulating which points to convert.
+ integer, intent(in) :: kd !< The number of layers to work on
+
integer :: i,j,k
real :: gsw_sr_from_sp, gsw_ct_from_pt, gsw_sa_from_sp
real :: p
@@ -2344,20 +2383,26 @@ subroutine convert_temp_salt_for_TEOS10(T, S, press, G, kd, mask_z, EOS)
enddo ; enddo ; enddo
end subroutine convert_temp_salt_for_TEOS10
-! Extractor routine for the EOS type if the members need to be accessed outside this module
+!> Extractor routine for the EOS type if the members need to be accessed outside this module
subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, &
Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp)
- type(EOS_type), pointer :: EOS
- integer, optional, intent(out) :: form_of_EOS
- integer, optional, intent(out) :: form_of_TFreeze
- logical, optional, intent(out) :: EOS_quadrature
- logical, optional, intent(out) :: Compressible
- real , optional, intent(out) :: Rho_T0_S0
- real , optional, intent(out) :: drho_dT
- real , optional, intent(out) :: dRho_dS
- real , optional, intent(out) :: TFr_S0_P0
- real , optional, intent(out) :: dTFr_dS
- real , optional, intent(out) :: dTFr_dp
+ type(EOS_type), pointer :: EOS !< Equation of state structure
+ integer, optional, intent(out) :: form_of_EOS !< A coded integer indicating the equation of state to use.
+ integer, optional, intent(out) :: form_of_TFreeze !< A coded integer indicating the expression for
+ !! the potential temperature of the freezing point.
+ logical, optional, intent(out) :: EOS_quadrature !< If true, always use the generic (quadrature)
+ !! code for the integrals of density.
+ logical, optional, intent(out) :: Compressible !< If true, in situ density is a function of pressure.
+ real , optional, intent(out) :: Rho_T0_S0 !< Density at T=0 degC and S=0 ppt (kg m-3)
+ real , optional, intent(out) :: drho_dT !< Partial derivative of density with temperature
+ !! 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 in deg C.
+ real , optional, intent(out) :: dTFr_dS !< The derivative of freezing point with salinity,
+ !! in deg C PSU-1.
+ real , optional, intent(out) :: dTFr_dp !< The derivative of freezing point with pressure,
+ !! in deg C Pa-1.
if (present(form_of_EOS )) form_of_EOS = EOS%form_of_EOS
if (present(form_of_TFreeze)) form_of_TFreeze = EOS%form_of_TFreeze
diff --git a/src/equation_of_state/MOM_EOS_NEMO.F90 b/src/equation_of_state/MOM_EOS_NEMO.F90
index 86ad3cb5be..c925301607 100644
--- a/src/equation_of_state/MOM_EOS_NEMO.F90
+++ b/src/equation_of_state/MOM_EOS_NEMO.F90
@@ -1,3 +1,4 @@
+!> The equation of state using the expressions of Roquet et al. that are used in NEMO
module MOM_EOS_NEMO
! This file is part of MOM6. See LICENSE.md for the license.
@@ -9,7 +10,7 @@ module MOM_EOS_NEMO
!* Roquet, F., Madec, G., McDougall, T. J., and Barker, P. M., 2015. *
!* Accurate polynomial expressions for the density and specific volume*
!* of seawater using the TEOS-10 standard. Ocean Modelling, 90:29-43. *
-!* These algorithms are NOT from NEMO package!! *
+!* These algorithms are NOT from the standard NEMO package!! *
!***********************************************************************
!use gsw_mod_toolbox, only : gsw_sr_from_sp, gsw_ct_from_pt
@@ -21,149 +22,154 @@ module MOM_EOS_NEMO
public calculate_density_derivs_nemo
public calculate_density_scalar_nemo, calculate_density_array_nemo
+!> Compute the in situ density of sea water (units of kg/m^3), or its anomaly with respect to
+!! a reference density, from absolute salinity (g/kg), conservative temperature (in deg C),
+!! and pressure in Pa, using the expressions derived for use with NEMO
interface calculate_density_nemo
module procedure calculate_density_scalar_nemo, calculate_density_array_nemo
end interface calculate_density_nemo
+!> For a given thermodynamic state, return the derivatives of density with conservative temperature
+!! and absolute salinity, the expressions derived for use with NEMO
interface calculate_density_derivs_nemo
module procedure calculate_density_derivs_scalar_nemo, calculate_density_derivs_array_nemo
end interface calculate_density_derivs_nemo
- real, parameter :: Pa2db = 1.e-4
- real, parameter :: rdeltaS = 32.
- real, parameter :: r1_S0 = 0.875/35.16504
- real, parameter :: r1_T0 = 1./40.
- real, parameter :: r1_P0 = 1.e-4
- real, parameter :: R00 = 4.6494977072e+01
- real, parameter :: R01 = -5.2099962525
- real, parameter :: R02 = 2.2601900708e-01
- real, parameter :: R03 = 6.4326772569e-02
- real, parameter :: R04 = 1.5616995503e-02
- real, parameter :: R05 = -1.7243708991e-03
- real, parameter :: EOS000 = 8.0189615746e+02
- real, parameter :: EOS100 = 8.6672408165e+02
- real, parameter :: EOS200 = -1.7864682637e+03
- real, parameter :: EOS300 = 2.0375295546e+03
- real, parameter :: EOS400 = -1.2849161071e+03
- real, parameter :: EOS500 = 4.3227585684e+02
- real, parameter :: EOS600 = -6.0579916612e+01
- real, parameter :: EOS010 = 2.6010145068e+01
- real, parameter :: EOS110 = -6.5281885265e+01
- real, parameter :: EOS210 = 8.1770425108e+01
- real, parameter :: EOS310 = -5.6888046321e+01
- real, parameter :: EOS410 = 1.7681814114e+01
- real, parameter :: EOS510 = -1.9193502195
- real, parameter :: EOS020 = -3.7074170417e+01
- real, parameter :: EOS120 = 6.1548258127e+01
- real, parameter :: EOS220 = -6.0362551501e+01
- real, parameter :: EOS320 = 2.9130021253e+01
- real, parameter :: EOS420 = -5.4723692739
- real, parameter :: EOS030 = 2.1661789529e+01
- real, parameter :: EOS130 = -3.3449108469e+01
- real, parameter :: EOS230 = 1.9717078466e+01
- real, parameter :: EOS330 = -3.1742946532
- real, parameter :: EOS040 = -8.3627885467
- real, parameter :: EOS140 = 1.1311538584e+01
- real, parameter :: EOS240 = -5.3563304045
- real, parameter :: EOS050 = 5.4048723791e-01
- real, parameter :: EOS150 = 4.8169980163e-01
- real, parameter :: EOS060 = -1.9083568888e-01
- real, parameter :: EOS001 = 1.9681925209e+01
- real, parameter :: EOS101 = -4.2549998214e+01
- real, parameter :: EOS201 = 5.0774768218e+01
- real, parameter :: EOS301 = -3.0938076334e+01
- real, parameter :: EOS401 = 6.6051753097
- real, parameter :: EOS011 = -1.3336301113e+01
- real, parameter :: EOS111 = -4.4870114575
- real, parameter :: EOS211 = 5.0042598061
- real, parameter :: EOS311 = -6.5399043664e-01
- real, parameter :: EOS021 = 6.7080479603
- real, parameter :: EOS121 = 3.5063081279
- real, parameter :: EOS221 = -1.8795372996
- real, parameter :: EOS031 = -2.4649669534
- real, parameter :: EOS131 = -5.5077101279e-01
- real, parameter :: EOS041 = 5.5927935970e-01
- real, parameter :: EOS002 = 2.0660924175
- real, parameter :: EOS102 = -4.9527603989
- real, parameter :: EOS202 = 2.5019633244
- real, parameter :: EOS012 = 2.0564311499
- real, parameter :: EOS112 = -2.1311365518e-01
- real, parameter :: EOS022 = -1.2419983026
- real, parameter :: EOS003 = -2.3342758797e-02
- real, parameter :: EOS103 = -1.8507636718e-02
- real, parameter :: EOS013 = 3.7969820455e-01
- real, parameter :: ALP000 = -6.5025362670e-01
- real, parameter :: ALP100 = 1.6320471316
- real, parameter :: ALP200 = -2.0442606277
- real, parameter :: ALP300 = 1.4222011580
- real, parameter :: ALP400 = -4.4204535284e-01
- real, parameter :: ALP500 = 4.7983755487e-02
- real, parameter :: ALP010 = 1.8537085209
- real, parameter :: ALP110 = -3.0774129064
- real, parameter :: ALP210 = 3.0181275751
- real, parameter :: ALP310 = -1.4565010626
- real, parameter :: ALP410 = 2.7361846370e-01
- real, parameter :: ALP020 = -1.6246342147
- real, parameter :: ALP120 = 2.5086831352
- real, parameter :: ALP220 = -1.4787808849
- real, parameter :: ALP320 = 2.3807209899e-01
- real, parameter :: ALP030 = 8.3627885467e-01
- real, parameter :: ALP130 = -1.1311538584
- real, parameter :: ALP230 = 5.3563304045e-01
- real, parameter :: ALP040 = -6.7560904739e-02
- real, parameter :: ALP140 = -6.0212475204e-02
- real, parameter :: ALP050 = 2.8625353333e-02
- real, parameter :: ALP001 = 3.3340752782e-01
- real, parameter :: ALP101 = 1.1217528644e-01
- real, parameter :: ALP201 = -1.2510649515e-01
- real, parameter :: ALP301 = 1.6349760916e-02
- real, parameter :: ALP011 = -3.3540239802e-01
- real, parameter :: ALP111 = -1.7531540640e-01
- real, parameter :: ALP211 = 9.3976864981e-02
- real, parameter :: ALP021 = 1.8487252150e-01
- real, parameter :: ALP121 = 4.1307825959e-02
- real, parameter :: ALP031 = -5.5927935970e-02
- real, parameter :: ALP002 = -5.1410778748e-02
- real, parameter :: ALP102 = 5.3278413794e-03
- real, parameter :: ALP012 = 6.2099915132e-02
- real, parameter :: ALP003 = -9.4924551138e-03
- real, parameter :: BET000 = 1.0783203594e+01
- real, parameter :: BET100 = -4.4452095908e+01
- real, parameter :: BET200 = 7.6048755820e+01
- real, parameter :: BET300 = -6.3944280668e+01
- real, parameter :: BET400 = 2.6890441098e+01
- real, parameter :: BET500 = -4.5221697773
- real, parameter :: BET010 = -8.1219372432e-01
- real, parameter :: BET110 = 2.0346663041
- real, parameter :: BET210 = -2.1232895170
- real, parameter :: BET310 = 8.7994140485e-01
- real, parameter :: BET410 = -1.1939638360e-01
- real, parameter :: BET020 = 7.6574242289e-01
- real, parameter :: BET120 = -1.5019813020
- real, parameter :: BET220 = 1.0872489522
- real, parameter :: BET320 = -2.7233429080e-01
- real, parameter :: BET030 = -4.1615152308e-01
- real, parameter :: BET130 = 4.9061350869e-01
- real, parameter :: BET230 = -1.1847737788e-01
- real, parameter :: BET040 = 1.4073062708e-01
- real, parameter :: BET140 = -1.3327978879e-01
- real, parameter :: BET050 = 5.9929880134e-03
- real, parameter :: BET001 = -5.2937873009e-01
- real, parameter :: BET101 = 1.2634116779
- real, parameter :: BET201 = -1.1547328025
- real, parameter :: BET301 = 3.2870876279e-01
- real, parameter :: BET011 = -5.5824407214e-02
- real, parameter :: BET111 = 1.2451933313e-01
- real, parameter :: BET211 = -2.4409539932e-02
- real, parameter :: BET021 = 4.3623149752e-02
- real, parameter :: BET121 = -4.6767901790e-02
- real, parameter :: BET031 = -6.8523260060e-03
- real, parameter :: BET002 = -6.1618945251e-02
- real, parameter :: BET102 = 6.2255521644e-02
- real, parameter :: BET012 = -2.6514181169e-03
- real, parameter :: BET003 = -2.3025968587e-04
-
-
+real, parameter :: Pa2db = 1.e-4 !< Conversion factor between Pa and dbar
+!>@{ Parameters in the NEMO equation of state
+real, parameter :: rdeltaS = 32.
+real, parameter :: r1_S0 = 0.875/35.16504
+real, parameter :: r1_T0 = 1./40.
+real, parameter :: r1_P0 = 1.e-4
+real, parameter :: R00 = 4.6494977072e+01
+real, parameter :: R01 = -5.2099962525
+real, parameter :: R02 = 2.2601900708e-01
+real, parameter :: R03 = 6.4326772569e-02
+real, parameter :: R04 = 1.5616995503e-02
+real, parameter :: R05 = -1.7243708991e-03
+real, parameter :: EOS000 = 8.0189615746e+02
+real, parameter :: EOS100 = 8.6672408165e+02
+real, parameter :: EOS200 = -1.7864682637e+03
+real, parameter :: EOS300 = 2.0375295546e+03
+real, parameter :: EOS400 = -1.2849161071e+03
+real, parameter :: EOS500 = 4.3227585684e+02
+real, parameter :: EOS600 = -6.0579916612e+01
+real, parameter :: EOS010 = 2.6010145068e+01
+real, parameter :: EOS110 = -6.5281885265e+01
+real, parameter :: EOS210 = 8.1770425108e+01
+real, parameter :: EOS310 = -5.6888046321e+01
+real, parameter :: EOS410 = 1.7681814114e+01
+real, parameter :: EOS510 = -1.9193502195
+real, parameter :: EOS020 = -3.7074170417e+01
+real, parameter :: EOS120 = 6.1548258127e+01
+real, parameter :: EOS220 = -6.0362551501e+01
+real, parameter :: EOS320 = 2.9130021253e+01
+real, parameter :: EOS420 = -5.4723692739
+real, parameter :: EOS030 = 2.1661789529e+01
+real, parameter :: EOS130 = -3.3449108469e+01
+real, parameter :: EOS230 = 1.9717078466e+01
+real, parameter :: EOS330 = -3.1742946532
+real, parameter :: EOS040 = -8.3627885467
+real, parameter :: EOS140 = 1.1311538584e+01
+real, parameter :: EOS240 = -5.3563304045
+real, parameter :: EOS050 = 5.4048723791e-01
+real, parameter :: EOS150 = 4.8169980163e-01
+real, parameter :: EOS060 = -1.9083568888e-01
+real, parameter :: EOS001 = 1.9681925209e+01
+real, parameter :: EOS101 = -4.2549998214e+01
+real, parameter :: EOS201 = 5.0774768218e+01
+real, parameter :: EOS301 = -3.0938076334e+01
+real, parameter :: EOS401 = 6.6051753097
+real, parameter :: EOS011 = -1.3336301113e+01
+real, parameter :: EOS111 = -4.4870114575
+real, parameter :: EOS211 = 5.0042598061
+real, parameter :: EOS311 = -6.5399043664e-01
+real, parameter :: EOS021 = 6.7080479603
+real, parameter :: EOS121 = 3.5063081279
+real, parameter :: EOS221 = -1.8795372996
+real, parameter :: EOS031 = -2.4649669534
+real, parameter :: EOS131 = -5.5077101279e-01
+real, parameter :: EOS041 = 5.5927935970e-01
+real, parameter :: EOS002 = 2.0660924175
+real, parameter :: EOS102 = -4.9527603989
+real, parameter :: EOS202 = 2.5019633244
+real, parameter :: EOS012 = 2.0564311499
+real, parameter :: EOS112 = -2.1311365518e-01
+real, parameter :: EOS022 = -1.2419983026
+real, parameter :: EOS003 = -2.3342758797e-02
+real, parameter :: EOS103 = -1.8507636718e-02
+real, parameter :: EOS013 = 3.7969820455e-01
+real, parameter :: ALP000 = -6.5025362670e-01
+real, parameter :: ALP100 = 1.6320471316
+real, parameter :: ALP200 = -2.0442606277
+real, parameter :: ALP300 = 1.4222011580
+real, parameter :: ALP400 = -4.4204535284e-01
+real, parameter :: ALP500 = 4.7983755487e-02
+real, parameter :: ALP010 = 1.8537085209
+real, parameter :: ALP110 = -3.0774129064
+real, parameter :: ALP210 = 3.0181275751
+real, parameter :: ALP310 = -1.4565010626
+real, parameter :: ALP410 = 2.7361846370e-01
+real, parameter :: ALP020 = -1.6246342147
+real, parameter :: ALP120 = 2.5086831352
+real, parameter :: ALP220 = -1.4787808849
+real, parameter :: ALP320 = 2.3807209899e-01
+real, parameter :: ALP030 = 8.3627885467e-01
+real, parameter :: ALP130 = -1.1311538584
+real, parameter :: ALP230 = 5.3563304045e-01
+real, parameter :: ALP040 = -6.7560904739e-02
+real, parameter :: ALP140 = -6.0212475204e-02
+real, parameter :: ALP050 = 2.8625353333e-02
+real, parameter :: ALP001 = 3.3340752782e-01
+real, parameter :: ALP101 = 1.1217528644e-01
+real, parameter :: ALP201 = -1.2510649515e-01
+real, parameter :: ALP301 = 1.6349760916e-02
+real, parameter :: ALP011 = -3.3540239802e-01
+real, parameter :: ALP111 = -1.7531540640e-01
+real, parameter :: ALP211 = 9.3976864981e-02
+real, parameter :: ALP021 = 1.8487252150e-01
+real, parameter :: ALP121 = 4.1307825959e-02
+real, parameter :: ALP031 = -5.5927935970e-02
+real, parameter :: ALP002 = -5.1410778748e-02
+real, parameter :: ALP102 = 5.3278413794e-03
+real, parameter :: ALP012 = 6.2099915132e-02
+real, parameter :: ALP003 = -9.4924551138e-03
+real, parameter :: BET000 = 1.0783203594e+01
+real, parameter :: BET100 = -4.4452095908e+01
+real, parameter :: BET200 = 7.6048755820e+01
+real, parameter :: BET300 = -6.3944280668e+01
+real, parameter :: BET400 = 2.6890441098e+01
+real, parameter :: BET500 = -4.5221697773
+real, parameter :: BET010 = -8.1219372432e-01
+real, parameter :: BET110 = 2.0346663041
+real, parameter :: BET210 = -2.1232895170
+real, parameter :: BET310 = 8.7994140485e-01
+real, parameter :: BET410 = -1.1939638360e-01
+real, parameter :: BET020 = 7.6574242289e-01
+real, parameter :: BET120 = -1.5019813020
+real, parameter :: BET220 = 1.0872489522
+real, parameter :: BET320 = -2.7233429080e-01
+real, parameter :: BET030 = -4.1615152308e-01
+real, parameter :: BET130 = 4.9061350869e-01
+real, parameter :: BET230 = -1.1847737788e-01
+real, parameter :: BET040 = 1.4073062708e-01
+real, parameter :: BET140 = -1.3327978879e-01
+real, parameter :: BET050 = 5.9929880134e-03
+real, parameter :: BET001 = -5.2937873009e-01
+real, parameter :: BET101 = 1.2634116779
+real, parameter :: BET201 = -1.1547328025
+real, parameter :: BET301 = 3.2870876279e-01
+real, parameter :: BET011 = -5.5824407214e-02
+real, parameter :: BET111 = 1.2451933313e-01
+real, parameter :: BET211 = -2.4409539932e-02
+real, parameter :: BET021 = 4.3623149752e-02
+real, parameter :: BET121 = -4.6767901790e-02
+real, parameter :: BET031 = -6.8523260060e-03
+real, parameter :: BET002 = -6.1618945251e-02
+real, parameter :: BET102 = 6.2255521644e-02
+real, parameter :: BET012 = -2.6514181169e-03
+real, parameter :: BET003 = -2.3025968587e-04
+!!@}
contains
@@ -205,6 +211,7 @@ subroutine calculate_density_array_nemo(T, S, pressure, rho, start, npts, rho_re
integer, intent(in) :: npts !< the number of values to calculate.
real, optional, intent(in) :: rho_ref !< A reference density in kg m-3.
+ ! Local variables
real :: zp, zt, zh, zs, zr0, zn, zn0, zn1, zn2, zn3, zs0
integer :: j
@@ -255,6 +262,8 @@ subroutine calculate_density_array_nemo(T, S, pressure, rho, start, npts, rho_re
enddo
end subroutine calculate_density_array_nemo
+!> For a given thermodynamic state, calculate the derivatives of density with conservative
+!! temperature and absolute salinity, using the expressions derived for use with NEMO.
subroutine calculate_density_derivs_array_nemo(T, S, pressure, drho_dT, drho_dS, start, npts)
real, intent(in), dimension(:) :: T !< Conservative temperature in C.
real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg.
@@ -265,15 +274,8 @@ subroutine calculate_density_derivs_array_nemo(T, S, pressure, drho_dT, drho_dS,
!! in kg m-3 psu-1.
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * Arguments: T - conservative temperature in C. *
-! * (in) S - absolute salinity in g/kg. *
-! * (in) pressure - pressure in Pa. *
-! * (out) drho_dT - the partial derivative of density with *
-! * potential temperature, in kg m-3 K-1. *
-! * (out) drho_dS - the partial derivative of density with *
-! * salinity, in kg m-3 psu-1. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
+
+ ! Local variables
real :: zp,zt , zh , zs , zr0, zn , zn0, zn1, zn2, zn3
integer :: j
@@ -337,9 +339,13 @@ end subroutine calculate_density_derivs_array_nemo
!> Wrapper to calculate_density_derivs_array for scalar inputs
subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds)
- real, intent(in) :: T, S, pressure
- real, intent(out) :: drho_dt
- real, intent(out) :: drho_ds
+ real, intent(in) :: T !< Potential temperature relative to the surface in C.
+ real, intent(in) :: S !< Salinity in PSU.
+ real, intent(in) :: pressure !< Pressure in Pa.
+ real, intent(out) :: drho_dT !< The partial derivative of density with potential
+ !! temperature, in kg m-3 K-1.
+ real, intent(out) :: drho_dS !< The partial derivative of density with salinity,
+ !! in kg m-3 psu-1.
! Local variables
real :: al0, p0, lambda
integer :: j
@@ -355,6 +361,10 @@ subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds
drho_ds = drds0(1)
end subroutine calculate_density_derivs_scalar_nemo
+!> Compute the in situ density of sea water (rho in units of kg/m^3) and the compressibility
+!! (drho/dp = C_sound^-2, stored as drho_dp in units of s2 m-2) from absolute salinity
+!! (sal in g/kg), conservative temperature (T in deg C), and pressure in Pa, using the expressions
+!! derived for use with NEMO.
subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts)
real, intent(in), dimension(:) :: T !< Conservative temperature in C.
real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg.
@@ -365,16 +375,8 @@ subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts)
!! in s2 m-2.
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * Arguments: T - conservative temperature in C. *
-! * (in) S - absolute salinity in g/kg. *
-! * (in) pressure - pressure in Pa. *
-! * (out) rho - in situ density in kg m-3. *
-! * (out) drho_dp - the partial derivative of density with *
-! * pressure (also the inverse of the square of *
-! * sound speed) in s2 m-2. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
-! *====================================================================*
+
+ ! Local variables
real :: zs,zt,zp
integer :: j
diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90
index ce940ca26f..4a139582a3 100644
--- a/src/equation_of_state/MOM_EOS_TEOS10.F90
+++ b/src/equation_of_state/MOM_EOS_TEOS10.F90
@@ -1,3 +1,4 @@
+!> The equation of state using the TEOS10 expressions
module MOM_EOS_TEOS10
! This file is part of MOM6. See LICENSE.md for the license.
@@ -21,23 +22,33 @@ module MOM_EOS_TEOS10
public calculate_density_second_derivs_teos10
public gsw_sp_from_sr, gsw_pt_from_ct
+!> Compute the in situ density of sea water (units of kg/m^3), or its anomaly with respect to
+!! a reference density, from absolute salinity (g/kg), conservative temperature (in deg C),
+!! and pressure in Pa, using the TEOS10 expressions.
interface calculate_density_teos10
module procedure calculate_density_scalar_teos10, calculate_density_array_teos10
end interface calculate_density_teos10
+!> Compute the in situ specific volume of sea water (in units of m^3/kg), or an anomaly with respect
+!! to a reference specific volume, from absolute salinity (in g/kg), conservative temperature
+!! (in deg C), and pressure in Pa, using the TEOS10 expressions.
interface calculate_spec_vol_teos10
module procedure calculate_spec_vol_scalar_teos10, calculate_spec_vol_array_teos10
end interface calculate_spec_vol_teos10
+!> For a given thermodynamic state, return the derivatives of density with conservative temperature
+!! and absolute salinity, using the TEOS10 expressions.
interface calculate_density_derivs_teos10
module procedure calculate_density_derivs_scalar_teos10, calculate_density_derivs_array_teos10
end interface calculate_density_derivs_teos10
+!> For a given thermodynamic state, return the second derivatives of density with various combinations
+!! of conservative temperature, absolute salinity, and pressure, using the TEOS10 expressions.
interface calculate_density_second_derivs_teos10
module procedure calculate_density_second_derivs_scalar_teos10, calculate_density_second_derivs_array_teos10
end interface calculate_density_second_derivs_teos10
-real, parameter :: Pa2db = 1.e-4 ! The conversion factor from Pa to dbar.
+real, parameter :: Pa2db = 1.e-4 !< The conversion factor from Pa to dbar.
contains
@@ -52,6 +63,7 @@ subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref)
real, intent(out) :: rho !< In situ density in kg m-3.
real, optional, intent(in) :: rho_ref !< A reference density in kg m-3.
+ ! Local variables
real, dimension(1) :: T0, S0, pressure0
real, dimension(1) :: rho0
@@ -77,6 +89,7 @@ subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_
integer, intent(in) :: npts !< the number of values to calculate.
real, optional, intent(in) :: rho_ref !< A reference density in kg m-3.
+ ! Local variables
real :: zs, zt, zp
integer :: j
@@ -96,17 +109,17 @@ subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_
end subroutine calculate_density_array_teos10
!> This subroutine computes the in situ specific volume of sea water (specvol in
-!! units of m^3/kg) from salinity (S in psu), potential temperature (T in deg C)
+!! units of m^3/kg) from absolute salinity (S in g/kg), conservative temperature (T in deg C)
!! and pressure in Pa, using the TEOS10 equation of state.
!! If spv_ref is present, specvol is an anomaly from spv_ref.
subroutine calculate_spec_vol_scalar_teos10(T, S, pressure, specvol, spv_ref)
- real, intent(in) :: T !< potential temperature relative to the surface
- !! in C.
- real, intent(in) :: S !< salinity in PSU.
+ real, intent(in) :: T !< Conservative temperature in C.
+ real, intent(in) :: S !< Absolute salinity in g/kg
real, intent(in) :: pressure !< pressure in Pa.
real, intent(out) :: specvol !< in situ specific volume in m3 kg-1.
real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1.
+ ! Local variables
real, dimension(1) :: T0, S0, pressure0, spv0
T0(1) = T ; S0(1) = S ; pressure0(1) = pressure
@@ -117,19 +130,20 @@ end subroutine calculate_spec_vol_scalar_teos10
!> This subroutine computes the in situ specific volume of sea water (specvol in
-!! units of m^3/kg) from salinity (S in psu), potential temperature (T in deg C)
+!! units of m^3/kg) from absolute salinity (S in g/kg), conservative temperature (T in deg C)
!! and pressure in Pa, using the TEOS10 equation of state.
!! If spv_ref is present, specvol is an anomaly from spv_ref.
subroutine calculate_spec_vol_array_teos10(T, S, pressure, specvol, start, npts, spv_ref)
- real, dimension(:), intent(in) :: T !< potential temperature relative to the surface
+ real, dimension(:), intent(in) :: T !< Conservative temperature relative to the surface
!! in C.
- real, dimension(:), intent(in) :: S !< salinity in PSU.
+ real, dimension(:), intent(in) :: S !< salinity in g/kg.
real, dimension(:), intent(in) :: pressure !< pressure in Pa.
real, dimension(:), intent(out) :: specvol !< in situ specific volume in m3 kg-1.
integer, intent(in) :: start !< the starting point in the arrays.
integer, intent(in) :: npts !< the number of values to calculate.
real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1.
+ ! Local variables
real :: zs, zt, zp
integer :: j
@@ -149,27 +163,21 @@ subroutine calculate_spec_vol_array_teos10(T, S, pressure, specvol, start, npts,
end subroutine calculate_spec_vol_array_teos10
-
+!> For a given thermodynamic state, calculate the derivatives of density with conservative
+!! temperature and absolute salinity, using the TEOS10 expressions.
subroutine calculate_density_derivs_array_teos10(T, S, pressure, drho_dT, drho_dS, start, npts)
real, intent(in), dimension(:) :: T !< Conservative temperature in C.
real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg.
real, intent(in), dimension(:) :: pressure !< Pressure in Pa.
- real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with potential
+ real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with conservative
!! temperature, in kg m-3 K-1.
- real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with salinity,
- !! in kg m-3 psu-1.
+ real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with absolute salinity,
+ !! in kg m-3 (g/kg)-1.
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * Arguments: T - conservative temperature in C. *
-! * (in) S - absolute salinity in g/kg. *
-! * (in) pressure - pressure in Pa. *
-! * (out) drho_dT - the partial derivative of density with *
-! * potential temperature, in kg m-3 K-1. *
-! * (out) drho_dS - the partial derivative of density with *
-! * salinity, in kg m-3 psu-1. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
- real :: zs,zt,zp
+
+ ! Local variables
+ real :: zs, zt, zp
integer :: j
do j=start,start+npts-1
@@ -186,11 +194,19 @@ subroutine calculate_density_derivs_array_teos10(T, S, pressure, drho_dT, drho_d
end subroutine calculate_density_derivs_array_teos10
+!> For a given thermodynamic state, calculate the derivatives of density with conservative
+!! temperature and absolute salinity, using the TEOS10 expressions.
subroutine calculate_density_derivs_scalar_teos10(T, S, pressure, drho_dT, drho_dS)
- real, intent(in) :: T, S, pressure
- real, intent(out) :: drho_dT, drho_dS
+ real, intent(in) :: T !< Conservative temperature in C
+ real, intent(in) :: S !< Absolute Salinity in g/kg
+ real, intent(in) :: pressure !< Pressure in Pa.
+ real, intent(out) :: drho_dT !< The partial derivative of density with conservative
+ !! temperature, in kg m-3 K-1.
+ real, intent(out) :: drho_dS !< The partial derivative of density with absolute salinity,
+ !! in kg m-3 (g/kg)-1.
+
! Local variables
- real :: zs,zt,zp
+ real :: zs, zt, zp
!Conversions
zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity
zt = T !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp
@@ -199,25 +215,20 @@ subroutine calculate_density_derivs_scalar_teos10(T, S, pressure, drho_dT, drho_
call gsw_rho_first_derivatives(zs, zt, zp, drho_dsa=drho_dS, drho_dct=drho_dT)
end subroutine calculate_density_derivs_scalar_teos10
+!> For a given thermodynamic state, calculate the derivatives of specific volume with conservative
+!! temperature and absolute salinity, using the TEOS10 expressions.
subroutine calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start, npts)
real, intent(in), dimension(:) :: T !< Conservative temperature in C.
real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg.
real, intent(in), dimension(:) :: pressure !< Pressure in Pa.
real, intent(out), dimension(:) :: dSV_dT !< The partial derivative of specific volume with
- !! potential temperature, in m3 kg-1 K-1.
+ !! conservative temperature, in m3 kg-1 K-1.
real, intent(out), dimension(:) :: dSV_dS !< The partial derivative of specific volume with
- !! salinity, in m3 kg-1 / (g/kg).
+ !! absolute salinity, in m3 kg-1 / (g/kg).
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * Arguments: T - conservative temperature in C. *
-! * (in) S - absolute salinity in g/kg. *
-! * (in) pressure - pressure in Pa. *
-! * (out) dSV_dT - the partial derivative of specific volume with *
-! * potential temperature, in m3 kg-1 K-1. *
-! * (out) dSV_dS - the partial derivative of specific volume with *
-! * salinity, in m3 kg-1 / (g/kg). *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
+
+ ! Local variables
real :: zs, zt, zp
integer :: j
@@ -238,20 +249,17 @@ end subroutine calculate_specvol_derivs_teos10
!> Calculate the 5 second derivatives of the equation of state for scalar inputs
subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, &
drho_dT_dT, drho_dS_dP, drho_dT_dP)
- real, intent(in) :: T, S, pressure
+ real, intent(in) :: T !< Conservative temperature in C
+ real, intent(in) :: S !< Absolute Salinity in g/kg
+ real, intent(in) :: pressure !< Pressure in Pa.
real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S
real, intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T
real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T
real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure
real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure
-! * Arguments: T - conservative temperature in C. *
-! * (in) S - absolute salinity in g/kg. *
-! * (in) pressure - pressure in Pa. *
-! * (out) drho_dT - the partial derivative of density with *
-! * potential temperature, in kg m-3 K-1. *
-! * (out) drho_dS - the partial derivative of density with *
-! * salinity, in kg m-3 psu-1. *
- real :: zs,zt,zp
+
+ ! Local variables
+ real :: zs, zt, zp
!Conversions
zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity
@@ -266,7 +274,9 @@ end subroutine calculate_density_second_derivs_scalar_teos10
!> Calculate the 5 second derivatives of the equation of state for scalar inputs
subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, &
drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts)
- real, dimension(:), intent(in) :: T, S, pressure
+ real, dimension(:), intent(in) :: T !< Conservative temperature in C
+ real, dimension(:), intent(in) :: S !< Absolute Salinity in g/kg
+ real, dimension(:), intent(in) :: pressure !< Pressure in Pa.
real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S
real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T
real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T
@@ -274,15 +284,11 @@ subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_
real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * Arguments: T - conservative temperature in C. *
-! * (in) S - absolute salinity in g/kg. *
-! * (in) pressure - pressure in Pa. *
-! * (out) drho_dT - the partial derivative of density with *
-! * potential temperature, in kg m-3 K-1. *
-! * (out) drho_dS - the partial derivative of density with *
-! * salinity, in kg m-3 psu-1. *
- real :: zs,zt,zp
+
+ ! Local variables
+ real :: zs, zt, zp
integer :: j
+
do j=start,start+npts-1
!Conversions
zs = S(j) !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity
@@ -299,10 +305,10 @@ subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_
end subroutine calculate_density_second_derivs_array_teos10
-!> This subroutine computes the in situ density of sea water (rho in *
-!! units of kg/m^3) and the compressibility (drho/dp = C_sound^-2) *
-!! (drho_dp in units of s2 m-2) from salinity (sal in psu), potential*
-!! temperature (T in deg C), and pressure in Pa. It uses the *
+!> This subroutine computes the in situ density of sea water (rho in
+!! units of kg/m^3) and the compressibility (drho/dp = C_sound^-2)
+!! (drho_dp in units of s2 m-2) from absolute salinity (sal in g/kg),
+!! conservative temperature (T in deg C), and pressure in Pa. It uses the
!! subroutines from TEOS10 website
subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts)
real, intent(in), dimension(:) :: T !< Conservative temperature in C.
@@ -314,22 +320,8 @@ subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts)
!! in s2 m-2.
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * Arguments: T - conservative temperature in C. *
-! * (in) S - absolute salinity in g/kg. *
-! * (in) pressure - pressure in Pa. *
-! * (out) rho - in situ density in kg m-3. *
-! * (out) drho_dp - the partial derivative of density with *
-! * pressure (also the inverse of the square of *
-! * sound speed) in s2 m-2. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
-! *====================================================================*
-! * This subroutine computes the in situ density of sea water (rho in *
-! * units of kg/m^3) and the compressibility (drho/dp = C_sound^-2) *
-! * (drho_dp in units of s2 m-2) from salinity (sal in psu), potential*
-! * temperature (T in deg C), and pressure in Pa. It uses the *
-! * subroutines from TEOS10 website *
-! *====================================================================*
+
+ ! Local variables
real :: zs,zt,zp
integer :: j
diff --git a/src/equation_of_state/MOM_EOS_UNESCO.F90 b/src/equation_of_state/MOM_EOS_UNESCO.F90
index 4489f40a2a..eaad8d0128 100644
--- a/src/equation_of_state/MOM_EOS_UNESCO.F90
+++ b/src/equation_of_state/MOM_EOS_UNESCO.F90
@@ -1,3 +1,4 @@
+!> The equation of state using the Jackett and McDougall fits to the UNESCO EOS
module MOM_EOS_UNESCO
! This file is part of MOM6. See LICENSE.md for the license.
@@ -15,15 +16,21 @@ module MOM_EOS_UNESCO
public calculate_density_derivs_UNESCO
public calculate_density_scalar_UNESCO, calculate_density_array_UNESCO
+!> Compute the in situ density of sea water (in units of kg/m^3), or its anomaly with respect to
+!! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure in Pa,
+!! using the UNESCO (1981) equation of state.
interface calculate_density_UNESCO
module procedure calculate_density_scalar_UNESCO, calculate_density_array_UNESCO
end interface calculate_density_UNESCO
+!> Compute the in situ specific volume of sea water (in units of m^3/kg), or an anomaly with respect
+!! to a reference specific volume, from salinity (in psu), potential temperature (in deg C), and
+!! pressure in Pa, using the UNESCO (1981) equation of state.
interface calculate_spec_vol_UNESCO
module procedure calculate_spec_vol_scalar_UNESCO, calculate_spec_vol_array_UNESCO
end interface calculate_spec_vol_UNESCO
-
+!>@{ Parameters in the UNESCO equation of state
! The following constants are used to calculate rho0. The notation
! is Rab for the contribution to rho0 from T^aS^b.
real, parameter :: R00 = 999.842594, R10 = 6.793952e-2, R20 = -9.095290e-3, &
@@ -42,7 +49,7 @@ module MOM_EOS_UNESCO
Sp30 = 1.956415e-6, Sp01 = 6.704388e-3, Sp11 = -1.847318e-4, Sp21 = 2.059331e-7, &
Sp032 = 1.480266e-4, SP000 = 2.102898e-4, SP010 = -1.202016e-5, SP020 = 1.394680e-7, &
SP001 = -2.040237e-6, SP011 = 6.128773e-8, SP021 = 6.207323e-10
-
+!!@}
contains
@@ -56,6 +63,7 @@ subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref)
real, intent(out) :: rho !< In situ density in kg m-3.
real, optional, intent(in) :: rho_ref !< A reference density in kg m-3.
+ ! Local variables
real, dimension(1) :: T0, S0, pressure0
real, dimension(1) :: rho0
@@ -80,17 +88,7 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_
integer, intent(in) :: npts !< the number of values to calculate.
real, optional, intent(in) :: rho_ref !< A reference density in kg m-3.
-! * This subroutine computes the in situ density of sea water (rho in *
-! * units of kg/m^3) from salinity (S in psu), potential temperature *
-! * (T in deg C), and pressure in Pa. *
-
-! * Arguments: T - potential temperature relative to the surface in C. *
-! * (in) S - salinity in PSU. *
-! * (in) pressure - pressure in Pa. *
-! * (out) rho - in situ density in kg m-3. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
-
+ ! Local variables
real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power.
real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power.
real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power.
@@ -144,6 +142,7 @@ subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref)
real, intent(out) :: specvol !< in situ specific volume in m3 kg-1.
real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1.
+ ! Local variables
real, dimension(1) :: T0, S0, pressure0, spv0
T0(1) = T ; S0(1) = S ; pressure0(1) = pressure
@@ -166,6 +165,7 @@ subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts,
integer, intent(in) :: npts !< the number of values to calculate.
real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1.
+ ! Local variables
real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power.
real :: s_local, s32, s2; ! Salinity to the 1st, 3/2, & 2nd power.
real :: p1, p2; ! Pressure (in bars) to the 1st and 2nd power.
@@ -221,18 +221,7 @@ subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, sta
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * This subroutine calculates the partial derivatives of density *
-! * with potential temperature and salinity. *
-! * *
-! * Arguments: T - potential temperature relative to the surface in C. *
-! * (in) S - salinity in PSU. *
-! * (in) pressure - pressure in Pa. *
-! * (out) drho_dT - the partial derivative of density with *
-! * potential temperature, in kg m-3 K-1. *
-! * (out) drho_dS - the partial derivative of density with *
-! * salinity, in kg m-3 psu-1. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
+ ! Local variables
real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power.
real :: s12, s_local, s32, s2; ! Salinity to the 1/2 - 2nd powers.
real :: p1, p2; ! Pressure (in bars) to the 1st & 2nd power.
@@ -303,20 +292,7 @@ subroutine calculate_compress_UNESCO(T, S, pressure, rho, drho_dp, start, npts)
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * This subroutine computes the in situ density of sea water (rho) *
-! * and the compressibility (drho/dp == C_sound^-2) at the given *
-! * salinity, potential temperature, and pressure. *
-! * *
-! * Arguments: T - potential temperature relative to the surface in C. *
-! * (in) S - salinity in PSU. *
-! * (in) pressure - pressure in Pa. *
-! * (out) rho - in situ density in kg m-3. *
-! * (out) drho_dp - the partial derivative of density with *
-! * pressure (also the inverse of the square of *
-! * sound speed) in s2 m-2. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
-
+ ! Local variables
real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power.
real :: s_local, s32, s2; ! Salinity to the 1st, 3/2, & 2nd power.
real :: p1, p2; ! Pressure (in bars) to the 1st and 2nd power.
diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90
index ad1908adb5..a4535ec961 100644
--- a/src/equation_of_state/MOM_EOS_Wright.F90
+++ b/src/equation_of_state/MOM_EOS_Wright.F90
@@ -1,3 +1,4 @@
+!> The equation of state using the Wright 1997 expressions
module MOM_EOS_Wright
! This file is part of MOM6. See LICENSE.md for the license.
@@ -19,22 +20,33 @@ module MOM_EOS_Wright
public calculate_density_second_derivs_wright
public int_density_dz_wright, int_spec_vol_dp_wright
+
+!> Compute the in situ density of sea water (in units of kg/m^3), or its anomaly with respect to
+!! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure in Pa,
+!! using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740.
interface calculate_density_wright
module procedure calculate_density_scalar_wright, calculate_density_array_wright
end interface calculate_density_wright
+!> Compute the in situ specific volume of sea water (in units of m^3/kg), or an anomaly with respect
+!! to a reference specific volume, from salinity (in psu), potential temperature (in deg C), and
+!! pressure in Pa, using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740.
interface calculate_spec_vol_wright
module procedure calculate_spec_vol_scalar_wright, calculate_spec_vol_array_wright
end interface calculate_spec_vol_wright
+!> For a given thermodynamic state, return the derivatives of density with temperature and salinity
interface calculate_density_derivs_wright
module procedure calculate_density_derivs_scalar_wright, calculate_density_derivs_array_wright
end interface
+!> For a given thermodynamic state, return the second derivatives of density with various combinations
+!! of temperature, salinity, and pressure
interface calculate_density_second_derivs_wright
module procedure calculate_density_second_derivs_scalar_wright, calculate_density_second_derivs_array_wright
end interface
+!>@{ Parameters in the Wright equation of state
!real :: a0, a1, a2, b0, b1, b2, b3, b4, b5, c0, c1, c2, c3, c4, c5
! One of the two following blocks of values should be commented out.
! Following are the values for the full range formula.
@@ -52,6 +64,7 @@ module MOM_EOS_Wright
real, parameter :: b3 = 2.084372e2, b4 = 5.944068e5, b5 = -9.643486e3
real, parameter :: c0 = 1.704853e5, c1 = 7.904722e2, c2 = -7.984422 ! c0/c1 ~= 216 ; c0/c4 ~= -740
real, parameter :: c3 = 5.140652e-2, c4 = -2.302158e2, c5 = -3.079464
+!!@}
contains
@@ -99,6 +112,7 @@ subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_
real, optional, intent(in) :: rho_ref !< A reference density in kg m-3.
! Original coded by R. Hallberg, 7/00, anomaly coded in 3/18.
+ ! Local variables
real :: al0, p0, lambda
real :: al_TS, p_TSp, lam_TS, pa_000
integer :: j
@@ -135,6 +149,7 @@ subroutine calculate_spec_vol_scalar_wright(T, S, pressure, specvol, spv_ref)
real, intent(out) :: specvol !< in situ specific volume in m3 kg-1.
real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1.
+ ! Local variables
real, dimension(1) :: T0, S0, pressure0, spv0
T0(1) = T ; S0(1) = S ; pressure0(1) = pressure
@@ -158,6 +173,7 @@ subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts,
integer, intent(in) :: npts !< the number of values to calculate.
real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1.
+ ! Local variables
real :: al0, p0, lambda
integer :: j
@@ -187,15 +203,7 @@ subroutine calculate_density_derivs_array_wright(T, S, pressure, drho_dT, drho_d
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * Arguments: T - potential temperature relative to the surface in C. *
-! * (in) S - salinity in PSU. *
-! * (in) pressure - pressure in Pa. *
-! * (out) drho_dT - the partial derivative of density with *
-! * potential temperature, in kg m-3 K-1. *
-! * (out) drho_dS - the partial derivative of density with *
-! * salinity, in kg m-3 psu-1. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
+ ! Local variables
real :: al0, p0, lambda, I_denom2
integer :: j
@@ -219,10 +227,9 @@ end subroutine calculate_density_derivs_array_wright
!> The scalar version of calculate_density_derivs which promotes scalar inputs to a 1-element array and then
!! demotes the output back to a scalar
subroutine calculate_density_derivs_scalar_wright(T, S, pressure, drho_dT, drho_dS)
- real, intent(in) :: T !< Potential temperature relative to the surface
- !! in C.
- real, intent(in) :: S !< Salinity in PSU.
- real, intent(in) :: pressure !< Pressure in Pa.
+ real, intent(in) :: T !< Potential temperature relative to the surface in C.
+ real, intent(in) :: S !< Salinity in PSU.
+ real, intent(in) :: pressure !< Pressure in Pa.
real, intent(out) :: drho_dT !< The partial derivative of density with potential
!! temperature, in kg m-3 K-1.
real, intent(out) :: drho_dS !< The partial derivative of density with salinity,
@@ -255,10 +262,11 @@ subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drh
integer, intent(in ) :: start !< Starting index in T,S,P
integer, intent(in ) :: npts !< Number of points to loop over
+ ! Local variables
+ real :: z0, z1, z2, z3, z4, z5, z6 ,z7, z8, z9, z10, z11, z2_2, z2_3
integer :: j
! Based on the above expression with common terms factored, there probably exists a more numerically stable
! and/or efficient expression
- real :: z0, z1, z2, z3, z4, z5, z6 ,z7, z8, z9, z10, z11, z2_2, z2_3
do j = start,start+npts-1
z0 = T(j)*(b1 + b5*S(j) + T(j)*(b2 + b3*T(j)))
@@ -314,9 +322,10 @@ subroutine calculate_density_second_derivs_scalar_wright(T, S, P, drho_ds_ds, dr
end subroutine calculate_density_second_derivs_scalar_wright
+!> For a given thermodynamic state, return the partial derivatives of specific volume
+!! with temperature and salinity
subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts)
- real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface
- !! in C.
+ real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface in C.
real, intent(in), dimension(:) :: S !< Salinity in g/kg.
real, intent(in), dimension(:) :: pressure !< Pressure in Pa.
real, intent(out), dimension(:) :: dSV_dT !< The partial derivative of specific volume with
@@ -326,15 +335,7 @@ subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * Arguments: T - potential temperature relative to the surface in C. *
-! * (in) S - salinity in g/kg. *
-! * (in) pressure - pressure in Pa. *
-! * (out) dSV_dT - the partial derivative of specific volume with *
-! * potential temperature, in m3 kg-1 K-1. *
-! * (out) dSV_dS - the partial derivative of specific volume with *
-! * salinity, in m3 kg-1 / (g/kg). *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
+ ! Local variables
real :: al0, p0, lambda, I_denom
integer :: j
@@ -361,8 +362,7 @@ end subroutine calculate_specvol_derivs_wright
!! from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740.
!! Coded by R. Hallberg, 1/01
subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts)
- real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface
- !! in C.
+ real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface in C.
real, intent(in), dimension(:) :: S !< Salinity in PSU.
real, intent(in), dimension(:) :: pressure !< Pressure in Pa.
real, intent(out), dimension(:) :: rho !< In situ density in kg m-3.
@@ -372,23 +372,8 @@ subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts)
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! * Arguments: T - potential temperature relative to the surface in C. *
-! * (in) S - salinity in PSU. *
-! * (in) pressure - pressure in Pa. *
-! * (out) rho - in situ density in kg m-3. *
-! * (out) drho_dp - the partial derivative of density with *
-! * pressure (also the inverse of the square of *
-! * sound speed) in s2 m-2. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
-! *====================================================================*
-! * This subroutine computes the in situ density of sea water (rho in *
-! * units of kg/m^3) and the compressibility (drho/dp = C_sound^-2) *
-! * (drho_dp in units of s2 m-2) from salinity (sal in psu), potential*
-! * temperature (T in deg C), and pressure in Pa. It uses the expres-*
-! * sions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. *
-! * Coded by R. Hallberg, 1/01 *
-! *====================================================================*
+ ! Coded by R. Hallberg, 1/01
+ ! Local variables
real :: al0, p0, lambda, I_denom
integer :: j
@@ -409,30 +394,31 @@ end subroutine calculate_compress_wright
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)
- type(hor_index_type), intent(in) :: HII, HIO
+ 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), &
intent(in) :: T !< Potential temperature relative to the surface
!! in C.
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
intent(in) :: S !< Salinity in PSU.
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- intent(in) :: z_t !< Height at the top of the layer in m.
+ intent(in) :: z_t !< Height at the top of the layer in depth units (Z).
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- intent(in) :: z_b !< Height at the top of the layer in m.
+ intent(in) :: z_b !< Height at the top of the layer in Z.
real, intent(in) :: rho_ref !< A mean density, in 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, in 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, in m s-2.
+ real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2.
real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
intent(out) :: dpa !< The change in the pressure anomaly across the
!! layer, in 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, in Pa m.
+ !! at the top of the layer, in 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
@@ -442,28 +428,28 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO,
!! pressure anomaly at the top and bottom of the
!! layer divided by the y grid spacing, in Pa.
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- optional, intent(in) :: bathyT !< The depth of the bathymetry in m
- real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the
- !! same units as z_t
+ optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z.
+ real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z.
logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to
- !! interpolate T/S for top and bottom integrals.
+ !! interpolate T/S for top and bottom integrals.
+ ! 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, in kg m-3.
real :: eps, eps2, rem
real :: GxRho, I_Rho
real :: p_ave, I_al0, I_Lzz
- real :: dz ! The layer thickness, in m.
- real :: hWght ! A pressure-thickness below topography, in m.
- real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m.
- real :: iDenom ! The inverse of the denominator in the wieghts, in m-2.
+ real :: dz ! The layer thickness, in Z.
+ real :: hWght ! A pressure-thickness below topography, in Z.
+ real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z.
+ real :: iDenom ! The inverse of the denominator in the weights, in m-Z.
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 wieghts of the left and right columns, 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 integrals of density with height at the
- ! 5 sub-column locations, in m2 s-2.
+ ! 5 sub-column locations, in Pa.
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.
@@ -613,7 +599,7 @@ end subroutine int_density_dz_wright
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)
- type(hor_index_type), intent(in) :: HI
+ 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
!! in C.
@@ -647,19 +633,13 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, &
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 in Pa
+ optional, intent(in) :: bathyP !< The pressure at the bathymetry in 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 (Pa?)
logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting
!! to interpolate T/S for top and bottom integrals.
-! This subroutine calculates 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| < 0.34.
-
+ ! 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
@@ -668,10 +648,10 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, &
real :: dp ! The pressure change through a layer, in Pa.
real :: hWght ! A pressure-thickness below topography, in Pa.
real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa.
- real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2.
+ real :: iDenom ! The inverse of the denominator in the weights, in 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 wieghts of the left and right columns, 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, in m2 s-2.
diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90
index 5ad35134ba..d63929bd62 100644
--- a/src/equation_of_state/MOM_EOS_linear.F90
+++ b/src/equation_of_state/MOM_EOS_linear.F90
@@ -1,12 +1,8 @@
+!> A simple linear equation of state for sea water with constant coefficients
module MOM_EOS_linear
! This file is part of MOM6. See LICENSE.md for the license.
-!***********************************************************************
-!* The subroutines in this file implement a simple linear equation of *
-!* state for sea water with constant coefficients set as parameters. *
-!***********************************************************************
-
use MOM_hor_index, only : hor_index_type
implicit none ; private
@@ -20,18 +16,29 @@ module MOM_EOS_linear
public calculate_density_second_derivs_linear
public int_density_dz_linear, int_spec_vol_dp_linear
+!> Compute the density of sea water (in kg/m^3), or its anomaly from a reference density,
+!! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C)
+!! and pressure in Pa.
interface calculate_density_linear
module procedure calculate_density_scalar_linear, calculate_density_array_linear
end interface calculate_density_linear
+!> Compute the specific volume of sea water (in m^3/kg), or its anomaly from a reference value,
+!! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C)
+!! and pressure in Pa.
interface calculate_spec_vol_linear
module procedure calculate_spec_vol_scalar_linear, calculate_spec_vol_array_linear
end interface calculate_spec_vol_linear
+!> For a given thermodynamic state, return the derivatives of density with temperature and
+!! salinity using the simple linear equation of state
interface calculate_density_derivs_linear
module procedure calculate_density_derivs_scalar_linear, calculate_density_derivs_array_linear
end interface calculate_density_derivs_linear
+!> For a given thermodynamic state, return the second derivatives of density with various
+!! combinations of temperature, salinity, and pressure. Note that with a simple linear
+!! equation of state these second derivatives are all 0.
interface calculate_density_second_derivs_linear
module procedure calculate_density_second_derivs_scalar_linear, calculate_density_second_derivs_array_linear
end interface calculate_density_second_derivs_linear
@@ -39,7 +46,7 @@ module MOM_EOS_linear
contains
!> This subroutine computes the density of sea water with a trivial
-!! linear equation of state (in kg/m^3) from salinity (sal in psu),
+!! linear equation of state (in kg m-3) from salinity (sal in PSU),
!! potential temperature (T in deg C), and pressure in Pa.
subroutine calculate_density_scalar_linear(T, S, pressure, rho, &
Rho_T0_S0, dRho_dT, dRho_dS, rho_ref)
@@ -54,20 +61,6 @@ subroutine calculate_density_scalar_linear(T, S, pressure, rho, &
!! in kg m-3 psu-1.
real, optional, intent(in) :: rho_ref !< A reference density in kg m-3.
-! * This subroutine computes the density of sea water with a trivial *
-! * linear equation of state (in kg/m^3) from salinity (sal in psu), *
-! * potential temperature (T in deg C), and pressure in Pa. *
-! * *
-! * Arguments: T - potential temperature relative to the surface in C. *
-! * (in) S - salinity in PSU. *
-! * (in) pressure - pressure in Pa. *
-! * (out) rho - in situ density in kg m-3. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
-! * (in) Rho_T0_S0 - The density at T=0, S=0, in kg m-3. *
-! * (in) dRho_dT - The derivatives of density with temperature *
-! * (in) dRho_dS - and salinity, in kg m-3 C-1 and kg m-3 psu-1. *
-
if (present(rho_ref)) then
rho = (Rho_T0_S0 - rho_ref) + (dRho_dT*T + dRho_dS*S)
else
@@ -93,7 +86,7 @@ subroutine calculate_density_array_linear(T, S, pressure, rho, start, npts, &
real, intent(in) :: dRho_dS !< The derivatives of density with salinity
!! in kg m-3 psu-1.
real, optional, intent(in) :: rho_ref !< A reference density in kg m-3.
-
+ ! Local variables
integer :: j
if (present(rho_ref)) then ; do j=start,start+npts-1
@@ -116,11 +109,10 @@ subroutine calculate_spec_vol_scalar_linear(T, S, pressure, specvol, &
real, intent(in) :: pressure !< pressure in Pa.
real, intent(out) :: specvol !< in situ specific volume in m3 kg-1.
real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3.
- real, intent(in) :: dRho_dT, dRho_dS !< The derivatives of density with
- !! temperature and salinity, in kg m-3 C-1
- !! and kg m-3 psu-1.
+ real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1.
+ real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1.
real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1.
-
+ ! Local variables
integer :: j
if (present(spv_ref)) then
@@ -146,11 +138,10 @@ subroutine calculate_spec_vol_array_linear(T, S, pressure, specvol, start, npts,
integer, intent(in) :: start !< the starting point in the arrays.
integer, intent(in) :: npts !< the number of values to calculate.
real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3.
- real, intent(in) :: dRho_dT, dRho_dS !< The derivatives of density with
- !! temperature and salinity, in kg m-3 C-1
- !! and kg m-3 psu-1.
+ real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1.
+ real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1.
real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1.
-
+ ! Local variables
integer :: j
if (present(spv_ref)) then ; do j=start,start+npts-1
@@ -175,27 +166,11 @@ subroutine calculate_density_derivs_array_linear(T, S, pressure, drho_dT_out, &
real, intent(out), dimension(:) :: drho_dS_out !< The partial derivative of density with
!! salinity, in kg m-3 psu-1.
real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3.
- real, intent(in) :: dRho_dT, dRho_dS !< The derivatives of density with
- !! temperature and salinity, in kg m-3 C-1
- !! and kg m-3 psu-1.
+ real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1.
+ real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1.
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-
-! * This subroutine calculates the partial derivatives of density *
-! * with potential temperature and salinity. *
-! * *
-! * Arguments: T - potential temperature relative to the surface in C. *
-! * (in) S - salinity in PSU. *
-! * (in) pressure - pressure in Pa. *
-! * (out) drho_dT_out - the partial derivative of density with *
-! * potential temperature, in kg m-3 K-1. *
-! * (out) drho_dS_out - the partial derivative of density with *
-! * salinity, in kg m-3 psu-1. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
-! * (in) Rho_T0_S0 - The density at T=0, S=0, in kg m-3. *
-! * (in) dRho_dT - The derivatives of density with temperature *
-! * (in) dRho_dS - and salinity, in kg m-3 C-1 and kg m-3 psu-1. *
+ ! Local variables
integer :: j
do j=start,start+npts-1
@@ -218,9 +193,8 @@ subroutine calculate_density_derivs_scalar_linear(T, S, pressure, drho_dT_out, &
real, intent(out) :: drho_dS_out !< The partial derivative of density with
!! salinity, in kg m-3 psu-1.
real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3.
- real, intent(in) :: dRho_dT, dRho_dS !< The derivatives of density with
- !! temperature and salinity, in kg m-3 C-1
- !! and kg m-3 psu-1.
+ real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1.
+ real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1.
drho_dT_out = dRho_dT
drho_dS_out = dRho_dS
@@ -263,6 +237,7 @@ subroutine calculate_density_second_derivs_array_linear(T, S,pressure, drho_dS_
real, dimension(:), intent(out) :: drho_dT_dP !< The partial derivative of density with
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
+ ! Local variables
integer :: j
do j=start,start+npts-1
drho_dS_dS(j) = 0.
@@ -274,7 +249,7 @@ subroutine calculate_density_second_derivs_array_linear(T, S,pressure, drho_dS_
end subroutine calculate_density_second_derivs_array_linear
-! #@# This subroutine needs a doxygen description.
+!> Calculate the derivatives of specific volume with temperature and salinity
subroutine calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, &
start, npts, Rho_T0_S0, dRho_dT, dRho_dS)
real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface
@@ -288,19 +263,11 @@ subroutine calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, &
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3.
- real, intent(in) :: dRho_dT, dRho_dS !< The derivatives of density with
- !! temperature and salinity, in kg m-3 C-1
- !! and kg m-3 psu-1.
-
-! * Arguments: T - potential temperature relative to the surface in C. *
-! * (in) S - salinity in g/kg. *
-! * (in) pressure - pressure in Pa. *
-! * (out) dSV_dT - the partial derivative of specific volume with *
-! * potential temperature, in m3 kg-1 K-1. *
-! * (out) dSV_dS - the partial derivative of specific volume with *
-! * salinity, in m3 kg-1 / (g/kg). *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
+ real, intent(in) :: dRho_dT !< The derivative of density with
+ !! temperature, in kg m-3 C-1.
+ real, intent(in) :: dRho_dS !< The derivative of density with
+ !! salinity, in kg m-3 psu-1.
+ ! Local variables
real :: I_rho2
integer :: j
@@ -329,27 +296,11 @@ subroutine calculate_compress_linear(T, S, pressure, rho, drho_dp, start, npts,&
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3.
- real, intent(in) :: dRho_dT, dRho_dS !< The derivatives of density with
- !! temperature and salinity, in kg m-3 C-1
- !! and kg m-3 psu-1.
-
-! * This subroutine computes the in situ density of sea water (rho) *
-! * and the compressibility (drho/dp == C_sound^-2) at the given *
-! * salinity, potential temperature, and pressure. *
-! * *
-! * Arguments: T - potential temperature relative to the surface in C. *
-! * (in) S - salinity in PSU. *
-! * (in) pressure - pressure in Pa. *
-! * (out) rho - in situ density in kg m-3. *
-! * (out) drho_dp - the partial derivative of density with *
-! * pressure (also the inverse of the square of *
-! * sound speed) in s2 m-2. *
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
-! * (in) Rho_T0_S0 - The density at T=0, S=0, in kg m-3. *
-! * (in) dRho_dT - The derivatives of density with temperature *
-! * (in) dRho_dS - and salinity, in kg m-3 C-1 and kg m-3 psu-1. *
-
+ real, intent(in) :: dRho_dT !< The derivative of density with
+ !! temperature, in kg m-3 C-1.
+ real, intent(in) :: dRho_dS !< The derivative of density with
+ !! salinity, in kg m-3 psu-1.
+ ! Local variables
integer :: j
do j=start,start+npts-1
@@ -364,16 +315,17 @@ end subroutine calculate_compress_linear
subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, HIO, &
Rho_T0_S0, dRho_dT, dRho_dS, dpa, intz_dpa, intx_dpa, inty_dpa, &
bathyT, dz_neglect, useMassWghtInterp)
- type(hor_index_type), intent(in) :: HII, HIO
+ 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), &
intent(in) :: T !< Potential temperature relative to the surface
!! in C.
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
intent(in) :: S !< Salinity in PSU.
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- intent(in) :: z_t !< Height at the top of the layer in m.
+ intent(in) :: z_t !< Height at the top of the layer in depth units (Z).
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- intent(in) :: z_b !< Height at the top of the layer in m.
+ intent(in) :: z_b !< Height at the top of the layer in Z.
real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted
!! out to reduce the magnitude of each of the
!! integrals.
@@ -381,8 +333,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII,
!! 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,
- !! in m s-2.
+ real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2.
real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3.
real, intent(in) :: dRho_dT !< The derivative of density with temperature,
!! in kg m-3 C-1.
@@ -394,7 +345,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII,
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, in Pa m.
+ !! at the top of the layer, in 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
@@ -404,24 +355,23 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII,
!! pressure anomaly at the top and bottom of the
!! layer divided by the y grid spacing, in Pa.
real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
- optional, intent(in) :: bathyT !< The depth of the bathymetry in m
- real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the
- !! same units as z_t
+ optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z.
+ real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z.
logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to
- !! interpolate T/S for top and bottom integrals.
-
+ !! interpolate T/S for top and bottom integrals.
+ ! Local variables
real :: rho_anom ! The density anomaly from rho_ref, in kg m-3.
real :: raL, raR ! rho_anom to the left and right, in kg m-3.
- real :: dz, dzL, dzR ! Layer thicknesses in m.
- real :: hWght ! A pressure-thickness below topography, in m.
- real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m.
- real :: iDenom ! The inverse of the denominator in the wieghts, in m-2.
+ real :: dz, dzL, dzR ! Layer thicknesses in Z.
+ real :: hWght ! A pressure-thickness below topography, in Z.
+ real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z.
+ real :: iDenom ! The inverse of the denominator in the weights, in Z-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 wieghts of the left and right columns, 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 integrals of density with height at the
- ! 5 sub-column locations, in m2 s-2.
+ ! 5 sub-column locations, in 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
@@ -532,7 +482,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII,
enddo ; enddo ; endif
end subroutine int_density_dz_linear
-!> This subroutine calculates analytical and nearly-analytical integrals in
+!> Calculates 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. Specific volume is assumed to vary linearly between adjacent points.
@@ -577,51 +527,22 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, &
!! in 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 in Pa
+ optional, intent(in) :: bathyP !< The pressure at the bathymetry in 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 (Pa?)
logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting
!! to interpolate T/S for top and bottom integrals.
-
-! This subroutine calculates 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. Specific volume is assumed to vary linearly between adjacent points.
-!
-! Arguments: T - potential temperature relative to the surface in C.
-! (in) S - salinity in PSU.
-! (in) p_t - pressure at the top of the layer in Pa.
-! (in) p_b - pressure at the top of the layer in Pa.
-! (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.
-! (in) HI - The ocean's horizontal index type.
-! (in) Rho_T0_S0 - The density at T=0, S=0, in kg m-3.
-! (in) dRho_dT - The derivative of density with temperature in kg m-3 C-1.
-! (in) dRho_dS - The derivative of density with salinity, in kg m-3 psu-1.
-! (out) dza - The change in the geopotential anomaly across the layer,
-! in m2 s-2.
-! (out,opt) intp_dza - The integral in pressure through the layer of the
-! geopotential anomaly relative to the anomaly at the
-! bottom of the layer, in Pa m2 s-2.
-! (out,opt) 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, in m2 s-2.
-! (out,opt) 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, in m2 s-2.
+ ! Local variables
real :: dRho_TS ! The density anomaly due to T and S, in kg m-3.
real :: alpha_anom ! The specific volume anomaly from 1/rho_ref, in m3 kg-1.
real :: aaL, aaR ! rho_anom to the left and right, in kg m-3.
real :: dp, dpL, dpR ! Layer pressure thicknesses in Pa.
real :: hWght ! A pressure-thickness below topography, in Pa.
real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa.
- real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2.
+ real :: iDenom ! The inverse of the denominator in the weights, in 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 wieghts of the left and right columns, 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, in m2 s-2.
diff --git a/src/equation_of_state/MOM_TFreeze.F90 b/src/equation_of_state/MOM_TFreeze.F90
index ddc0e215da..99937181c0 100644
--- a/src/equation_of_state/MOM_TFreeze.F90
+++ b/src/equation_of_state/MOM_TFreeze.F90
@@ -1,3 +1,4 @@
+!> Freezing point expressions
module MOM_TFreeze
! This file is part of MOM6. See LICENSE.md for the license.
@@ -12,43 +13,48 @@ module MOM_TFreeze
public calculate_TFreeze_linear, calculate_TFreeze_Millero, calculate_TFreeze_teos10
+!> Compute the freezing point potential temperature (in deg C) from salinity (in psu) and
+!! pressure (in Pa) using a simple linear expression, with coefficients passed in as arguments.
interface calculate_TFreeze_linear
module procedure calculate_TFreeze_linear_scalar, calculate_TFreeze_linear_array
end interface calculate_TFreeze_linear
+!> Compute the freezing point potential temperature (in deg C) from salinity (in psu) and
+!! pressure (in Pa) using the expression from Millero (1978) (and in appendix A of Gill 1982),
+!! but with the of the pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an
+!! expression for potential temperature (not in situ temperature), using a
+!! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar).
interface calculate_TFreeze_Millero
module procedure calculate_TFreeze_Millero_scalar, calculate_TFreeze_Millero_array
end interface calculate_TFreeze_Millero
+!> Compute the freezing point conservative temperature (in deg C) from absolute salinity (in g/kg)
+!! and pressure (in Pa) using the TEOS10 package.
interface calculate_TFreeze_teos10
module procedure calculate_TFreeze_teos10_scalar, calculate_TFreeze_teos10_array
end interface calculate_TFreeze_teos10
contains
+!> This subroutine computes the freezing point potential temperature
+!! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple
+!! linear expression, with coefficients passed in as arguments.
subroutine calculate_TFreeze_linear_scalar(S, pres, T_Fr, TFr_S0_P0, &
dTFr_dS, dTFr_dp)
- real, intent(in) :: S, pres
- real, intent(out) :: T_Fr
- real, intent(in) :: TFr_S0_P0, dTFr_dS, dTFr_dp
-! This subroutine computes the freezing point potential temparature
-! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple
-! linear expression, with coefficients passed in as arguments.
-!
-! Arguments: S - salinity in PSU.
-! (in) pres - pressure in Pa.
-! (out) T_Fr - Freezing point potential temperature in deg C.
-! (in) TFr_S0_P0 - The freezing point at S=0, p=0, in deg C.
-! (in) dTFr_dS - The derivatives of freezing point with salinity, in
-! deg C PSU-1.
-! (in) dTFr_dp - The derivatives of freezing point with pressure, in
-! deg C Pa-1.
+ real, intent(in) :: S !< salinity in PSU.
+ real, intent(in) :: pres !< pressure in Pa.
+ real, intent(out) :: T_Fr !< Freezing point potential temperature in deg C.
+ real, intent(in) :: TFr_S0_P0 !< The freezing point at S=0, p=0, in deg C.
+ real, intent(in) :: dTFr_dS !< The derivative of freezing point with salinity,
+ !! in deg C PSU-1.
+ real, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure,
+ !! in deg C Pa-1.
T_Fr = (TFr_S0_P0 + dTFr_dS*S) + dTFr_dp*pres
end subroutine calculate_TFreeze_linear_scalar
-!> This subroutine computes the freezing point potential temparature
+!> This subroutine computes an array of freezing point potential temperatures
!! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple
!! linear expression, with coefficients passed in as arguments.
subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, &
@@ -63,21 +69,6 @@ subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, &
!! in deg C PSU-1.
real, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure,
!! in deg C Pa-1.
-
-! This subroutine computes the freezing point potential temparature
-! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple
-! linear expression, with coefficients passed in as arguments.
-!
-! Arguments: S - salinity in PSU.
-! (in) pres - pressure in Pa.
-! (out) T_Fr - Freezing point potential temperature in deg C.
-! (in) start - the starting point in the arrays.
-! (in) npts - the number of values to calculate.
-! (in) TFr_S0_P0 - The freezing point at S=0, p=0, in deg C.
-! (in) dTFr_dS - The derivative of freezing point with salinity, in
-! deg C PSU-1.
-! (in) dTFr_dp - The derivative of freezing point with pressure, in
-! deg C Pa-1.
integer :: j
do j=start,start+npts-1
@@ -86,7 +77,7 @@ subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, &
end subroutine calculate_TFreeze_linear_array
-!> This subroutine computes the freezing point potential temparature
+!> This subroutine computes the freezing point potential temperature
!! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression
!! from Millero (1978) (and in appendix A of Gill 1982), but with the of the
!! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an
@@ -97,16 +88,7 @@ subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr)
real, intent(in) :: pres !< Pressure in Pa.
real, intent(out) :: T_Fr !< Freezing point potential temperature in deg C.
-! This subroutine computes the freezing point potential temparature
-! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression
-! from Millero (1978) (and in appendix A of Gill 1982), but with the of the
-! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an
-! expression for potential temperature (not in situ temperature), using a
-! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar).
-!
-! Arguments: S - salinity in PSU.
-! (in) pres - pressure in Pa.
-! (out) T_Fr - Freezing point potential temperature in deg C.
+ ! Local variables
real, parameter :: cS1 = -0.0575, cS3_2 = 1.710523e-3, cS2 = -2.154996e-4
real, parameter :: dTFr_dp = -7.75e-8
@@ -114,7 +96,7 @@ subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr)
end subroutine calculate_TFreeze_Millero_scalar
-!> This subroutine computes the freezing point potential temparature
+!> This subroutine computes the freezing point potential temperature
!! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression
!! from Millero (1978) (and in appendix A of Gill 1982), but with the of the
!! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an
@@ -126,18 +108,8 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts)
real, dimension(:), intent(out) :: T_Fr !< Freezing point potential temperature in deg C.
integer, intent(in) :: start !< The starting point in the arrays.
integer, intent(in) :: npts !< The number of values to calculate.
-! This subroutine computes the freezing point potential temparature
-! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression
-! from Millero (1978) (and in appendix A of Gill 1982), but with the of the
-! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an
-! expression for potential temperature (not in situ temperature), using a
-! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar).
-!
-! Arguments: S - salinity in PSU.
-! (in) pres - pressure in Pa.
-! (out) T_Fr - Freezing point potential temperature in deg C.
-! (in) start - the starting point in the arrays.
-! (in) npts - the number of values to calculate.
+
+ ! Local variables
real, parameter :: cS1 = -0.0575, cS3_2 = 1.710523e-3, cS2 = -2.154996e-4
real, parameter :: dTFr_dp = -7.75e-8
integer :: j
@@ -149,20 +121,15 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts)
end subroutine calculate_TFreeze_Millero_array
-!> This subroutine computes the freezing point conservative temparature
+!> This subroutine computes the freezing point conservative temperature
!! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the
!! TEOS10 package.
subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr)
real, intent(in) :: S !< Absolute salinity in g/kg.
real, intent(in) :: pres !< Pressure in Pa.
real, intent(out) :: T_Fr !< Freezing point conservative temperature in deg C.
-! This subroutine computes the freezing point conservative temparature
-! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the
-! TEOS10 package.
-!
-! Arguments: S - absolute salinity in g/kg.
-! (in) pres - pressure in Pa.
-! (out) T_Fr - Freezing point conservative temperature in deg C.
+
+ ! Local variables
real, dimension(1) :: S0, pres0
real, dimension(1) :: tfr0
@@ -174,7 +141,7 @@ subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr)
end subroutine calculate_TFreeze_teos10_scalar
-!> This subroutine computes the freezing point conservative temparature
+!> This subroutine computes the freezing point conservative temperature
!! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the
!! TEOS10 package.
subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts)
@@ -183,18 +150,9 @@ subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts)
real, dimension(:), intent(out) :: T_Fr !< Freezing point conservative temperature in deg C.
integer, intent(in) :: start !< the starting point in the arrays.
integer, intent(in) :: npts !< the number of values to calculate.
-! This subroutine computes the freezing point conservative temparature
-! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the
-! TEOS10 package.
-!
-! Arguments: S - absolute salinity in g/kg.
-! (in) pres - pressure in Pa.
-! (out) T_Fr - Freezing point conservative temperature in deg C.
-! * (in) start - the starting point in the arrays. *
-! * (in) npts - the number of values to calculate. *
+ ! Local variables
real, parameter :: Pa2db = 1.e-4 ! The conversion factor from Pa to dbar.
-
real :: zs,zp
integer :: j
! Assume sea-water contains no dissolved air.
@@ -209,7 +167,6 @@ subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts)
T_Fr(j) = gsw_ct_freezing_exact(zs,zp,saturation_fraction)
enddo
-
end subroutine calculate_TFreeze_teos10_array
end module MOM_TFreeze
diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90
index da90ef1ad7..df014dc7a5 100644
--- a/src/framework/MOM_checksums.F90
+++ b/src/framework/MOM_checksums.F90
@@ -1,3 +1,4 @@
+!> Routines to calculate checksums of various array and vector types
module MOM_checksums
! This file is part of MOM6. See LICENSE.md for the license.
@@ -16,69 +17,80 @@ module MOM_checksums
public :: chksum_general
public :: MOM_checksums_init
+!> Checksums a pair of arrays (2d or 3d) staggered at tracer points
interface hchksum_pair
module procedure chksum_pair_h_2d, chksum_pair_h_3d
end interface
+!> Checksums a pair velocity arrays (2d or 3d) staggered at C-grid locations
interface uvchksum
module procedure chksum_uv_2d, chksum_uv_3d
end interface
+!> Checksums an array (2d or 3d) staggered at C-grid u points.
interface uchksum
module procedure chksum_u_2d, chksum_u_3d
end interface
+!> Checksums an array (2d or 3d) staggered at C-grid v points.
interface vchksum
module procedure chksum_v_2d, chksum_v_3d
end interface
+!> Checksums a pair of arrays (2d or 3d) staggered at corner points
interface Bchksum_pair
module procedure chksum_pair_B_2d, chksum_pair_B_3d
end interface
+!> Checksums an array (2d or 3d) staggered at tracer points.
interface hchksum
module procedure chksum_h_2d, chksum_h_3d
end interface
+!> Checksums an array (2d or 3d) staggered at corner points.
interface Bchksum
module procedure chksum_B_2d, chksum_B_3d
end interface
-! This is an older interface that has been renamed Bchksum
+!> This is an older interface that has been renamed Bchksum
interface qchksum
module procedure chksum_B_2d, chksum_B_3d
end interface
+!> This is an older interface for 1-, 2-, or 3-D checksums
interface chksum
module procedure chksum1d, chksum2d, chksum3d
end interface
+!> Write a message with either checksums or numerical statistics of arrays
interface chk_sum_msg
module procedure chk_sum_msg1, chk_sum_msg2, chk_sum_msg3, chk_sum_msg5
end interface
+!> Returns .true. if any element of x is a NaN, and .false. otherwise.
interface is_NaN
module procedure is_NaN_0d, is_NaN_1d, is_NaN_2d, is_NaN_3d
end interface
+!> Return the bitcount of an array
interface chksum_general
module procedure chksum_general_1d, chksum_general_2d, chksum_general_3d
end interface
-integer, parameter :: default_shift=0
-logical :: calculateStatistics=.true. ! If true, report min, max and mean.
-logical :: writeChksums=.true. ! If true, report the bitcount checksum
-logical :: checkForNaNs=.true. ! If true, checks array for NaNs and cause
- ! FATAL error is any are found
+integer, parameter :: default_shift=0 !< The default array shift
+logical :: calculateStatistics=.true. !< If true, report min, max and mean.
+logical :: writeChksums=.true. !< If true, report the bitcount checksum
+logical :: checkForNaNs=.true. !< If true, checks array for NaNs and cause
+ !! FATAL error is any are found
contains
-! =====================================================================
-
+!> Checksums on a pair of 2d arrays staggered at tracer points.
subroutine chksum_pair_h_2d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, scale)
character(len=*), intent(in) :: mesg !< Identifying messages
type(hor_index_type), intent(in) :: HI !< A horizontal index type
- real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayA, arrayB !< The arrays to be checksummed
+ real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayA !< The first array to be checksummed
+ real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayB !< The second array to be checksummed
integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0)
logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts
real, optional, intent(in) :: scale !< A scaling factor for this array.
@@ -93,10 +105,12 @@ subroutine chksum_pair_h_2d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, s
end subroutine chksum_pair_h_2d
+!> Checksums on a pair of 3d arrays staggered at tracer points.
subroutine chksum_pair_h_3d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, scale)
character(len=*), intent(in) :: mesg !< Identifying messages
type(hor_index_type), intent(in) :: HI !< A horizontal index type
- real, dimension(HI%isd:,HI%jsd:, :), intent(in) :: arrayA, arrayB !< The arrays to be checksummed
+ real, dimension(HI%isd:,HI%jsd:, :), intent(in) :: arrayA !< The first array to be checksummed
+ real, dimension(HI%isd:,HI%jsd:, :), intent(in) :: arrayB !< The second array to be checksummed
integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0)
logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts
real, optional, intent(in) :: scale !< A scaling factor for this array.
@@ -111,7 +125,7 @@ subroutine chksum_pair_h_3d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, s
end subroutine chksum_pair_h_3d
-!> chksum_h_2d performs checksums on a 2d array staggered at tracer points.
+!> Checksums a 2d array staggered at tracer points.
subroutine chksum_h_2d(array, mesg, HI, haloshift, omit_corners, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed
@@ -191,8 +205,9 @@ subroutine chksum_h_2d(array, mesg, HI, haloshift, omit_corners, scale)
integer function subchk(array, HI, di, dj, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed
- integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum
- real, intent(in) :: scale !< A scaling factor for this array.
+ integer, intent(in) :: di !< i- direction array shift for this checksum
+ integer, intent(in) :: dj !< j- direction array shift for this checksum
+ real, intent(in) :: scale !< A scaling factor for this array.
integer :: i, j, bc
subchk = 0
do j=HI%jsc+dj,HI%jec+dj; do i=HI%isc+di,HI%iec+di
@@ -229,12 +244,12 @@ end subroutine subStats
end subroutine chksum_h_2d
-! =====================================================================
-
+!> Checksums on a pair of 2d arrays staggered at q-points.
subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit_corners, scale)
character(len=*), intent(in) :: mesg !< Identifying messages
type(hor_index_type), intent(in) :: HI !< A horizontal index type
- real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayA, arrayB !< The arrays to be checksummed
+ real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayA !< The first array to be checksummed
+ real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayB !< The second array to be checksummed
logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full
!! symmetric computational domain.
integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0)
@@ -257,10 +272,12 @@ subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit
end subroutine chksum_pair_B_2d
+!> Checksums on a pair of 3d arrays staggered at q-points.
subroutine chksum_pair_B_3d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit_corners, scale)
character(len=*), intent(in) :: mesg !< Identifying messages
type(hor_index_type), intent(in) :: HI !< A horizontal index type
- real, dimension(HI%IsdB:,HI%JsdB:, :), intent(in) :: arrayA, arrayB !< The arrays to be checksummed
+ real, dimension(HI%IsdB:,HI%JsdB:, :), intent(in) :: arrayA !< The first array to be checksummed
+ real, dimension(HI%IsdB:,HI%JsdB:, :), intent(in) :: arrayB !< The second array to be checksummed
integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0)
logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full
!! symmetric computational domain.
@@ -281,7 +298,7 @@ subroutine chksum_pair_B_3d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit
end subroutine chksum_pair_B_3d
-!> chksum_B_2d performs checksums on a 2d array staggered at corner points.
+!> Checksums a 2d array staggered at corner points.
subroutine chksum_B_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%IsdB:,HI%JsdB:), &
@@ -377,8 +394,9 @@ subroutine chksum_B_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal
integer function subchk(array, HI, di, dj, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed
- integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum
- real, intent(in) :: scale !< A scaling factor for this array.
+ integer, intent(in) :: di !< i- direction array shift for this checksum
+ integer, intent(in) :: dj !< j- direction array shift for this checksum
+ real, intent(in) :: scale !< A scaling factor for this array.
integer :: i, j, bc
subchk = 0
! This line deliberately uses the h-point computational domain.
@@ -420,8 +438,7 @@ end subroutine subStats
end subroutine chksum_B_2d
-! =====================================================================
-
+!> Checksums a pair of 2d velocity arrays staggered at C-grid locations
subroutine chksum_uv_2d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_corners, scale)
character(len=*), intent(in) :: mesg !< Identifying messages
type(hor_index_type), intent(in) :: HI !< A horizontal index type
@@ -443,6 +460,7 @@ subroutine chksum_uv_2d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_cor
end subroutine chksum_uv_2d
+!> Checksums a pair of 3d velocity arrays staggered at C-grid locations
subroutine chksum_uv_3d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_corners, scale)
character(len=*), intent(in) :: mesg !< Identifying messages
type(hor_index_type), intent(in) :: HI !< A horizontal index type
@@ -464,7 +482,7 @@ subroutine chksum_uv_3d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_cor
end subroutine chksum_uv_3d
-!> chksum_u_2d performs checksums on a 2d array staggered at C-grid u points.
+!> Checksums a 2d array staggered at C-grid u points.
subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed
@@ -565,8 +583,9 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal
integer function subchk(array, HI, di, dj, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed
- integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum
- real, intent(in) :: scale !< A scaling factor for this array.
+ integer, intent(in) :: di !< i- direction array shift for this checksum
+ integer, intent(in) :: dj !< j- direction array shift for this checksum
+ real, intent(in) :: scale !< A scaling factor for this array.
integer :: i, j, bc
subchk = 0
! This line deliberately uses the h-point computational domain.
@@ -607,9 +626,7 @@ end subroutine subStats
end subroutine chksum_u_2d
-! =====================================================================
-
-!> chksum_v_2d performs checksums on a 2d array staggered at C-grid v points.
+!> Checksums a 2d array staggered at C-grid v points.
subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed
@@ -710,8 +727,9 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal
integer function subchk(array, HI, di, dj, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed
- integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum
- real, intent(in) :: scale !< A scaling factor for this array.
+ integer, intent(in) :: di !< i- direction array shift for this checksum
+ integer, intent(in) :: dj !< j- direction array shift for this checksum
+ real, intent(in) :: scale !< A scaling factor for this array.
integer :: i, j, bc
subchk = 0
! This line deliberately uses the h-point computational domain.
@@ -752,9 +770,7 @@ end subroutine subStats
end subroutine chksum_v_2d
-! =====================================================================
-
-!> chksum_h_3d performs checksums on a 3d array staggered at tracer points.
+!> Checksums a 3d array staggered at tracer points.
subroutine chksum_h_3d(array, mesg, HI, haloshift, omit_corners, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed
@@ -837,8 +853,9 @@ subroutine chksum_h_3d(array, mesg, HI, haloshift, omit_corners, scale)
integer function subchk(array, HI, di, dj, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed
- integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum
- real, intent(in) :: scale !< A scaling factor for this array.
+ integer, intent(in) :: di !< i- direction array shift for this checksum
+ integer, intent(in) :: dj !< j- direction array shift for this checksum
+ real, intent(in) :: scale !< A scaling factor for this array.
integer :: i, j, k, bc
subchk = 0
do k=LBOUND(array,3),UBOUND(array,3) ; do j=HI%jsc+dj,HI%jec+dj ; do i=HI%isc+di,HI%iec+di
@@ -875,9 +892,7 @@ end subroutine subStats
end subroutine chksum_h_3d
-! =====================================================================
-
-!> chksum_B_3d performs checksums on a 3d array staggered at corner points.
+!> Checksums a 3d array staggered at corner points.
subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed
@@ -978,8 +993,9 @@ subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal
integer function subchk(array, HI, di, dj, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed
- integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum
- real, intent(in) :: scale !< A scaling factor for this array.
+ integer, intent(in) :: di !< i- direction array shift for this checksum
+ integer, intent(in) :: dj !< j- direction array shift for this checksum
+ real, intent(in) :: scale !< A scaling factor for this array.
integer :: i, j, k, bc
subchk = 0
! This line deliberately uses the h-point computational domain.
@@ -1020,9 +1036,7 @@ end subroutine subStats
end subroutine chksum_B_3d
-! =====================================================================
-
-!> chksum_u_3d performs checksums on a 3d array staggered at C-grid u points.
+!> Checksums a 3d array staggered at C-grid u points.
subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%isdB:,HI%Jsd:,:), intent(in) :: array !< The array to be checksummed
@@ -1123,8 +1137,9 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal
integer function subchk(array, HI, di, dj, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed
- integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum
- real, intent(in) :: scale !< A scaling factor for this array.
+ integer, intent(in) :: di !< i- direction array shift for this checksum
+ integer, intent(in) :: dj !< j- direction array shift for this checksum
+ real, intent(in) :: scale !< A scaling factor for this array.
integer :: i, j, k, bc
subchk = 0
! This line deliberately uses the h-point computational domain.
@@ -1165,7 +1180,6 @@ end subroutine subStats
end subroutine chksum_u_3d
-!---chksum_general interface routines
!> Return the bitcount of an arbitrarily sized 3d array
integer function chksum_general_3d( array, scale_factor, istart, iend, jstart, jend, kstart, kend ) &
result(subchk)
@@ -1238,9 +1252,7 @@ integer function chksum_general_1d( array_1d, scale_factor, istart, iend )
deallocate(array_3d)
end function chksum_general_1d
-! =====================================================================
-
-!> chksum_v_3d performs checksums on a 3d array staggered at C-grid v points.
+!> Checksums a 3d array staggered at C-grid v points.
subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed
@@ -1341,8 +1353,9 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal
integer function subchk(array, HI, di, dj, scale)
type(hor_index_type), intent(in) :: HI !< A horizontal index type
real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed
- integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum
- real, intent(in) :: scale !< A scaling factor for this array.
+ integer, intent(in) :: di !< i- direction array shift for this checksum
+ integer, intent(in) :: dj !< j- direction array shift for this checksum
+ real, intent(in) :: scale !< A scaling factor for this array.
integer :: i, j, k, bc
subchk = 0
! This line deliberately uses the h-point computational domain.
@@ -1383,9 +1396,6 @@ end subroutine subStats
end subroutine chksum_v_3d
-
-! =====================================================================
-
! These are the older version of chksum that do not take the grid staggering
! into account.
@@ -1444,7 +1454,6 @@ subroutine chksum1d(array, mesg, start_i, end_i, compare_PEs)
end subroutine chksum1d
-! =====================================================================
! These are the older version of chksum that do not take the grid staggering
! into account.
@@ -1505,8 +1514,6 @@ subroutine chksum3d(array, mesg)
end subroutine chksum3d
-! =====================================================================
-
!> This function returns .true. if x is a NaN, and .false. otherwise.
function is_NaN_0d(x)
real, intent(in) :: x !< The value to be checked for NaNs.
@@ -1523,9 +1530,7 @@ function is_NaN_0d(x)
end function is_NaN_0d
-! =====================================================================
-
-!> This function returns .true. if any element of x is a NaN, and .false. otherwise.
+!> Returns .true. if any element of x is a NaN, and .false. otherwise.
function is_NaN_1d(x, skip_mpp)
real, dimension(:), intent(in) :: x !< The array to be checked for NaNs.
logical, optional, intent(in) :: skip_mpp !< If true, only check this array only
@@ -1548,9 +1553,7 @@ function is_NaN_1d(x, skip_mpp)
end function is_NaN_1d
-! =====================================================================
-
-!> This function returns .true. if any element of x is a NaN, and .false. otherwise.
+!> Returns .true. if any element of x is a NaN, and .false. otherwise.
function is_NaN_2d(x)
real, dimension(:,:), intent(in) :: x !< The array to be checked for NaNs.
logical :: is_NaN_2d
@@ -1567,9 +1570,7 @@ function is_NaN_2d(x)
end function is_NaN_2d
-! =====================================================================
-
-!> This function returns .true. if any element of x is a NaN, and .false. otherwise.
+!> Returns .true. if any element of x is a NaN, and .false. otherwise.
function is_NaN_3d(x)
real, dimension(:,:,:), intent(in) :: x !< The array to be checked for NaNs.
logical :: is_NaN_3d
@@ -1588,7 +1589,6 @@ function is_NaN_3d(x)
end function is_NaN_3d
-! =====================================================================
!> Write a message including the checksum of the non-shifted array
subroutine chk_sum_msg1(fmsg,bc0,mesg)
character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble
@@ -1597,29 +1597,32 @@ subroutine chk_sum_msg1(fmsg,bc0,mesg)
if (is_root_pe()) write(0,'(A,1(A,I10,X),A)') fmsg," c=",bc0,trim(mesg)
end subroutine chk_sum_msg1
-! =====================================================================
!> Write a message including checksums of non-shifted and diagonally shifted arrays
subroutine chk_sum_msg5(fmsg,bc0,bcSW,bcSE,bcNW,bcNE,mesg)
character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble
character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller
integer, intent(in) :: bc0 !< The bitcount of the non-shifted array
- integer, intent(in) :: bcSW,bcSE,bcNW,bcNE !< The bitcounts for 4 diagonal array shifts
+ integer, intent(in) :: bcSW !< The bitcount for SW shifted array
+ integer, intent(in) :: bcSE !< The bitcount for SE shifted array
+ integer, intent(in) :: bcNW !< The bitcount for NW shifted array
+ integer, intent(in) :: bcNE !< The bitcount for NE shifted array
if (is_root_pe()) write(0,'(A,5(A,I10,1X),A)') &
fmsg," c=",bc0,"sw=",bcSW,"se=",bcSE,"nw=",bcNW,"ne=",bcNE,trim(mesg)
end subroutine chk_sum_msg5
-! =====================================================================
!> Write a message including checksums of non-shifted and laterally shifted arrays
subroutine chk_sum_msg_NSEW(fmsg,bc0,bcN,bcS,bcE,bcW,mesg)
character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble
character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller
integer, intent(in) :: bc0 !< The bitcount of the non-shifted array
- integer, intent(in) :: bcN, bcS, bcE, bcW !< The bitcounts including 4 lateral array shifts
+ integer, intent(in) :: bcN !< The bitcount for N shifted array
+ integer, intent(in) :: bcS !< The bitcount for S shifted array
+ integer, intent(in) :: bcE !< The bitcount for E shifted array
+ integer, intent(in) :: bcW !< The bitcount for W shifted array
if (is_root_pe()) write(0,'(A,5(A,I10,1X),A)') &
fmsg," c=",bc0,"N=",bcN,"S=",bcS,"E=",bcE,"W=",bcW,trim(mesg)
end subroutine chk_sum_msg_NSEW
-! =====================================================================
!> Write a message including checksums of non-shifted and southward shifted arrays
subroutine chk_sum_msg_S(fmsg,bc0,bcS,mesg)
character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble
@@ -1630,7 +1633,6 @@ subroutine chk_sum_msg_S(fmsg,bc0,bcS,mesg)
fmsg," c=",bc0,"S=",bcS,trim(mesg)
end subroutine chk_sum_msg_S
-! =====================================================================
!> Write a message including checksums of non-shifted and westward shifted arrays
subroutine chk_sum_msg_W(fmsg,bc0,bcW,mesg)
character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble
@@ -1641,7 +1643,6 @@ subroutine chk_sum_msg_W(fmsg,bc0,bcW,mesg)
fmsg," c=",bc0,"W=",bcW,trim(mesg)
end subroutine chk_sum_msg_W
-! =====================================================================
!> Write a message including checksums of non-shifted and southwestward shifted arrays
subroutine chk_sum_msg2(fmsg,bc0,bcSW,mesg)
character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble
@@ -1652,18 +1653,17 @@ subroutine chk_sum_msg2(fmsg,bc0,bcSW,mesg)
fmsg," c=",bc0,"s/w=",bcSW,trim(mesg)
end subroutine chk_sum_msg2
-! =====================================================================
!> Write a message including the global mean, maximum and minimum of an array
subroutine chk_sum_msg3(fmsg,aMean,aMin,aMax,mesg)
character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble
character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller
- real, intent(in) :: aMean,aMin,aMax !< The mean, minimum and maximum of the array
+ real, intent(in) :: aMean !< The mean value of the array
+ real, intent(in) :: aMin !< The minimum value of the array
+ real, intent(in) :: aMax !< The maximum value of the array
if (is_root_pe()) write(0,'(A,3(A,ES25.16,1X),A)') &
fmsg," mean=",aMean,"min=",aMin,"max=",aMax,trim(mesg)
end subroutine chk_sum_msg3
-! =====================================================================
-
!> MOM_checksums_init initializes the MOM_checksums module. As it happens, the
!! only thing that it does is to log the version of this module.
subroutine MOM_checksums_init(param_file)
@@ -1676,7 +1676,6 @@ subroutine MOM_checksums_init(param_file)
end subroutine MOM_checksums_init
-! =====================================================================
!> A wrapper for MOM_error used in the checksum code
subroutine chksum_error(signal, message)
! Wrapper for MOM_error to help place specific break points in debuggers
@@ -1703,6 +1702,5 @@ integer function bitcount( x )
enddo
end function bitcount
-! =====================================================================
end module MOM_checksums
diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90
index f8e58d2072..47601db679 100644
--- a/src/framework/MOM_coms.F90
+++ b/src/framework/MOM_coms.F90
@@ -1,3 +1,5 @@
+!> Interfaces to non-domain-oriented communication subroutines, including the
+!! MOM6 reproducing sums facility
module MOM_coms
! This file is part of MOM6. See LICENSE.md for the license.
@@ -23,38 +25,47 @@ module MOM_coms
! This module provides interfaces to the non-domain-oriented communication
! subroutines.
-integer(kind=8), parameter :: prec=2_8**46 ! The precision of each integer.
-real, parameter :: r_prec=2.0**46 ! A real version of prec.
-real, parameter :: I_prec=1.0/(2.0**46) ! The inverse of prec.
+integer(kind=8), parameter :: prec=2_8**46 !< The precision of each integer.
+real, parameter :: r_prec=2.0**46 !< A real version of prec.
+real, parameter :: I_prec=1.0/(2.0**46) !< The inverse of prec.
integer, parameter :: max_count_prec=2**(63-46)-1
- ! The number of values that can be added together
- ! with the current value of prec before there will
- ! be roundoff problems.
+ !< The number of values that can be added together
+ !! with the current value of prec before there will
+ !! be roundoff problems.
-integer, parameter :: ni=6 ! The number of long integers to use to represent
- ! a real number.
+integer, parameter :: ni=6 !< The number of long integers to use to represent
+ !< a real number.
real, parameter, dimension(ni) :: &
pr = (/ r_prec**2, r_prec, 1.0, 1.0/r_prec, 1.0/r_prec**2, 1.0/r_prec**3 /)
+ !< An array of the real precision of each of the integers
real, parameter, dimension(ni) :: &
I_pr = (/ 1.0/r_prec**2, 1.0/r_prec, 1.0, r_prec, r_prec**2, r_prec**3 /)
+ !< An array of the inverse of thereal precision of each of the integers
-logical :: overflow_error = .false., NaN_error = .false.
-logical :: debug = .false. ! Making this true enables debugging output.
+logical :: overflow_error = .false. !< This becomes true if an overflow is encountered.
+logical :: NaN_error = .false. !< This becomes true if a NaN is encountered.
+logical :: debug = .false. !< Making this true enables debugging output.
+!> Find an accurate and order-invariant sum of distributed 2d or 3d fields
interface reproducing_sum
module procedure reproducing_sum_2d, reproducing_sum_3d
end interface reproducing_sum
-! The Extended Fixed Point (EFP) type provides a public interface for doing sums
-! and taking differences with this type. The use of this type is documented in
-! Hallberg, R. & A. Adcroft, 2014: An Order-invariant Real-to-Integer Conversion Sum.
-! Parallel Computing, 40(5-6), doi:10.1016/j.parco.2014.04.007.
+!> The Extended Fixed Point (EFP) type provides a public interface for doing sums
+!! and taking differences with this type.
+!!
+!! The use of this type is documented in
+!! Hallberg, R. & A. Adcroft, 2014: An Order-invariant Real-to-Integer Conversion Sum.
+!! Parallel Computing, 40(5-6), doi:10.1016/j.parco.2014.04.007.
type, public :: EFP_type ; private
- integer(kind=8), dimension(ni) :: v
+ integer(kind=8), dimension(ni) :: v !< The value in this type
end type EFP_type
+!> Add two extended-fixed-point numbers
interface operator (+) ; module procedure EFP_plus ; end interface
+!> Subtract one extended-fixed-point number from another
interface operator (-) ; module procedure EFP_minus ; end interface
+!> Copy the value of one extended-fixed-point number into another
interface assignment(=); module procedure EFP_assign ; end interface
contains
@@ -456,7 +467,7 @@ end function ints_to_real
subroutine increment_ints(int_sum, int2, prec_error)
integer(kind=8), dimension(ni), intent(inout) :: int_sum !< The array of EFP integers being incremented
integer(kind=8), dimension(ni), intent(in) :: int2 !< The array of EFP integers being added
- integer(kind=8), optional, intent(in) :: prec_error !!< The PE-count dependent precision of the
+ integer(kind=8), optional, intent(in) :: prec_error !< The PE-count dependent precision of the
!! integers that is safe from overflows during global
!! sums. This will be larger than the compile-time
!! precision parameter, and is used to detect overflows.
@@ -671,7 +682,7 @@ function real_to_EFP(val, overflow)
end function real_to_EFP
-!< This subroutine does a sum across PEs of a list of EFP variables,
+!> This subroutine does a sum across PEs of a list of EFP variables,
!! returning the sums in place, with all overflows carried.
subroutine EFP_list_sum_across_PEs(EFPs, nval, errors)
type(EFP_type), dimension(:), &
@@ -721,12 +732,9 @@ subroutine EFP_list_sum_across_PEs(EFPs, nval, errors)
end subroutine EFP_list_sum_across_PEs
-!< This subroutine carries out all of the calls required to close out the infrastructure cleanly.
+!> This subroutine carries out all of the calls required to close out the infrastructure cleanly.
!! This should only be called in ocean-only runs, as the coupler takes care of this in coupled runs.
subroutine MOM_infra_end
- ! This subroutine should contain all of the calls that are required
- ! to close out the infrastructure cleanly. This should only be called
- ! in ocean-only runs, as the coupler takes care of this in coupled runs.
call print_memuse_stats( 'Memory HiWaterMark', always=.TRUE. )
call fms_end
end subroutine MOM_infra_end
diff --git a/src/framework/MOM_constants.F90 b/src/framework/MOM_constants.F90
index 84c82069d0..2db177e08c 100644
--- a/src/framework/MOM_constants.F90
+++ b/src/framework/MOM_constants.F90
@@ -7,6 +7,7 @@ module MOM_constants
implicit none ; private
+!> The constant offset for converting temperatures in Kelvin to Celsius
real, public, parameter :: CELSIUS_KELVIN_OFFSET = 273.15
public :: HLV, HLF
diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90
index 6a148d1878..a4c1787855 100644
--- a/src/framework/MOM_diag_mediator.F90
+++ b/src/framework/MOM_diag_mediator.F90
@@ -1,13 +1,9 @@
+!> The subroutines here provide convenient wrappers to the fms diag_manager
+!! interfaces with additional diagnostic capabilies.
module MOM_diag_mediator
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* The subroutines here provide convenient wrappers to the fms *
-!* diag_manager interfaces with additional diagnostic capabilies. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
use MOM_checksums, only : chksum_general
use MOM_coms, only : PE_here
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
@@ -66,8 +62,9 @@ module MOM_diag_mediator
public diag_copy_diag_to_storage, diag_copy_storage_to_diag
public diag_save_grids, diag_restore_grids
+!> Make a diagnostic available for averaging or output.
interface post_data
- module procedure post_data_3d, post_data_2d, post_data_0d
+ module procedure post_data_3d, post_data_2d, post_data_1d_k, post_data_0d
end interface post_data
!> A group of 1D axes that comprise a 1D/2D/3D mesh
@@ -126,6 +123,7 @@ module MOM_diag_mediator
end type diag_grid_storage
!> This type is used to represent a diagnostic at the diag_mediator level.
+!!
!! There can be both 'primary' and 'seconday' diagnostics. The primaries
!! reside in the diag_cs%diags array. They have an id which is an index
!! into this array. The secondaries are 'variations' on the primary diagnostic.
@@ -136,8 +134,8 @@ module MOM_diag_mediator
integer :: fms_diag_id !< Underlying FMS diag_manager id.
integer :: fms_xyave_diag_id = -1 !< For a horizontally area-averaged diagnostic.
character(64) :: debug_str = '' !< For FATAL errors and debugging.
- type(axes_grp), pointer :: axes => null()
- type(diag_type), pointer :: next => null() !< Pointer to the next diag.
+ type(axes_grp), pointer :: axes => null() !< The axis group for this diagnostic
+ type(diag_type), pointer :: next => null() !< Pointer to the next diagnostic
real :: conversion_factor = 0. !< A factor to multiply data by before posting to FMS, if non-zero.
logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated).
!! False for intensive (concentrations).
@@ -153,41 +151,53 @@ module MOM_diag_mediator
logical :: diag_as_chksum !< If true, log chksums in a text file instead of posting diagnostics
! The following fields are used for the output of the data.
- integer :: is, ie, js, je
- integer :: isd, ied, jsd, jed
+ integer :: is !< The start i-index of cell centers within the computational domain
+ integer :: ie !< The end i-index of cell centers within the computational domain
+ integer :: js !< The start j-index of cell centers within the computational domain
+ integer :: je !< The end j-index of cell centers within the computational domain
+
+ integer :: isd !< The start i-index of cell centers within the data domain
+ integer :: ied !< The end i-index of cell centers within the data domain
+ integer :: jsd !< The start j-index of cell centers within the data domain
+ integer :: jed !< The end j-index of cell centers within the data domain
real :: time_int !< The time interval in s for any fields
!! that are offered for averaging.
type(time_type) :: time_end !< The end time of the valid
!! interval for any offered field.
logical :: ave_enabled = .false. !< True if averaging is enabled.
- ! The following are axis types defined for output.
+ !>@{ The following are 3D and 2D axis groups defined for output. The names
+ !! indicate the horizontal (B, T, Cu, or Cv) and vertical (L, i, or 1) locations.
type(axes_grp) :: axesBL, axesTL, axesCuL, axesCvL
type(axes_grp) :: axesBi, axesTi, axesCui, axesCvi
type(axes_grp) :: axesB1, axesT1, axesCu1, axesCv1
- type(axes_grp) :: axesZi, axesZL, axesNull
-
- ! Mask arrays for diagnostics
- real, dimension(:,:), pointer :: mask2dT => null()
- real, dimension(:,:), pointer :: mask2dBu => null()
- real, dimension(:,:), pointer :: mask2dCu => null()
- real, dimension(:,:), pointer :: mask2dCv => null()
+ !!@}
+ type(axes_grp) :: axesZi !< A 1-D z-space axis at interfaces
+ type(axes_grp) :: axesZL !< A 1-D z-space axis at layer centers
+ type(axes_grp) :: axesNull !< An axis group for scalars
+
+ real, dimension(:,:), pointer :: mask2dT => null() !< 2D mask array for cell-center points
+ real, dimension(:,:), pointer :: mask2dBu => null() !< 2D mask array for cell-corner points
+ real, dimension(:,:), pointer :: mask2dCu => null() !< 2D mask array for east-face points
+ real, dimension(:,:), pointer :: mask2dCv => null() !< 2D mask array for north-face points
+ !>@{ 3D mask arrays for diagnostics at layers (mask...L) and interfaces (mask...i)
real, dimension(:,:,:), pointer :: mask3dTL => null()
- real, dimension(:,:,:), pointer :: mask3dBL => null()
+ real, dimension(:,:,:), pointer :: mask3dBL => null()
real, dimension(:,:,:), pointer :: mask3dCuL => null()
real, dimension(:,:,:), pointer :: mask3dCvL => null()
real, dimension(:,:,:), pointer :: mask3dTi => null()
- real, dimension(:,:,:), pointer :: mask3dBi => null()
+ real, dimension(:,:,:), pointer :: mask3dBi => null()
real, dimension(:,:,:), pointer :: mask3dCui => null()
real, dimension(:,:,:), pointer :: mask3dCvi => null()
+ !!@}
! Space for diagnostics is dynamically allocated as it is needed.
! The chunk size is how much the array should grow on each new allocation.
#define DIAG_ALLOC_CHUNK_SIZE 100
- type(diag_type), dimension(:), allocatable :: diags
- integer :: next_free_diag_id
+ type(diag_type), dimension(:), allocatable :: diags !< The list of diagnostics
+ integer :: next_free_diag_id !< The next unused diagnostic ID
- !default missing value to be sent to ALL diagnostics registrations
+ !> default missing value to be sent to ALL diagnostics registrations
real :: missing_value = -1.0e+34
!> Number of diagnostic vertical coordinates (remapped)
@@ -197,20 +207,23 @@ module MOM_diag_mediator
type(diag_grid_storage) :: diag_grid_temp !< Stores the remapped diagnostic grid
logical :: diag_grid_overridden = .false. !< True if the diagnostic grids have been overriden
- !> Axes groups for each possible coordinate (these will all be 3D groups)
- type(axes_grp), dimension(:), allocatable :: remap_axesZL, remap_axesZi
+ type(axes_grp), dimension(:), allocatable :: &
+ remap_axesZL, & !< The 1-D z-space cell-centered axis for remapping
+ remap_axesZi !< The 1-D z-space interface axis for remapping
+ !!@{
type(axes_grp), dimension(:), allocatable :: remap_axesTL, remap_axesBL, remap_axesCuL, remap_axesCvL
type(axes_grp), dimension(:), allocatable :: remap_axesTi, remap_axesBi, remap_axesCui, remap_axesCvi
+ !!@}
! Pointer to H, G and T&S needed for remapping
- real, dimension(:,:,:), pointer :: h => null()
- real, dimension(:,:,:), pointer :: T => null()
- real, dimension(:,:,:), pointer :: S => null()
- type(EOS_type), pointer :: eqn_of_state => null()
- type(ocean_grid_type), pointer :: G => null()
- type(verticalGrid_type), pointer :: GV => null()
-
- ! The volume cell measure (special diagnostic) manager id
+ real, dimension(:,:,:), pointer :: h => null() !< The thicknesses needed for remapping
+ real, dimension(:,:,:), pointer :: T => null() !< The temperatures needed for remapping
+ real, dimension(:,:,:), pointer :: S => null() !< The salinities needed for remapping
+ type(EOS_type), pointer :: eqn_of_state => null() !< The equation of state type
+ type(ocean_grid_type), pointer :: G => null() !< The ocean grid type
+ type(verticalGrid_type), pointer :: GV => null() !< The model's vertical ocean grid
+
+ !> The volume cell measure (special diagnostic) manager id
integer :: volume_cell_measure_dm_id = -1
#if defined(DEBUG) || defined(__DO_SAFETY_CHECKS__)
@@ -416,7 +429,7 @@ subroutine set_masks_for_axes(G, diag_cs)
!! used for diagnostics
! Local variables
integer :: c, nk, i, j, k
- type(axes_grp), pointer :: axes, h_axes ! Current axes, for convenience
+ type(axes_grp), pointer :: axes => NULL(), h_axes => NULL() ! Current axes, for convenience
do c=1, diag_cs%num_diag_coords
! This vertical coordinate has been configured so can be used.
@@ -555,7 +568,7 @@ subroutine diag_associate_volume_cell_measure(diag_cs, id_h_volume)
type(diag_ctrl), intent(inout) :: diag_cs !< Diagnostics control structure
integer, intent(in) :: id_h_volume !< Diag_manager id for volume of h-cells
! Local variables
- type(diag_type), pointer :: tmp
+ type(diag_type), pointer :: tmp => NULL()
if (id_h_volume<=0) return ! Do nothing
diag_cs%volume_cell_measure_dm_id = id_h_volume ! Record for diag_get_volume_cell_measure_dm_id()
@@ -696,10 +709,6 @@ subroutine set_diag_mediator_grid(G, diag_cs)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output
-! Arguments:
-! (inout) G - ocean grid structure
-! (inout) diag - structure used to regulate diagnostic output
-
diag_cs%is = G%isc - (G%isd-1) ; diag_cs%ie = G%iec - (G%isd-1)
diag_cs%js = G%jsc - (G%jsd-1) ; diag_cs%je = G%jec - (G%jsd-1)
diag_cs%isd = G%isd ; diag_cs%ied = G%ied
@@ -715,14 +724,7 @@ subroutine post_data_0d(diag_field_id, field, diag_cs, is_static)
type(diag_ctrl), target, intent(in) :: diag_CS !< Structure used to regulate diagnostic output
logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered.
-! Arguments:
-! (in) diag_field_id - the id for an output variable returned by a
-! previous call to register_diag_field.
-! (in) field - 0-d array being offered for output or averaging.
-! (inout) diag_cs - structure used to regulate diagnostic output.
-! (in,opt) is_static - If true, this is a static field that is always offered.
-! (in,opt) mask - If present, use this real array as the data mask.
-
+ ! Local variables
logical :: used, is_stat
type(diag_type), pointer :: diag => null()
@@ -750,20 +752,15 @@ end subroutine post_data_0d
subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static)
integer, intent(in) :: diag_field_id !< The id for an output variable returned by a
!! previous call to register_diag_field.
- real, intent(in) :: field(:) !< 1-d array being offered for output or averaging
+ real, target, intent(in) :: field(:) !< 1-d array being offered for output or averaging
type(diag_ctrl), target, intent(in) :: diag_CS !< Structure used to regulate diagnostic output
logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered.
-! Arguments:
-! (in) diag_field_id - id for an output variable returned by a
-! previous call to register_diag_field.
-! (in) field - 1-d array being offered for output or averaging
-! (inout) diag_cs - structure used to regulate diagnostic output
-! (in) static - If true, this is a static field that is always offered.
-
+ ! Local variables
logical :: used ! The return value of send_data is not used for anything.
+ real, dimension(:), pointer :: locfield => NULL()
logical :: is_stat
- integer :: isv, iev, jsv, jev
+ integer :: k, ks, ke
type(diag_type), pointer :: diag => null()
if (id_clock_diag_mediator>0) call cpu_clock_begin(id_clock_diag_mediator)
@@ -774,11 +771,29 @@ subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static)
'post_data_1d_k: Unregistered diagnostic id')
diag => diag_cs%diags(diag_field_id)
do while (associated(diag))
+
+ if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then
+ ks = lbound(field,1) ; ke = ubound(field,1)
+ allocate( locfield( ks:ke ) )
+
+ do k=ks,ke
+ if (field(k) == diag_cs%missing_value) then
+ locfield(k) = diag_cs%missing_value
+ else
+ locfield(k) = field(k) * diag%conversion_factor
+ endif
+ enddo
+ else
+ locfield => field
+ endif
+
if (is_stat) then
- used = send_data(diag%fms_diag_id, field)
+ used = send_data(diag%fms_diag_id, locfield)
elseif (diag_cs%ave_enabled) then
- used = send_data(diag%fms_diag_id, field, diag_cs%time_end, weight=diag_cs%time_int)
+ used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, weight=diag_cs%time_int)
endif
+ if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield )
+
diag => diag%next
enddo
@@ -794,14 +809,7 @@ subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask)
logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered.
real, optional, intent(in) :: mask(:,:) !< If present, use this real array as the data mask.
-! Arguments:
-! (in) diag_field_id - id for an output variable returned by a
-! previous call to register_diag_field.
-! (in) field - 2-d array being offered for output or averaging.
-! (inout) diag_cs - structure used to regulate diagnostic output.
-! (in,opt) is_static - If true, this is a static field that is always offered.
-! (in,opt) mask - If present, use this real array as the data mask.
-
+ ! Local variables
type(diag_type), pointer :: diag => null()
if (id_clock_diag_mediator>0) call cpu_clock_begin(id_clock_diag_mediator)
@@ -811,7 +819,7 @@ subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask)
'post_data_2d: Unregistered diagnostic id')
diag => diag_cs%diags(diag_field_id)
do while (associated(diag))
- call post_data_2d_low(diag, field, diag_cs, is_static, mask)
+ call post_data_2d_low(diag, field, diag_cs, is_static, mask)
diag => diag%next
enddo
@@ -827,13 +835,7 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask)
logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered.
real, optional, intent(in) :: mask(:,:) !< If present, use this real array as the data mask.
-! Arguments:
-! (in) diag - structure representing the diagnostic to post
-! (in) field - 2-d array being offered for output or averaging
-! (inout) diag_cs - structure used to regulate diagnostic output
-! (in,opt) is_static - If true, this is a static field that is always offered.
-! (in,opt) mask - If present, use this real array as the data mask.
-
+ ! Local variables
real, dimension(:,:), pointer :: locfield => NULL()
character(len=300) :: mesg
logical :: used, is_stat
@@ -947,19 +949,12 @@ subroutine post_data_3d(diag_field_id, field, diag_cs, is_static, mask, alt_h)
target, optional, intent(in) :: alt_h !< An alternate thickness to use for vertically
!! remapping this diagnostic, in H.
-! Arguments:
-! (in) diag_field_id - id for an output variable returned by a
-! previous call to register_diag_field.
-! (in) field - 3-d array being offered for output or averaging
-! (inout) diag - structure used to regulate diagnostic output
-! (in) static - If true, this is a static field that is always offered.
-! (in,opt) mask - If present, use this real array as the data mask.
-
+ ! Local variables
type(diag_type), pointer :: diag => null()
integer :: nz, i, j, k
real, dimension(:,:,:), allocatable :: remapped_field
logical :: staggered_in_x, staggered_in_y
- real, dimension(:,:,:), pointer :: h_diag
+ real, dimension(:,:,:), pointer :: h_diag => NULL()
if (present(alt_h)) then
h_diag => alt_h
@@ -1070,13 +1065,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask)
logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered.
real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask.
-! Arguments:
-! (in) diag - the diagnostic to post.
-! (in) field - 3-d array being offered for output or averaging
-! (inout) diag_cs - structure used to regulate diagnostic output
-! (in) static - If true, this is a static field that is always offered.
-! (in,opt) mask - If present, use this real array as the data mask.
-
+ ! Local variables
real, dimension(:,:,:), pointer :: locfield => NULL()
character(len=300) :: mesg
logical :: used ! The return value of send_data is not used for anything.
@@ -1260,12 +1249,6 @@ subroutine enable_averaging(time_int_in, time_end_in, diag_cs)
! This subroutine enables the accumulation of time averages over the
! specified time interval.
-! Arguments:
-! (in) time_int_in - time interval in s over which any
-! values that are offered are valid.
-! (in) time_end_in - end time of the valid interval
-! (inout) diag - structure used to regulate diagnostic output
-
! if (num_file==0) return
diag_cs%time_int = time_int_in
diag_cs%time_end = time_end_in
@@ -1276,9 +1259,6 @@ end subroutine enable_averaging
subroutine disable_averaging(diag_cs)
type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output
-! Argument:
-! diag - structure used to regulate diagnostic output
-
diag_cs%time_int = 0.0
diag_cs%ave_enabled = .false.
@@ -1292,11 +1272,6 @@ function query_averaging_enabled(diag_cs, time_int, time_end)
type(time_type), optional, intent(out) :: time_end !< Current setting of diag%time_end
logical :: query_averaging_enabled
-! Arguments:
-! (in) diag - structure used to regulate diagnostic output
-! (out,opt) time_int - current setting of diag%time_int, in s
-! (out,opt) time_end - current setting of diag%time_end
-
if (present(time_int)) time_int = diag_cs%time_int
if (present(time_end)) time_end = diag_cs%time_end
query_averaging_enabled = diag_cs%ave_enabled
@@ -1844,7 +1819,7 @@ function register_scalar_field(module_name, field_name, init_time, diag_cs, &
long_name, units, missing_value, range, standard_name, &
do_not_log, err_msg, interp_method, cmor_field_name, &
cmor_long_name, cmor_units, cmor_standard_name)
- integer :: register_scalar_field
+ integer :: register_scalar_field !< An integer handle for a diagnostic array.
character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model"
!! or "ice_shelf_model"
character(len=*), intent(in) :: field_name !< Name of the diagnostic field
@@ -1865,25 +1840,7 @@ function register_scalar_field(module_name, field_name, init_time, diag_cs, &
character(len=*), optional, intent(in) :: cmor_units !< CMOR units of a field
character(len=*), optional, intent(in) :: cmor_standard_name !< CMOR standardized name associated with a field
- ! Output: An integer handle for a diagnostic array.
- ! Arguments:
- ! (in) module_name - name of this module, usually "ocean_model" or "ice_shelf_model".
- ! (in) field_name - name of the diagnostic field.
- ! (in) init_time - time at which a field is first available?
- ! (inout) diag_cs - structure used to regulate diagnostic output
- ! (in,opt) long_name - long name of a field
- ! (in,opt) units - units of a field
- ! (in,opt) missing_value - indicates missing values
- ! (in,opt) standard_name - standardized name associated with a field
-
- ! Following params have yet to be used in MOM.
- ! (in,opt) range - valid range of a variable
- ! (in,opt) verbose - If true, FMS is verbosed
- ! (in,opt) do_not_log - If true, do not log something
- ! (out,opt) err_msg - character string into which an error message might be placed
- ! (in,opt) interp_method - If 'none' indicates the field should not be interpolated as a scalar
- ! (in,opt) tile_count - no clue
-
+ ! Local variables
real :: MOM_missing_value
integer :: dm_id, fms_id
type(diag_type), pointer :: diag => null(), cmor_diag => null()
@@ -1959,7 +1916,7 @@ function register_static_field(module_name, field_name, axes, &
do_not_log, interp_method, tile_count, &
cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name, area, &
x_cell_method, y_cell_method, area_cell_method)
- integer :: register_static_field
+ integer :: register_static_field !< An integer handle for a diagnostic array.
character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model"
!! or "ice_shelf_model"
character(len=*), intent(in) :: field_name !< Name of the diagnostic field
@@ -1985,23 +1942,7 @@ function register_static_field(module_name, field_name, axes, &
character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction.
character(len=*), optional, intent(in) :: area_cell_method !< Specifies the cell method for area
- ! Output: An integer handle for a diagnostic array.
- ! Arguments:
- ! (in) module_name - name of this module, usually "ocean_model" or "ice_shelf_model".
- ! (in) field_name - name of the diagnostic field
- ! (in) axes - container with up to 3 integer handles that indicates axes for this field
- ! (in,opt) long_name - long name of a field
- ! (in,opt) units - units of a field
- ! (in,opt) missing_value - A value that indicates missing values.
- ! (in,opt) standard_name - standardized name associated with a field
-
- ! Following params have yet to be used in MOM.
- ! (in,opt) range - valid range of a variable
- ! (in,opt) mask_variant - If true a logical mask must be provided with post_data calls
- ! (in,opt) do_not_log - If true, do not log something
- ! (in,opt) interp_method - If 'none' indicates the field should not be interpolated as a scalar
- ! (in,opt) tile_count - no clue
-
+ ! Local variables
real :: MOM_missing_value
type(diag_ctrl), pointer :: diag_cs => null()
type(diag_type), pointer :: diag => null(), cmor_diag => null()
@@ -2128,7 +2069,7 @@ function ocean_register_diag(var_desc, G, diag_CS, day)
character(len=48) :: units ! A variable's units.
character(len=240) :: longname ! A variable's longname.
character(len=8) :: hor_grid, z_grid ! Variable grid info.
- type(axes_grp), pointer :: axes
+ type(axes_grp), pointer :: axes => NULL()
call query_vardesc(var_desc, units=units, longname=longname, hor_grid=hor_grid, &
z_grid=z_grid, caller="ocean_register_diag")
@@ -2249,7 +2190,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir)
character(len=240), allocatable :: diag_coords(:)
! This include declares and sets the variable "version".
#include "version_variable.h"
- character(len=40) :: mod = "MOM_diag_mediator" ! This module's name.
+ character(len=40) :: mdl = "MOM_diag_mediator" ! This module's name.
id_clock_diag_mediator = cpu_clock_id('(Ocean diagnostics framework)', grain=CLOCK_MODULE)
id_clock_diag_remap = cpu_clock_id('(Ocean diagnostics remapping)', grain=CLOCK_ROUTINE)
@@ -2263,22 +2204,22 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir)
enddo
! Read all relevant parameters and write them to the model log.
- call log_version(param_file, mod, version, "")
+ call log_version(param_file, mdl, version, "")
- call get_param(param_file, mod, 'NUM_DIAG_COORDS', diag_cs%num_diag_coords, &
+ call get_param(param_file, mdl, 'NUM_DIAG_COORDS', diag_cs%num_diag_coords, &
'The number of diagnostic vertical coordinates to use.\n'//&
'For each coordinate, an entry in DIAG_COORDS must be provided.', &
default=1)
if (diag_cs%num_diag_coords>0) then
allocate(diag_coords(diag_cs%num_diag_coords))
if (diag_cs%num_diag_coords==1) then ! The default is to provide just one instance of Z*
- call get_param(param_file, mod, 'DIAG_COORDS', diag_coords, &
+ call get_param(param_file, mdl, 'DIAG_COORDS', diag_coords, &
'A list of string tuples associating diag_table modules to\n'//&
'a coordinate definition used for diagnostics. Each string\n'//&
'is of the form "MODULE_SUFFIX PARAMETER_SUFFIX COORDINATE_NAME".', &
default='z Z ZSTAR')
else ! If using more than 1 diagnostic coordinate, all must be explicitly defined
- call get_param(param_file, mod, 'DIAG_COORDS', diag_coords, &
+ call get_param(param_file, mdl, 'DIAG_COORDS', diag_coords, &
'A list of string tuples associating diag_table modules to\n'//&
'a coordinate definition used for diagnostics. Each string\n'//&
'is of the form "MODULE_SUFFIX,PARAMETER_SUFFIX,COORDINATE_NAME".', &
@@ -2292,10 +2233,10 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir)
deallocate(diag_coords)
endif
- call get_param(param_file, mod, 'DIAG_MISVAL', diag_cs%missing_value, &
+ call get_param(param_file, mdl, 'DIAG_MISVAL', diag_cs%missing_value, &
'Set the default missing value to use for diagnostics.', &
default=1.e20)
- call get_param(param_file, mod, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, &
+ call get_param(param_file, mdl, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, &
'Instead of writing diagnostics to the diag manager, write\n' //&
'a textfile containing the checksum (bitcount) of the array.', &
default=.false.)
@@ -2322,7 +2263,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir)
if (is_root_pe() .and. (diag_CS%available_diag_doc_unit < 0)) then
write(this_pe,'(i6.6)') PE_here()
doc_file_dflt = "available_diags."//this_pe
- call get_param(param_file, mod, "AVAILABLE_DIAGS_FILE", doc_file, &
+ call get_param(param_file, mdl, "AVAILABLE_DIAGS_FILE", doc_file, &
"A file into which to write a list of all available \n"//&
"ocean diagnostics that can be included in a diag_table.", &
default=doc_file_dflt, do_not_log=(diag_CS%available_diag_doc_unit/=-1))
@@ -2360,7 +2301,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir)
if (is_root_pe() .and. (diag_CS%chksum_diag_doc_unit < 0) .and. diag_CS%diag_as_chksum) then
write(this_pe,'(i6.6)') PE_here()
doc_file_dflt = "chksum_diag."//this_pe
- call get_param(param_file, mod, "CHKSUM_DIAG_FILE", doc_file, &
+ call get_param(param_file, mdl, "CHKSUM_DIAG_FILE", doc_file, &
"A file into which to write all checksums of the \n"//&
"diagnostics listed in the diag_table.", &
default=doc_file_dflt, do_not_log=(diag_CS%chksum_diag_doc_unit/=-1))
@@ -2426,7 +2367,8 @@ subroutine diag_update_remap_grids(diag_cs, alt_h, alt_T, alt_S)
!! the current salinity
! Local variables
integer :: i
- real, dimension(:,:,:), pointer :: h_diag, T_diag, S_diag
+ real, dimension(:,:,:), pointer :: h_diag => NULL()
+ real, dimension(:,:,:), pointer :: T_diag => NULL(), S_diag => NULL()
if (present(alt_h)) then
h_diag => alt_h
@@ -2637,7 +2579,7 @@ subroutine alloc_diag_with_id(diag_id, diag_cs, diag)
type(diag_ctrl), target, intent(inout) :: diag_cs !< structure used to regulate diagnostic output
type(diag_type), pointer :: diag !< structure representing a diagnostic (inout)
- type(diag_type), pointer :: tmp
+ type(diag_type), pointer :: tmp => NULL()
if (.not. diag_cs%diags(diag_id)%in_use) then
diag => diag_cs%diags(diag_id)
diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90
index c43f8f5026..be3a02f777 100644
--- a/src/framework/MOM_diag_remap.F90
+++ b/src/framework/MOM_diag_remap.F90
@@ -1,15 +1,17 @@
-!> This module is used for runtime remapping of diagnostics to z star, sigma and
-!! rho vertical coordinates. It defines the diag_remap_ctrl type which
-!! represents a remapping of diagnostics to a particular vertical coordinate.
-!! The module is used by the diag mediator module in the following way:
-!! 1) _init() is called to initialise a diag_remap_ctrl instance.
-!! 2) _configure_axes() is called to read the configuration file and set up the
+!> provides runtime remapping of diagnostics to z star, sigma and
+!! rho vertical coordinates.
+!!
+!! The diag_remap_ctrl type represents a remapping of diagnostics to a particular
+!! vertical coordinate. The module is used by the diag mediator module in the
+!! following way:
+!! 1. diag_remap_init() is called to initialize a diag_remap_ctrl instance.
+!! 2. diag_remap_configure_axes() is called to read the configuration file and set up the
!! vertical coordinate / axes definitions.
-!! 3) _get_axes_info() returns information needed for the diag mediator to
+!! 3. diag_remap_get_axes_info() returns information needed for the diag mediator to
!! define new axes for the remapped diagnostics.
-!! 4) _update() is called periodically (whenever h, T or S change) to either
+!! 4. diag_remap_update() is called periodically (whenever h, T or S change) to either
!! create or update the target remapping grids.
-!! 5) _do_remap() is called from within a diag post() to do the remapping before
+!! 5. diag_remap_do_remap() is called from within a diag post() to do the remapping before
!! the diagnostic is written out.
module MOM_diag_remap
@@ -53,8 +55,8 @@ module MOM_diag_remap
public vertically_interpolate_diag_field
public horizontally_average_diag_field
-!> This type represents remapping of diagnostics to a particular vertical
-!! coordinate.
+!> Represents remapping of diagnostics to a particular vertical coordinate.
+!!
!! There is one of these types for each vertical coordinate. The vertical axes
!! of a diagnostic will reference an instance of this type indicating how (or
!! if) the diagnostic should be vertically remapped when being posted.
@@ -225,7 +227,9 @@ subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state)
type(diag_remap_ctrl), intent(inout) :: remap_cs !< Diagnostic coordinate control structure
type(ocean_grid_type), pointer :: G !< The ocean's grid type
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
- real, dimension(:, :, :), intent(in) :: h, T, S !< New thickness, T and S
+ real, dimension(:, :, :), intent(in) :: h !< New thickness
+ real, dimension(:, :, :), intent(in) :: T !< New T
+ real, dimension(:, :, :), intent(in) :: S !< New S
type(EOS_type), pointer :: eqn_of_state !< A pointer to the equation of state
! Local variables
@@ -265,22 +269,22 @@ subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state)
if (remap_cs%vertical_coord == coordinateMode('ZSTAR')) then
call build_zstar_column(get_zlike_CS(remap_cs%regrid_cs), &
- G%bathyT(i,j)*GV%m_to_H, sum(h(i,j,:)), &
+ GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), &
zInterfaces, zScale=GV%m_to_H)
elseif (remap_cs%vertical_coord == coordinateMode('SIGMA')) then
call build_sigma_column(get_sigma_CS(remap_cs%regrid_cs), &
- GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces)
+ GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces)
elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then
call build_rho_column(get_rho_CS(remap_cs%regrid_cs), G%ke, &
- G%bathyT(i,j), h(i,j,:), T(i, j, :), S(i, j, :), &
+ G%Zd_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
! call build_slight_column(remap_cs%regrid_cs,remap_cs%remap_cs, nz, &
-! G%bathyT(i,j), sum(h(i,j,:)), zInterfaces)
+! G%Zd_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces)
call MOM_error(FATAL,"diag_remap_update: SLIGHT coordinate not coded for diagnostics yet!")
elseif (remap_cs%vertical_coord == coordinateMode('HYCOM1')) then
! call build_hycom1_column(remap_cs%regrid_cs, nz, &
-! G%bathyT(i,j), sum(h(i,j,:)), zInterfaces)
+! G%Zd_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces)
call MOM_error(FATAL,"diag_remap_update: HYCOM1 coordinate not coded for diagnostics yet!")
endif
remap_cs%h(i,j,:) = zInterfaces(1:nz) - zInterfaces(2:nz+1)
diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90
index a6ca5db387..36f43528be 100644
--- a/src/framework/MOM_document.F90
+++ b/src/framework/MOM_document.F90
@@ -1,14 +1,9 @@
+!> The subroutines here provide hooks for document generation functions at
+!! various levels of granularity.
module MOM_document
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* The subroutines here provide hooks for document generation *
-!* functions at various levels of granularity. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_time_manager, only : time_type
use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe
@@ -17,6 +12,7 @@ module MOM_document
public doc_param, doc_subroutine, doc_function, doc_module, doc_init, doc_end
public doc_openBlock, doc_closeBlock
+!> Document parameter values
interface doc_param
module procedure doc_param_none, &
doc_param_logical, doc_param_logical_array, &
@@ -26,36 +22,37 @@ module MOM_document
doc_param_time
end interface
-integer, parameter :: mLen = 1240 ! Length of interface/message strings
+integer, parameter :: mLen = 1240 !< Length of interface/message strings
!> A structure that controls where the documentation occurs, its veborsity and formatting.
type, public :: doc_type ; private
- integer :: unitAll = -1 ! The open unit number for docFileBase + .all.
- integer :: unitShort = -1 ! The open unit number for docFileBase + .short.
- integer :: unitLayout = -1 ! The open unit number for docFileBase + .layout.
- integer :: unitDebugging = -1 ! The open unit number for docFileBase + .debugging.
- logical :: filesAreOpen = .false. ! True if any files were successfully opened.
- character(len=mLen) :: docFileBase = '' ! The basename of the files where run-time
- ! parameters, settings and defaults are documented.
- logical :: complete = .true. ! If true, document all parameters.
- logical :: minimal = .true. ! If true, document non-default parameters.
- logical :: layout = .true. ! If true, document layout parameters.
- logical :: debugging = .true. ! If true, document debugging parameters.
- logical :: defineSyntax = .false. ! If true, use #def syntax instead of a=b syntax
- logical :: warnOnConflicts = .false. ! Cause a WARNING error if defaults differ.
- integer :: commentColumn = 32 ! Number of spaces before the comment marker.
- type(link_msg), pointer :: chain_msg => NULL() ! Db of messages
- character(len=240) :: blockPrefix = '' ! The full name of the current block.
+ integer :: unitAll = -1 !< The open unit number for docFileBase + .all.
+ integer :: unitShort = -1 !< The open unit number for docFileBase + .short.
+ integer :: unitLayout = -1 !< The open unit number for docFileBase + .layout.
+ integer :: unitDebugging = -1 !< The open unit number for docFileBase + .debugging.
+ logical :: filesAreOpen = .false. !< True if any files were successfully opened.
+ character(len=mLen) :: docFileBase = '' !< The basename of the files where run-time
+ !! parameters, settings and defaults are documented.
+ logical :: complete = .true. !< If true, document all parameters.
+ logical :: minimal = .true. !< If true, document non-default parameters.
+ logical :: layout = .true. !< If true, document layout parameters.
+ logical :: debugging = .true. !< If true, document debugging parameters.
+ logical :: defineSyntax = .false. !< If true, use '\#def' syntax instead of a=b syntax
+ logical :: warnOnConflicts = .false. !< Cause a WARNING error if defaults differ.
+ integer :: commentColumn = 32 !< Number of spaces before the comment marker.
+ type(link_msg), pointer :: chain_msg => NULL() !< Database of messages
+ character(len=240) :: blockPrefix = '' !< The full name of the current block.
end type doc_type
+!> A linked list of the parameter documentation messages that have been issued so far.
type :: link_msg ; private
- type(link_msg), pointer :: next => NULL() ! Facilitates linked list
- character(len=80) :: name ! Parameter name
- character(len=620) :: msg ! Parameter value and default
+ type(link_msg), pointer :: next => NULL() !< Facilitates linked list
+ character(len=80) :: name !< Parameter name
+ character(len=620) :: msg !< Parameter value and default
end type link_msg
-character(len=4), parameter :: STRING_TRUE = 'True'
-character(len=5), parameter :: STRING_FALSE = 'False'
+character(len=4), parameter :: STRING_TRUE = 'True' !< A string for true logicals
+character(len=5), parameter :: STRING_FALSE = 'False' !< A string for false logicals
contains
@@ -737,6 +734,7 @@ end subroutine doc_function
! ----------------------------------------------------------------------
+!> Initialize the parameter documentation
subroutine doc_init(docFileBase, doc, minimal, complete, layout, debugging)
character(len=*), intent(in) :: docFileBase !< The base file name for this set of parameters,
!! for example MOM_parameter_doc
@@ -750,8 +748,6 @@ subroutine doc_init(docFileBase, doc, minimal, complete, layout, debugging)
!! the layout parameters
logical, optional, intent(in) :: debugging !< If present and true, write out the (.debugging) files documenting
!! the debugging parameters
-! Arguments: docFileBase - The name of the doc file.
-! (inout) doc - The doc_type to populate.
if (.not. associated(doc)) then
allocate(doc)
@@ -765,7 +761,7 @@ subroutine doc_init(docFileBase, doc, minimal, complete, layout, debugging)
end subroutine doc_init
-!< This subroutine allocates and populates a structure that controls where the
+!> This subroutine allocates and populates a structure that controls where the
!! documentation occurs and its formatting, and opens up the files controlled
!! by this structure
subroutine open_doc_file(doc)
@@ -865,7 +861,7 @@ subroutine open_doc_file(doc)
end subroutine open_doc_file
-! Find an unused unit number, returning >0 if found, and triggering a FATAL error if not.
+!> Find an unused unit number, returning >0 if found, and triggering a FATAL error if not.
function find_unused_unit_number()
! Find an unused unit number.
! Returns >0 if found. FATAL if not.
@@ -879,12 +875,12 @@ function find_unused_unit_number()
"doc_init failed to find an unused unit number.")
end function find_unused_unit_number
-!< This subroutine closes the the files controlled by doc, and sets flags in
+!> This subroutine closes the the files controlled by doc, and sets flags in
!! doc to indicate that parameterization is no longer permitted.
subroutine doc_end(doc)
type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
!! documentation occurs and its formatting
- type(link_msg), pointer :: this, next
+ type(link_msg), pointer :: this => NULL(), next => NULL()
if (.not.associated(doc)) return
@@ -929,7 +925,7 @@ function mesgHasBeenDocumented(doc,varName,mesg)
!! to compare with the message that was written previously
logical :: mesgHasBeenDocumented
! Returns true if documentation has already been written
- type(link_msg), pointer :: newLink, this, last
+ type(link_msg), pointer :: newLink => NULL(), this => NULL(), last => NULL()
mesgHasBeenDocumented = .false.
diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90
index 4afcf590a2..417274500d 100644
--- a/src/framework/MOM_domains.F90
+++ b/src/framework/MOM_domains.F90
@@ -1,3 +1,4 @@
+!> Describes the decomposed MOM domain and has routines for communications across PEs
module MOM_domains
! This file is part of MOM6. See LICENSE.md for the license.
@@ -26,49 +27,55 @@ module MOM_domains
use mpp_domains_mod, only : compute_block_extent => mpp_compute_block_extent
use mpp_parameter_mod, only : AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER
use mpp_parameter_mod, only : To_East => WUPDATE, To_West => EUPDATE, Omit_Corners => EDGEUPDATE
-use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE
+use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE, CENTER
use fms_io_mod, only : file_exist, parse_mask_table
implicit none ; private
-! #include
-
public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent
public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain
-public :: pass_var, pass_vector, broadcast, PE_here, root_PE, num_PEs
-public :: pass_var_start, pass_var_complete, fill_symmetric_edges
+public :: pass_var, pass_vector, PE_here, root_PE, num_PEs
+public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast
public :: pass_vector_start, pass_vector_complete
public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs
-public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER
+public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER, CENTER
public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners
public :: create_group_pass, do_group_pass, group_pass_type
public :: start_group_pass, complete_group_pass
public :: compute_block_extent, get_global_shape
+public :: get_simple_array_i_ind, get_simple_array_j_ind
+!> Do a halo update on an array
interface pass_var
module procedure pass_var_3d, pass_var_2d
end interface pass_var
+!> Do a halo update on a pair of arrays representing the two components of a vector
interface pass_vector
module procedure pass_vector_3d, pass_vector_2d
end interface pass_vector
+!> Initiate a non-blocking halo update on an array
interface pass_var_start
module procedure pass_var_start_3d, pass_var_start_2d
end interface pass_var_start
+!> Complete a non-blocking halo update on an array
interface pass_var_complete
module procedure pass_var_complete_3d, pass_var_complete_2d
end interface pass_var_complete
+!> Initiate a halo update on a pair of arrays representing the two components of a vector
interface pass_vector_start
module procedure pass_vector_start_3d, pass_vector_start_2d
end interface pass_vector_start
+!> Complete a halo update on a pair of arrays representing the two components of a vector
interface pass_vector_complete
module procedure pass_vector_complete_3d, pass_vector_complete_2d
end interface pass_vector_complete
+!> Set up a group of halo updates
interface create_group_pass
module procedure create_var_group_pass_2d
module procedure create_var_group_pass_3d
@@ -76,11 +83,14 @@ module MOM_domains
module procedure create_vector_group_pass_3d
end interface create_group_pass
+!> Do a set of halo updates that fill in the values at the duplicated edges
+!! of a staggered symmetric memory domain
interface fill_symmetric_edges
module procedure fill_vector_symmetric_edges_2d !, fill_vector_symmetric_edges_3d
! module procedure fill_scalar_symmetric_edges_2d, fill_scalar_symmetric_edges_3d
end interface fill_symmetric_edges
+!> Copy one MOM_domain_type into another
interface clone_MOM_domain
module procedure clone_MD_to_MD, clone_MD_to_d2D
end interface clone_MOM_domain
@@ -109,7 +119,6 @@ module MOM_domains
!! domain in the i-direction in a define_domain call.
integer :: Y_FLAGS !< Flag that specifies the properties of the
!! domain in the j-direction in a define_domain call.
- logical :: use_io_layout !< True if an I/O layout is available.
logical, pointer :: maskmap(:,:) => NULL() !< A pointer to an array indicating
!! which logical processors are actually used for
!! the ocean code. The other logical processors
@@ -118,7 +127,7 @@ module MOM_domains
!! assigned if all logical processors are used.
end type MOM_domain_type
-integer, parameter :: To_All = To_East + To_West + To_North + To_South
+integer, parameter :: To_All = To_East + To_West + To_North + To_South !< A flag for passing in all directions
contains
@@ -145,21 +154,7 @@ subroutine pass_var_3d(array, MOM_dom, sideflag, complete, position, halo, &
!! halo by default.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments: array - The array which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) sideflag - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH. For example,
-! TO_EAST sends the data to the processor to the east, so
-! the halos on the western side are filled. TO_ALL is
-! the default if sideflag is omitted.
-! (in,opt) complete - An optional argument indicating whether the halo updates
-! should be completed before progress resumes. Omitting
-! complete is the same as setting complete to .true.
-! (in,opt) position - An optional argument indicating the position. This is
-! usally CORNER, but is CENTER by default.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
+
integer :: dirflag
logical :: block_til_complete
@@ -184,8 +179,7 @@ subroutine pass_var_3d(array, MOM_dom, sideflag, complete, position, halo, &
end subroutine pass_var_3d
!> pass_var_2d does a halo update for a two-dimensional array.
-subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, &
- clock)
+subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, inner_halo, clock)
real, dimension(:,:), intent(inout) :: array !< The array which is having its halos points
!! exchanged.
type(MOM_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
@@ -203,24 +197,18 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, &
!! by default.
integer, optional, intent(in) :: halo !< The size of the halo to update - the full halo
!! by default.
- integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
+ integer, optional, intent(in) :: inner_halo !< The size of an inner halo to avoid updating,
+ !! or 0 to avoid updating symmetric memory
+ !! computational domain points. Setting this >=0
+ !! also enforces that complete=.true.
+ integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments: array - The array which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) sideflag - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH. For example,
-! TO_EAST sends the data to the processor to the east, so
-! the halos on the western side are filled. TO_ALL is
-! the default if sideflag is omitted.
-! (in,opt) complete - An optional argument indicating whether the halo updates
-! should be completed before progress resumes. Omitting
-! complete is the same as setting complete to .true.
-! (in,opt) position - An optional argument indicating the position. This is
-! usally CORNER, but is CENTER by default.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
+ ! Local variables
+ real, allocatable, dimension(:,:) :: tmp
+ integer :: pos, i_halo, j_halo
+ integer :: isc, iec, jsc, jec, isd, ied, jsd, jed, IscB, IecB, JscB, JecB
+ integer :: inner, i, j, isfw, iefw, isfe, iefe, jsfs, jefs, jsfn, jefn
integer :: dirflag
logical :: block_til_complete
@@ -228,8 +216,15 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, &
dirflag = To_All ! 60
if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif
- block_til_complete = .true.
- if (present(complete)) block_til_complete = complete
+ block_til_complete = .true. ; if (present(complete)) block_til_complete = complete
+ pos = CENTER ; if (present(position)) pos = position
+
+ if (present(inner_halo)) then ; if (inner_halo >= 0) then
+ ! Store the original values.
+ allocate(tmp(size(array,1), size(array,2)))
+ tmp(:,:) = array(:,:)
+ block_til_complete = .true.
+ endif ; endif
if (present(halo) .and. MOM_dom%thin_halo_updates) then
call mpp_update_domains(array, MOM_dom%mpp_domain, flags=dirflag, &
@@ -240,6 +235,46 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, &
complete=block_til_complete, position=position)
endif
+ if (present(inner_halo)) then ; if (inner_halo >= 0) then
+ call mpp_get_compute_domain(MOM_dom%mpp_domain, isc, iec, jsc, jec)
+ call mpp_get_data_domain(MOM_dom%mpp_domain, isd, ied, jsd, jed)
+ ! Convert to local indices for arrays starting at 1.
+ isc = isc - (isd-1) ; iec = iec - (isd-1) ; ied = ied - (isd-1) ; isd = 1
+ jsc = jsc - (jsd-1) ; jec = jec - (jsd-1) ; jed = jed - (jsd-1) ; jsd = 1
+ i_halo = min(inner_halo, isc-1) ; j_halo = min(inner_halo, jsc-1)
+
+ ! Figure out the array index extents of the eastern, western, northern and southern regions to copy.
+ if (pos == CENTER) then
+ if (size(array,1) == ied) then
+ isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo
+ else ; call MOM_error(FATAL, "pass_var_2d: wrong i-size for CENTER array.") ; endif
+ if (size(array,2) == jed) then
+ isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo
+ else ; call MOM_error(FATAL, "pass_var_2d: wrong j-size for CENTER array.") ; endif
+ elseif (pos == CORNER) then
+ if (size(array,1) == ied) then
+ isfw = max(isc - (i_halo+1), 1) ; iefw = isc ; isfe = iec ; iefe = iec + i_halo
+ elseif (size(array,1) == ied+1) then
+ isfw = isc - i_halo ; iefw = isc+1 ; isfe = iec+1 ; iefe = min(iec + 1 + i_halo, ied+1)
+ else ; call MOM_error(FATAL, "pass_var_2d: wrong i-size for CORNER array.") ; endif
+ if (size(array,2) == jed) then
+ jsfs = max(jsc - (j_halo+1), 1) ; jefs = jsc ; jsfn = jec ; jefn = jec + j_halo
+ elseif (size(array,2) == jed+1) then
+ jsfs = jsc - j_halo ; jefs = jsc+1 ; jsfn = jec+1 ; jefn = min(jec + 1 + j_halo, jed+1)
+ else ; call MOM_error(FATAL, "pass_var_2d: wrong j-size for CORNER array.") ; endif
+ else
+ call MOM_error(FATAL, "pass_var_2d: Unrecognized position")
+ endif
+
+ ! Copy back the stored inner halo points
+ do j=jsfs,jefn ; do i=isfw,iefw ; array(i,j) = tmp(i,j) ; enddo ; enddo
+ do j=jsfs,jefn ; do i=isfe,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo
+ do j=jsfs,jefs ; do i=isfw,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo
+ do j=jsfn,jefn ; do i=isfw,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo
+
+ deallocate(tmp)
+ endif ; endif
+
if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
end subroutine pass_var_2d
@@ -268,23 +303,7 @@ function pass_var_start_2d(array, MOM_dom, sideflag, position, complete, halo, &
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
integer :: pass_var_start_2d !0) call cpu_clock_begin(clock) ; endif
@@ -329,23 +348,7 @@ function pass_var_start_3d(array, MOM_dom, sideflag, position, complete, halo, &
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
integer :: pass_var_start_3d !< The integer index for this update.
-! Arguments: array - The array which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) sideflag - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH. For example,
-! TO_EAST sends the data to the processor to the east, so
-! the halos on the western side are filled. TO_ALL is
-! the default if sideflag is omitted.
-! (in) position - An optional argument indicating the position. This is
-! may be CORNER, but is CENTER by default.
-! (in) complete - An optional argument indicating whether the halo updates
-! should be initiated immediately or wait for second
-! pass_..._start call. Omitting complete is the same as
-! setting complete to .true.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
-! (return value) - The integer index for this update.
+
integer :: dirflag
if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
@@ -388,20 +391,7 @@ subroutine pass_var_complete_2d(id_update, array, MOM_dom, sideflag, position, h
!! halo by default.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments: id_update - The integer id of this update which has been returned
-! from a previous call to pass_var_start.
-! (inout) array - The array which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) sideflag - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH. For example,
-! TO_EAST sends the data to the processor to the east, so
-! the halos on the western side are filled. TO_ALL is
-! the default if sideflag is omitted.
-! (in) position - An optional argument indicating the position. This is
-! may be CORNER, but is CENTER by default.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
+
integer :: dirflag
if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
@@ -444,20 +434,7 @@ subroutine pass_var_complete_3d(id_update, array, MOM_dom, sideflag, position, h
!! halo by default.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments: id_update - The integer id of this update which has been returned
-! from a previous call to pass_var_start.
-! (inout) array - The array which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) sideflag - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH. For example,
-! TO_EAST sends the data to the processor to the east, so
-! the halos on the western side are filled. TO_ALL is
-! the default if sideflag is omitted.
-! (in) position - An optional argument indicating the position. This is
-! may be CORNER, but is CENTER by default.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
+
integer :: dirflag
if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
@@ -507,29 +484,8 @@ subroutine pass_vector_2d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete,
!! halo by default.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments: u_cmpt - The nominal zonal (u) component of the vector pair which
-! is having its halos points exchanged.
-! (inout) v_cmpt - The nominal meridional (v) component of the vector pair
-! which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) direction - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH, possibly
-! plus SCALAR_PAIR if these are paired non-directional
-! scalars discretized at the typical vector component
-! locations. For example, TO_EAST sends the data to the
-! processor to the east, so the halos on the western
-! side are filled. TO_ALL is the default if omitted.
-! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE,
-! or CGRID_NE, indicating where the two components of the
-! vector are discretized. Omitting stagger is the same as
-! setting it to CGRID_NE.
-! (in) complete - An optional argument indicating whether the halo updates
-! should be completed before progress resumes. Omitting
-! complete is the same as setting complete to .true.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
+ ! Local variables
integer :: stagger_local
integer :: dirflag
logical :: block_til_complete
@@ -579,18 +535,8 @@ subroutine fill_vector_symmetric_edges_2d(u_cmpt, v_cmpt, MOM_dom, stagger, scal
logical, optional, intent(in) :: scalar !< An optional argument indicating whether.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments: u_cmpt - The nominal zonal (u) component of the vector pair which
-! is having its halos points exchanged.
-! (inout) v_cmpt - The nominal meridional (v) component of the vector pair
-! which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE,
-! or CGRID_NE, indicating where the two components of the
-! vector are discretized. Omitting stagger is the same as
-! setting it to CGRID_NE.
-! (in) scalar - An optional argument indicating whether
+ ! Local variables
integer :: stagger_local
integer :: dirflag
integer :: i, j, isc, iec, jsc, jec, isd, ied, jsd, jed, IscB, IecB, JscB, JecB
@@ -684,29 +630,8 @@ subroutine pass_vector_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete,
!! halo by default.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments: u_cmpt - The nominal zonal (u) component of the vector pair which
-! is having its halos points exchanged.
-! (inout) v_cmpt - The nominal meridional (v) component of the vector pair
-! which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) direction - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH, possibly
-! plus SCALAR_PAIR if these are paired non-directional
-! scalars discretized at the typical vector component
-! locations. For example, TO_EAST sends the data to the
-! processor to the east, so the halos on the western
-! side are filled. TO_ALL is the default if omitted.
-! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE,
-! or CGRID_NE, indicating where the two components of the
-! vector are discretized. Omitting stagger is the same as
-! setting it to CGRID_NE.
-! (in) complete - An optional argument indicating whether the halo updates
-! should be completed before progress resumes. Omitting
-! complete is the same as setting complete to .true.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
+ ! Local variables
integer :: stagger_local
integer :: dirflag
logical :: block_til_complete
@@ -765,30 +690,8 @@ function pass_vector_start_2d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, compl
!! started then stopped to time this routine.
integer :: pass_vector_start_2d !< The integer index for this
!! update.
-! Arguments: u_cmpt - The nominal zonal (u) component of the vector pair which
-! is having its halos points exchanged.
-! (inout) v_cmpt - The nominal meridional (v) component of the vector pair
-! which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) direction - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH, possibly
-! plus SCALAR_PAIR if these are paired non-directional
-! scalars discretized at the typical vector component
-! locations. For example, TO_EAST sends the data to the
-! processor to the east, so the halos on the western
-! side are filled. TO_ALL is the default if omitted.
-! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE,
-! or CGRID_NE, indicating where the two components of the
-! vector are discretized. Omitting stagger is the same as
-! setting it to CGRID_NE.
-! (in) complete - An optional argument indicating whether the halo updates
-! should be initiated immediately or wait for second
-! pass_..._start call. Omitting complete is the same as
-! setting complete to .true.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
-! (return value) - The integer index for this update.
+
+ ! Local variables
integer :: stagger_local
integer :: dirflag
@@ -844,30 +747,7 @@ function pass_vector_start_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, compl
!! started then stopped to time this routine.
integer :: pass_vector_start_3d !< The integer index for this
!! update.
-! Arguments: u_cmpt - The nominal zonal (u) component of the vector pair which
-! is having its halos points exchanged.
-! (inout) v_cmpt - The nominal meridional (v) component of the vector pair
-! which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) direction - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH, possibly
-! plus SCALAR_PAIR if these are paired non-directional
-! scalars discretized at the typical vector component
-! locations. For example, TO_EAST sends the data to the
-! processor to the east, so the halos on the western
-! side are filled. TO_ALL is the default if omitted.
-! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE,
-! or CGRID_NE, indicating where the two components of the
-! vector are discretized. Omitting stagger is the same as
-! setting it to CGRID_NE.
-! (in) complete - An optional argument indicating whether the halo updates
-! should be initiated immediately or wait for second
-! pass_..._start call. Omitting complete is the same as
-! setting complete to .true.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
-! (return value) - The integer index for this update.
+ ! Local variables
integer :: stagger_local
integer :: dirflag
@@ -921,28 +801,7 @@ subroutine pass_vector_complete_2d(id_update, u_cmpt, v_cmpt, MOM_dom, direction
!! halo by default.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments: id_update - The integer id of this update which has been returned
-! from a previous call to pass_var_start.
-! (inout) u_cmpt - The nominal zonal (u) component of the vector pair which
-! is having its halos points exchanged.
-! (inout) v_cmpt - The nominal meridional (v) component of the vector pair
-! which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) direction - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH, possibly
-! plus SCALAR_PAIR if these are paired non-directional
-! scalars discretized at the typical vector component
-! locations. For example, TO_EAST sends the data to the
-! processor to the east, so the halos on the western
-! side are filled. TO_ALL is the default if omitted.
-! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE,
-! or CGRID_NE, indicating where the two components of the
-! vector are discretized. Omitting stagger is the same as
-! setting it to CGRID_NE.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
-! (return value) - The integer index for this update.
+ ! Local variables
integer :: stagger_local
integer :: dirflag
@@ -996,28 +855,7 @@ subroutine pass_vector_complete_3d(id_update, u_cmpt, v_cmpt, MOM_dom, direction
!! halo by default.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments: id_update - The integer id of this update which has been returned
-! from a previous call to pass_var_start.
-! (inout) u_cmpt - The nominal zonal (u) component of the vector pair which
-! is having its halos points exchanged.
-! (inout) v_cmpt - The nominal meridional (v) component of the vector pair
-! which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) direction - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH, possibly
-! plus SCALAR_PAIR if these are paired non-directional
-! scalars discretized at the typical vector component
-! locations. For example, TO_EAST sends the data to the
-! processor to the east, so the halos on the western
-! side are filled. TO_ALL is the default if omitted.
-! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE,
-! or CGRID_NE, indicating where the two components of the
-! vector are discretized. Omitting stagger is the same as
-! setting it to CGRID_NE.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
-! (return value) - The integer index for this update.
+ ! Local variables
integer :: stagger_local
integer :: dirflag
@@ -1064,21 +902,7 @@ subroutine create_var_group_pass_2d(group, array, MOM_dom, sideflag, position, &
!! halo by default.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments:
-! (inout) group - The data type that store information for group update.
-! This data will be used in do_group_pass.
-! (inout) array - The array which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in,opt) sideflag - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH. For example,
-! TO_EAST sends the data to the processor to the east, so
-! the halos on the western side are filled. TO_ALL is
-! the default if sideflag is omitted.
-! (in,opt) position - An optional argument indicating the position. This is
-! may be CORNER, but is CENTER by default.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
+ ! Local variables
integer :: dirflag
if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
@@ -1123,21 +947,7 @@ subroutine create_var_group_pass_3d(group, array, MOM_dom, sideflag, position, h
!! halo by default.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments:
-! (inout) group - The data type that store information for group update.
-! This data will be used in do_group_pass.
-! (inout) array - The array which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in,opt) sideflag - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH. For example,
-! TO_EAST sends the data to the processor to the east, so
-! the halos on the western side are filled. TO_ALL is
-! the default if sideflag is omitted.
-! (in,opt) position - An optional argument indicating the position. This is
-! may be CORNER, but is CENTER by default.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
+ ! Local variables
integer :: dirflag
if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
@@ -1189,28 +999,7 @@ subroutine create_vector_group_pass_2d(group, u_cmpt, v_cmpt, MOM_dom, direction
!! halo by default.
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments:
-! (inout) group - The data type that store information for group update.
-! This data will be used in do_group_pass.
-! (inout) u_cmpt - The nominal zonal (u) component of the vector pair which
-! is having its halos points exchanged.
-! (inout) v_cmpt - The nominal meridional (v) component of the vector pair
-! which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) direction - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH, possibly
-! plus SCALAR_PAIR if these are paired non-directional
-! scalars discretized at the typical vector component
-! locations. For example, TO_EAST sends the data to the
-! processor to the east, so the halos on the western
-! side are filled. TO_ALL is the default if omitted.
-! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE,
-! or CGRID_NE, indicating where the two components of the
-! vector are discretized. Omitting stagger is the same as
-! setting it to CGRID_NE.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
+ ! Local variables
integer :: stagger_local
integer :: dirflag
@@ -1267,29 +1056,7 @@ subroutine create_vector_group_pass_3d(group, u_cmpt, v_cmpt, MOM_dom, direction
integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
!! started then stopped to time this routine.
-! Arguments:
-! (inout) group - The data type that store information for group update.
-! This data will be used in do_group_pass.
-! (inout) u_cmpt - The nominal zonal (u) component of the vector pair which
-! is having its halos points exchanged.
-! (inout) v_cmpt - The nominal meridional (v) component of the vector pair
-! which is having its halos points exchanged.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-! (in) direction - An optional integer indicating which directions the
-! data should be sent. It is TO_ALL or the sum of any of
-! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH, possibly
-! plus SCALAR_PAIR if these are paired non-directional
-! scalars discretized at the typical vector component
-! locations. For example, TO_EAST sends the data to the
-! processor to the east, so the halos on the western
-! side are filled. TO_ALL is the default if omitted.
-! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE,
-! or CGRID_NE, indicating where the two components of the
-! vector are discretized. Omitting stagger is the same as
-! setting it to CGRID_NE.
-! (in,opt) halo - The size of the halo to update - the full halo by default.
-
+ ! Local variables
integer :: stagger_local
integer :: dirflag
@@ -1328,11 +1095,6 @@ subroutine do_group_pass(group, MOM_dom, clock)
!! started then stopped to time this routine.
real :: d_type
-! Arguments:
-! (inout) group - The data type that store information for group update.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-
if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
call mpp_do_group_update(group, MOM_dom%mpp_domain, d_type)
@@ -1354,11 +1116,6 @@ subroutine start_group_pass(group, MOM_dom, clock)
real :: d_type
-! Arguments:
-! (inout) group - The data type that store information for group update.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-
if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
call mpp_start_group_update(group, MOM_dom%mpp_domain, d_type)
@@ -1379,11 +1136,6 @@ subroutine complete_group_pass(group, MOM_dom, clock)
!! started then stopped to time this routine.
real :: d_type
-! Arguments:
-! (inout) group - The data type that store information for group update.
-! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
-! determine where data should be sent.
-
if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
call mpp_complete_group_update(group, MOM_dom%mpp_domain, d_type)
@@ -1430,26 +1182,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, &
character(len=*), optional, intent(in) :: param_suffix !< A suffix to apply to
!! layout-specific parameters.
-
-! Arguments: MOM_dom - A pointer to the MOM_domain_type being defined here.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in,opt) symmetric - If present, this specifies whether this domain
-! is symmetric, regardless of whether the macro
-! SYMMETRIC_MEMORY_ is defined.
-! (in,opt) static_memory - If present and true, this domain type is set up for
-! static memory and error checking of various input
-! values is performed against those in the input file.
-! (in,opt) NIHALO, NJHALO - Default halo sizes, required with static memory.
-! (in,opt) NIGLOBAL, NJGLOBAL - Total domain sizes, required with static memory.
-! (in,opt) NIPROC, NJPROC - Processor counts, required with static memory.
-! (in,opt) min_halo - If present, this sets the minimum halo size for this
-! domain in the i- and j- directions, and returns the
-! actual halo size used.
-! (in,opt) domain_name - A name for this domain, "MOM" if missing.
-! (in,opt) include_name - A name for model's include file, "MOM_memory.h" if missing.
-! (in,opt) param_suffix - A suffix to apply to layout-specific parameters.
-
+ ! Local variables
integer, dimension(2) :: layout = (/ 1, 1 /)
integer, dimension(2) :: io_layout = (/ 0, 0 /)
integer, dimension(4) :: global_indices
@@ -1723,11 +1456,11 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, &
"STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",&
layoutParam=.true.)
call log_param(param_file, mdl, trim(njproc_nm), layout(2), &
- "The number of processors in the x-direction. With \n"//& !### FIX THIS COMMENT
+ "The number of processors in the y-direction. With \n"//&
"STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",&
layoutParam=.true.)
call log_param(param_file, mdl, trim(layout_nm), layout, &
- "The processor layout that was acutally used.",&
+ "The processor layout that was actually used.",&
layoutParam=.true.)
! Idiot check that fewer PEs than columns have been requested
@@ -1812,7 +1545,6 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, &
MOM_dom%Y_FLAGS = Y_FLAGS
MOM_dom%layout = layout
MOM_dom%io_layout = io_layout
- MOM_dom%use_io_layout = (io_layout(1) + io_layout(2) > 0)
if (is_static) then
! A requirement of equal sized compute domains is necessary when STATIC_MEMORY_
@@ -1876,7 +1608,6 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, &
MOM_dom%X_FLAGS = MD_in%X_FLAGS ; MOM_dom%Y_FLAGS = MD_in%Y_FLAGS
MOM_dom%layout(:) = MD_in%layout(:) ; MOM_dom%io_layout(:) = MD_in%io_layout(:)
- MOM_dom%use_io_layout = (MOM_dom%io_layout(1) + MOM_dom%io_layout(2) > 0)
if (associated(MD_in%maskmap)) then
mask_table_exists = .true.
@@ -2002,43 +1733,38 @@ subroutine clone_MD_to_d2D(MD_in, mpp_domain, min_halo, halo_size, symmetric, &
end subroutine clone_MD_to_d2D
-!> get_domain_extent returns various data that has been stored in a MOM_domain_type.
+!> Returns various data that has been stored in a MOM_domain_type
subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, &
isg, ieg, jsg, jeg, idg_offset, jdg_offset, &
symmetric, local_indexing, index_offset)
type(MOM_domain_type), &
- intent(in) :: Domain !< The MOM domain from which to extract information
- integer, intent(out) :: isc, iec, jsc, jec !< The start & end indices of the computational
- !! domain.
- integer, intent(out) :: isd, ied, jsd, jed !< The start & end indices of the data domain.
- integer, intent(out) :: isg, ieg, jsg, jeg !< The start & end indices of the global domain.
- integer, intent(out) :: idg_offset, jdg_offset !< The offset between the corresponding global and
- !! data index spaces.
- logical, intent(out) :: symmetric !< True if symmetric memory is used.
- logical, optional, &
- intent(in) :: local_indexing !< If true, local tracer array indices start at 1,
- !! as in most MOM6 or GOLD code.
- integer, optional, &
- intent(in) :: index_offset !< A fixed additional offset to all indices. This
- !! can be useful for some types of debugging with
- !! dynamic memory allocation.
-
-! Arguments: Domain - The MOM_domain_type from which the indices are extracted.
-! (out) isc, iec, jsc, jec - the start & end indices of the
-! computational domain.
-! (out) isd, ied, jsd, jed - the start & end indices of the data domain.
-! (out) isg, ieg, jsg, jeg - the start & end indices of the global domain.
-! (out) idg_offset, jdg_offset - the offset between the corresponding
-! global and data index spaces.
-! (out) symmetric - true if symmetric memory is used.
-! (in,opt) local_indexing - if true, local tracer array indices start at 1, as
-! in most MOM6 or GOLD code.
-! (in,opt) index_offset - A fixed additional offset to all indices. This can
-! be useful for some types of debugging with dynamic
-! memory allocation.
-
+ intent(in) :: Domain !< The MOM domain from which to extract information
+ integer, intent(out) :: isc !< The start i-index of the computational domain
+ integer, intent(out) :: iec !< The end i-index of the computational domain
+ integer, intent(out) :: jsc !< The start j-index of the computational domain
+ integer, intent(out) :: jec !< The end j-index of the computational domain
+ integer, intent(out) :: isd !< The start i-index of the data domain
+ integer, intent(out) :: ied !< The end i-index of the data domain
+ integer, intent(out) :: jsd !< The start j-index of the data domain
+ integer, intent(out) :: jed !< The end j-index of the data domain
+ integer, intent(out) :: isg !< The start i-index of the global domain
+ integer, intent(out) :: ieg !< The end i-index of the global domain
+ integer, intent(out) :: jsg !< The start j-index of the global domain
+ integer, intent(out) :: jeg !< The end j-index of the global domain
+ integer, intent(out) :: idg_offset !< The offset between the corresponding global and
+ !! data i-index spaces.
+ integer, intent(out) :: jdg_offset !< The offset between the corresponding global and
+ !! data j-index spaces.
+ logical, intent(out) :: symmetric !< True if symmetric memory is used.
+ logical, optional, intent(in) :: local_indexing !< If true, local tracer array indices start at 1,
+ !! as in most MOM6 code.
+ integer, optional, intent(in) :: index_offset !< A fixed additional offset to all indices. This
+ !! can be useful for some types of debugging with
+ !! dynamic memory allocation.
+ ! Local variables
integer :: ind_off
logical :: local
+
local = .true. ; if (present(local_indexing)) local = local_indexing
ind_off = 0 ; if (present(index_offset)) ind_off = index_offset
@@ -2066,6 +1792,79 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, &
end subroutine get_domain_extent
+!> Return the (potentially symmetric) computational domain i-bounds for an array
+!! passed without index specifications (i.e. indices start at 1) based on an array size.
+subroutine get_simple_array_i_ind(domain, size, is, ie, symmetric)
+ type(MOM_domain_type), intent(in) :: domain !< MOM domain from which to extract information
+ integer, intent(in) :: size !< The i-array size
+ integer, intent(out) :: is !< The computational domain starting i-index.
+ integer, intent(out) :: ie !< The computational domain ending i-index.
+ logical, optional, intent(in) :: symmetric !< If present, indicates whether symmetric sizes
+ !! can be considered.
+ ! Local variables
+ logical :: sym
+ character(len=120) :: mesg, mesg2
+ integer :: isc, iec, jsc, jec, isd, ied, jsd, jed
+
+ call mpp_get_compute_domain(Domain%mpp_domain, isc, iec, jsc, jec)
+ call mpp_get_data_domain(Domain%mpp_domain, isd, ied, jsd, jed)
+
+ isc = isc-isd+1 ; iec = iec-isd+1 ; ied = ied-isd+1 ; isd = 1
+ sym = Domain%symmetric ; if (present(symmetric)) sym = symmetric
+
+ if (size == ied) then ; is = isc ; ie = iec
+ elseif (size == 1+iec-isc) then ; is = 1 ; ie = size
+ elseif (sym .and. (size == 1+ied)) then ; is = isc ; ie = iec+1
+ elseif (sym .and. (size == 2+iec-isc)) then ; is = 1 ; ie = size+1
+ else
+ write(mesg,'("Unrecognized size ", i6, "in call to get_simple_array_i_ind. \")') size
+ if (sym) then
+ write(mesg2,'("Valid sizes are : ", 2i7)') ied, 1+iec-isc
+ else
+ write(mesg2,'("Valid sizes are : ", 4i7)') ied, 1+iec-isc, 1+ied, 2+iec-isc
+ endif
+ call MOM_error(FATAL, trim(mesg)//trim(mesg2))
+ endif
+
+end subroutine get_simple_array_i_ind
+
+
+!> Return the (potentially symmetric) computational domain j-bounds for an array
+!! passed without index specifications (i.e. indices start at 1) based on an array size.
+subroutine get_simple_array_j_ind(domain, size, js, je, symmetric)
+ type(MOM_domain_type), intent(in) :: domain !< MOM domain from which to extract information
+ integer, intent(in) :: size !< The j-array size
+ integer, intent(out) :: js !< The computational domain starting j-index.
+ integer, intent(out) :: je !< The computational domain ending j-index.
+ logical, optional, intent(in) :: symmetric !< If present, indicates whether symmetric sizes
+ !! can be considered.
+ ! Local variables
+ logical :: sym
+ character(len=120) :: mesg, mesg2
+ integer :: isc, iec, jsc, jec, isd, ied, jsd, jed
+
+ call mpp_get_compute_domain(Domain%mpp_domain, isc, iec, jsc, jec)
+ call mpp_get_data_domain(Domain%mpp_domain, isd, ied, jsd, jed)
+
+ jsc = jsc-jsd+1 ; jec = jec-jsd+1 ; jed = jed-jsd+1 ; jsd = 1
+ sym = Domain%symmetric ; if (present(symmetric)) sym = symmetric
+
+ if (size == jed) then ; js = jsc ; je = jec
+ elseif (size == 1+jec-jsc) then ; js = 1 ; je = size
+ elseif (sym .and. (size == 1+jed)) then ; js = jsc ; je = jec+1
+ elseif (sym .and. (size == 2+jec-jsc)) then ; js = 1 ; je = size+1
+ else
+ write(mesg,'("Unrecognized size ", i6, "in call to get_simple_array_j_ind. \")') size
+ if (sym) then
+ write(mesg2,'("Valid sizes are : ", 2i7)') jed, 1+jec-jsc
+ else
+ write(mesg2,'("Valid sizes are : ", 4i7)') jed, 1+jec-jsc, 1+jed, 2+jec-jsc
+ endif
+ call MOM_error(FATAL, trim(mesg)//trim(mesg2))
+ endif
+
+end subroutine get_simple_array_j_ind
+
!> Returns the global shape of h-point arrays
subroutine get_global_shape(domain, niglobal, njglobal)
type(MOM_domain_type), intent(in) :: domain !< MOM domain
diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90
index a11646aa2a..37500d31c2 100644
--- a/src/framework/MOM_dyn_horgrid.F90
+++ b/src/framework/MOM_dyn_horgrid.F90
@@ -1,3 +1,5 @@
+!> Contains a shareable dynamic type for describing horizontal grids and metric data
+!! and utilty routines that work on this type.
module MOM_dyn_horgrid
! This file is part of MOM6. See LICENSE.md for the license.
@@ -9,116 +11,156 @@ module MOM_dyn_horgrid
implicit none ; private
public create_dyn_horgrid, destroy_dyn_horgrid, set_derived_dyn_horgrid
+public rescale_dyn_horgrid_bathymetry
+!> Describes the horizontal ocean grid with only dynamic memory arrays
type, public :: dyn_horgrid_type
- type(MOM_domain_type), pointer :: Domain => NULL()
- type(MOM_domain_type), pointer :: Domain_aux => NULL() ! A non-symmetric auxiliary domain type.
-
- ! These elements can be copied from a provided hor_index_type.
- type(hor_index_type) :: HI ! Make this a pointer?
- integer :: isc, iec, jsc, jec ! The range of the computational domain indices
- integer :: isd, ied, jsd, jed ! and data domain indices at tracer cell centers.
- integer :: isg, ieg, jsg, jeg ! The range of the global domain tracer cell indices.
- integer :: IscB, IecB, JscB, JecB ! The range of the computational domain indices
- integer :: IsdB, IedB, JsdB, JedB ! and data domain indices at tracer cell vertices.
- integer :: IsgB, IegB, JsgB, JegB ! The range of the global domain vertex indices.
- integer :: isd_global ! The values of isd and jsd in the global
- integer :: jsd_global ! (decomposition invariant) index space.
- integer :: idg_offset ! The offset between the corresponding global
- integer :: jdg_offset ! and local array indices.
- logical :: symmetric ! True if symmetric memory is used.
-
- logical :: nonblocking_updates ! If true, non-blocking halo updates are
- ! allowed. The default is .false. (for now).
- integer :: first_direction ! An integer that indicates which direction is
- ! to be updated first in directionally split
- ! parts of the calculation. This can be altered
- ! during the course of the run via calls to
- ! set_first_direction.
+ type(MOM_domain_type), pointer :: Domain => NULL() !< Ocean model domain
+ type(MOM_domain_type), pointer :: Domain_aux => NULL() !< A non-symmetric auxiliary domain type.
+ type(hor_index_type) :: HI !< Horizontal index ranges
+
+ integer :: isc !< The start i-index of cell centers within the computational domain
+ integer :: iec !< The end i-index of cell centers within the computational domain
+ integer :: jsc !< The start j-index of cell centers within the computational domain
+ integer :: jec !< The end j-index of cell centers within the computational domain
+
+ integer :: isd !< The start i-index of cell centers within the data domain
+ integer :: ied !< The end i-index of cell centers within the data domain
+ integer :: jsd !< The start j-index of cell centers within the data domain
+ integer :: jed !< The end j-index of cell centers within the data domain
+
+ integer :: isg !< The start i-index of cell centers within the global domain
+ integer :: ieg !< The end i-index of cell centers within the global domain
+ integer :: jsg !< The start j-index of cell centers within the global domain
+ integer :: jeg !< The end j-index of cell centers within the global domain
+
+ integer :: IscB !< The start i-index of cell vertices within the computational domain
+ integer :: IecB !< The end i-index of cell vertices within the computational domain
+ integer :: JscB !< The start j-index of cell vertices within the computational domain
+ integer :: JecB !< The end j-index of cell vertices within the computational domain
+
+ integer :: IsdB !< The start i-index of cell vertices within the data domain
+ integer :: IedB !< The end i-index of cell vertices within the data domain
+ integer :: JsdB !< The start j-index of cell vertices within the data domain
+ integer :: JedB !< The end j-index of cell vertices within the data domain
+
+ integer :: IsgB !< The start i-index of cell vertices within the global domain
+ integer :: IegB !< The end i-index of cell vertices within the global domain
+ integer :: JsgB !< The start j-index of cell vertices within the global domain
+ integer :: JegB !< The end j-index of cell vertices within the global domain
+
+ integer :: isd_global !< The value of isd in the global index space (decompoistion invariant).
+ integer :: jsd_global !< The value of isd in the global index space (decompoistion invariant).
+ integer :: idg_offset !< The offset between the corresponding global and local i-indices.
+ integer :: jdg_offset !< The offset between the corresponding global and local j-indices.
+ logical :: symmetric !< True if symmetric memory is used.
+
+ logical :: nonblocking_updates !< If true, non-blocking halo updates are
+ !! allowed. The default is .false. (for now).
+ integer :: first_direction !< An integer that indicates which direction is to be updated first in
+ !! directionally split parts of the calculation. This can be altered
+ !! during the course of the run via calls to set_first_direction.
real, allocatable, dimension(:,:) :: &
- mask2dT, & ! 0 for land points and 1 for ocean points on the h-grid. Nd.
- geoLatT, & ! The geographic latitude at q points in degrees of latitude or m.
- geoLonT, & ! The geographic longitude at q points in degrees of longitude or m.
- dxT, IdxT, & ! dxT is delta x at h points, in m, and IdxT is 1/dxT in m-1.
- dyT, IdyT, & ! dyT is delta y at h points, in m, and IdyT is 1/dyT in m-1.
- areaT, & ! areaT is the area of an h-cell, in m2.
- IareaT, & ! IareaT = 1/areaT, in m-2.
- sin_rot, & ! The sine and cosine of the angular rotation between the local
- cos_rot ! model grid's northward and the true northward directions.
+ mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid. Nd.
+ geoLatT, & !< The geographic latitude at q points in degrees of latitude or m.
+ geoLonT, & !< The geographic longitude at q points in degrees of longitude or m.
+ dxT, & !< dxT is delta x at h points, in m.
+ IdxT, & !< 1/dxT in m-1.
+ dyT, & !< dyT is delta y at h points, in m, and IdyT is 1/dyT in m-1.
+ IdyT, & !< dyT is delta y at h points, in m, and IdyT is 1/dyT in m-1.
+ areaT, & !< The area of an h-cell, in m2.
+ IareaT !< 1/areaT, in m-2.
+ real, allocatable, dimension(:,:) :: sin_rot
+ !< The sine of the angular rotation between the local model grid's northward
+ !! and the true northward directions.
+ real, allocatable, dimension(:,:) :: cos_rot
+ !< The cosine of the angular rotation between the local model grid's northward
+ !! and the true northward directions.
real, allocatable, dimension(:,:) :: &
- mask2dCu, & ! 0 for boundary points and 1 for ocean points on the u grid. Nondim.
- geoLatCu, & ! The geographic latitude at u points in degrees of latitude or m.
- geoLonCu, & ! The geographic longitude at u points in degrees of longitude or m.
- dxCu, IdxCu, & ! dxCu is delta x at u points, in m, and IdxCu is 1/dxCu in m-1.
- dyCu, IdyCu, & ! dyCu is delta y at u points, in m, and IdyCu is 1/dyCu in m-1.
- dy_Cu, & ! The unblocked lengths of the u-faces of the h-cell in m.
- IareaCu, & ! The masked inverse areas of u-grid cells in m2.
- areaCu ! The areas of the u-grid cells in m2.
+ mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid. Nondim.
+ geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m.
+ geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m.
+ dxCu, & !< dxCu is delta x at u points, in m.
+ IdxCu, & !< 1/dxCu in m-1.
+ dyCu, & !< dyCu is delta y at u points, in m.
+ IdyCu, & !< 1/dyCu in m-1.
+ dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell in m.
+ IareaCu, & !< The masked inverse areas of u-grid cells in m2.
+ areaCu !< The areas of the u-grid cells in m2.
real, allocatable, dimension(:,:) :: &
- mask2dCv, & ! 0 for boundary points and 1 for ocean points on the v grid. Nondim.
- geoLatCv, & ! The geographic latitude at v points in degrees of latitude or m.
- geoLonCv, & ! The geographic longitude at v points in degrees of longitude or m.
- dxCv, IdxCv, & ! dxCv is delta x at v points, in m, and IdxCv is 1/dxCv in m-1.
- dyCv, IdyCv, & ! dyCv is delta y at v points, in m, and IdyCv is 1/dyCv in m-1.
- dx_Cv, & ! The unblocked lengths of the v-faces of the h-cell in m.
- IareaCv, & ! The masked inverse areas of v-grid cells in m2.
- areaCv ! The areas of the v-grid cells in m2.
+ mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim.
+ geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m.
+ geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m.
+ dxCv, & !< dxCv is delta x at v points, in m.
+ IdxCv, & !< 1/dxCv in m-1.
+ dyCv, & !< dyCv is delta y at v points, in m.
+ IdyCv, & !< 1/dyCv in m-1.
+ dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell in m.
+ IareaCv, & !< The masked inverse areas of v-grid cells in m2.
+ areaCv !< The areas of the v-grid cells in m2.
real, allocatable, dimension(:,:) :: &
- mask2dBu, & ! 0 for boundary points and 1 for ocean points on the q grid. Nondim.
- geoLatBu, & ! The geographic latitude at q points in degrees of latitude or m.
- geoLonBu, & ! The geographic longitude at q points in degrees of longitude or m.
- dxBu, IdxBu, & ! dxBu is delta x at q points, in m, and IdxBu is 1/dxBu in m-1.
- dyBu, IdyBu, & ! dyBu is delta y at q points, in m, and IdyBu is 1/dyBu in m-1.
- areaBu, & ! areaBu is the area of a q-cell, in m2
- IareaBu ! IareaBu = 1/areaBu in m-2.
-
- real, pointer, dimension(:) :: &
- gridLatT => NULL(), gridLatB => NULL() ! The latitude of T or B points for
- ! the purpose of labeling the output axes.
- ! On many grids these are the same as geoLatT & geoLatBu.
- real, pointer, dimension(:) :: &
- gridLonT => NULL(), gridLonB => NULL() ! The longitude of T or B points for
- ! the purpose of labeling the output axes.
- ! On many grids these are the same as geoLonT & geoLonBu.
+ mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid. Nondim.
+ geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m.
+ geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m.
+ dxBu, & !< dxBu is delta x at q points, in m.
+ IdxBu, & !< 1/dxBu in m-1.
+ dyBu, & !< dyBu is delta y at q points, in m.
+ IdyBu, & !< 1/dyBu in m-1.
+ areaBu, & !< areaBu is the area of a q-cell, in m2
+ IareaBu !< IareaBu = 1/areaBu in m-2.
+
+ real, pointer, dimension(:) :: gridLatT => NULL()
+ !< The latitude of T points for the purpose of labeling the output axes.
+ !! On many grids this is the same as geoLatT.
+ real, pointer, dimension(:) :: gridLatB => NULL()
+ !< The latitude of B points for the purpose of labeling the output axes.
+ !! On many grids this is the same as geoLatBu.
+ real, pointer, dimension(:) :: gridLonT => NULL()
+ !< The longitude of T points for the purpose of labeling the output axes.
+ !! On many grids this is the same as geoLonT.
+ real, pointer, dimension(:) :: gridLonB => NULL()
+ !< The longitude of B points for the purpose of labeling the output axes.
+ !! On many grids this is the same as geoLonBu.
character(len=40) :: &
- x_axis_units, & ! The units that are used in labeling the coordinate
- y_axis_units ! axes. Except on a Cartesian grid, these are usually
- ! some variant of "degrees".
+ x_axis_units, & !< The units that are used in labeling the x coordinate axes.
+ y_axis_units !< The units that are used in labeling the y coordinate axes.
+ ! Except on a Cartesian grid, these are usually some variant of "degrees".
real, allocatable, dimension(:,:) :: &
- bathyT ! Ocean bottom depth at tracer points, in m.
+ bathyT !< Ocean bottom depth at tracer points, in depth units.
+ real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m.
- logical :: bathymetry_at_vel ! If true, there are separate values for the
- ! basin depths at velocity points. Otherwise the effects of
- ! of topography are entirely determined from thickness points.
+ logical :: bathymetry_at_vel !< If true, there are separate values for the
+ !! basin depths at velocity points. Otherwise the effects of
+ !! of topography are entirely determined from thickness points.
real, allocatable, dimension(:,:) :: &
- Dblock_u, & ! Topographic depths at u-points at which the flow is blocked
- Dopen_u ! (Dblock_u) and open at width dy_Cu (Dopen_u), both in m.
+ Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in depth units.
+ Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in depth units.
real, allocatable, dimension(:,:) :: &
- Dblock_v, & ! Topographic depths at v-points at which the flow is blocked
- Dopen_v ! (Dblock_v) and open at width dx_Cv (Dopen_v), both in m.
+ Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units.
+ Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units.
real, allocatable, dimension(:,:) :: &
- CoriolisBu ! The Coriolis parameter at corner points, in s-1.
+ CoriolisBu !< The Coriolis parameter at corner points, in s-1.
real, allocatable, dimension(:,:) :: &
- dF_dx, dF_dy ! Derivatives of f (Coriolis parameter) at h-points, in s-1 m-1.
+ df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points, in s-1 m-1.
+ df_dy !< Derivative d/dy f (Coriolis parameter) at h-points, in s-1 m-1.
! These variables are global sums that are useful for 1-d diagnostics
- real :: areaT_global ! Global sum of h-cell area in m2
- real :: IareaT_global ! Global sum of inverse h-cell area (1/areaT_global)
- ! in m2
+ real :: areaT_global !< Global sum of h-cell area in m2
+ real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) in m2
! These parameters are run-time parameters that are used during some
! initialization routines (but not all)
- real :: south_lat ! The latitude (or y-coordinate) of the first v-line
- real :: west_lon ! The longitude (or x-coordinate) of the first u-line
- real :: len_lat = 0. ! The latitudinal (or y-coord) extent of physical domain
- real :: len_lon = 0. ! The longitudinal (or x-coord) extent of physical domain
- real :: Rad_Earth = 6.378e6 ! The radius of the planet in meters.
- real :: max_depth ! The maximum depth of the ocean in meters.
+ real :: south_lat !< The latitude (or y-coordinate) of the first v-line
+ real :: west_lon !< The longitude (or x-coordinate) of the first u-line
+ real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain
+ real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain
+ real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters.
+ real :: max_depth !< The maximum depth of the ocean in depth units (scaled by Zd_to_m).
end type dyn_horgrid_type
contains
@@ -232,6 +274,40 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel)
end subroutine create_dyn_horgrid
+!> rescale_dyn_horgrid_bathymetry permits a change in the internal units for the bathymetry on the
+!! grid, both rescaling the depths and recording the new internal depth units.
+subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units)
+ type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type
+ real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth.
+
+ ! Local variables
+ real :: rescale
+ integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
+
+ isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
+ IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
+
+ if (m_in_new_units == G%Zd_to_m) return
+ if (m_in_new_units < 0.0) &
+ call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.")
+ if (m_in_new_units == 0.0) &
+ call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.")
+
+ rescale = G%Zd_to_m / m_in_new_units
+ do j=jsd,jed ; do i=isd,ied
+ G%bathyT(i,j) = rescale*G%bathyT(i,j)
+ enddo ; enddo
+ if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB
+ G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j)
+ enddo ; enddo ; endif
+ if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied
+ G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J)
+ enddo ; enddo ; endif
+ G%max_depth = rescale*G%max_depth
+ G%Zd_to_m = m_in_new_units
+
+end subroutine rescale_dyn_horgrid_bathymetry
+
!> set_derived_dyn_horgrid calculates metric terms that are derived from other metrics.
subroutine set_derived_dyn_horgrid(G)
type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type
diff --git a/src/framework/MOM_error_handler.F90 b/src/framework/MOM_error_handler.F90
index e1a85b52c4..30300d6e33 100644
--- a/src/framework/MOM_error_handler.F90
+++ b/src/framework/MOM_error_handler.F90
@@ -1,16 +1,8 @@
+!> Routines for error handling and I/O management
module MOM_error_handler
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By R. Hallberg, 2005-2012. *
-!* *
-!* This module wraps the mpp_mod error handling code and the *
-!* mpp functions stdlog() and stdout() that return open unit numbers. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use mpp_mod, only : mpp_error, NOTE, WARNING, FATAL
use mpp_mod, only : mpp_pe, mpp_root_pe, stdlog, stdout
@@ -21,18 +13,19 @@ module MOM_error_handler
public callTree_showQuery, callTree_enter, callTree_leave, callTree_waypoint
public assert
-! Verbosity level:
-! 0 - FATAL messages only
-! 1 - FATAL + WARNING messages only
-! 2 - FATAL + WARNING + NOTE messages only [default]
-! 3 - above + informational
-! 4 -
-! 5 -
-! 6 - above + call tree
-! 7 -
-! 8 -
-! 9 - anything and everything (also set with #define DEBUG)
integer :: verbosity = 6
+!< Verbosity level:
+!! 0 - FATAL messages only
+!! 1 - FATAL + WARNING messages only
+!! 2 - FATAL + WARNING + NOTE messages only [default]
+!! 3 - above + informational
+!! 4 -
+!! 5 -
+!! 6 - above + call tree
+!! 7 -
+!! 8 -
+!! 9 - anything and everything (also set with DEBUG=True)
+
! Note that this module default will only hold until the
! VERBOSITY parameter is parsed and the given default imposed.
! We set it to 6 here so that the call tree will print before
@@ -41,8 +34,8 @@ module MOM_error_handler
! a type passed by argument (preferred for most data) for convenience
! and to reduce obfuscation of code
-! The level of calling within the call tree
integer :: callTreeIndentLevel = 0
+!< The level of calling within the call tree
contains
diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90
index e22b36e5cd..5c80fb9d51 100644
--- a/src/framework/MOM_file_parser.F90
+++ b/src/framework/MOM_file_parser.F90
@@ -1,38 +1,13 @@
+!> The MOM6 facility to parse input files for runtime parameters
module MOM_file_parser
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg and Alistair Adcroft, updated 9/2013. *
-!* *
-!* The subroutines here parse a set of input files for the value *
-!* a named parameter and sets that parameter at run time. Currently *
-!* these files use use one of several formats: *
-!* #define VAR ! To set the logical VAR to true. *
-!* VAR = True ! To set the logical VAR to true. *
-!* #undef VAR ! To set the logical VAR to false. *
-!* VAR = False ! To set the logical VAR to false. *
-!* #define VAR 999 ! To set the real or integer VAR to 999. *
-!* VAR = 999 ! To set the real or integer VAR to 999. *
-!* #override VAR = 888 ! To override a previously set value. *
-!* VAR = 1.1, 2.2, 3.3 ! To set an array of real values. *
-!* *
-!* In addition, when set by the get_param interface, the values of *
-!* parameters are automatically logged, along with defaults, units, *
-!* and a description. It is an error for a variable to be overridden *
-!* more than once, and MOM6 has a facility to check for unused lines *
-!* to set variables, which may indicate miss-spelled or archaic *
-!* parameters. Parameter names are case-specific, and lines may use *
-!* a F90 or C++ style comment, starting with ! or //. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_coms, only : root_PE, broadcast
use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg
use MOM_error_handler, only : is_root_pe, stdlog, stdout
-use MOM_time_manager, only : set_time, get_time, time_type, get_ticks_per_second
-use MOM_time_manager, only : set_date, get_date
+use MOM_time_manager, only : get_time, time_type, get_ticks_per_second
+use MOM_time_manager, only : set_date, get_date, real_to_time, operator(-), set_time
use MOM_document, only : doc_param, doc_module, doc_init, doc_end, doc_type
use MOM_document, only : doc_openBlock, doc_closeBlock
use MOM_string_functions, only : left_int, left_ints, slasher
@@ -40,40 +15,45 @@ module MOM_file_parser
implicit none ; private
-integer, parameter, public :: MAX_PARAM_FILES = 5 ! Maximum number of parameter files.
-integer, parameter :: INPUT_STR_LENGTH = 320 ! Maximum linelength in parameter file.
-integer, parameter :: FILENAME_LENGTH = 200 ! Maximum number of characters in
- ! file names.
+integer, parameter, public :: MAX_PARAM_FILES = 5 !< Maximum number of parameter files.
+integer, parameter :: INPUT_STR_LENGTH = 320 !< Maximum line length in parameter file.
+integer, parameter :: FILENAME_LENGTH = 200 !< Maximum number of characters in file names.
! The all_PEs_read option should be eliminated with post-riga shared code.
-logical :: all_PEs_read = .false.
+logical :: all_PEs_read = .false. !< If true, all PEs read the input files
+ !! TODO: Eliminate this parameter
-! Defaults
+!>@{ Default values for parameters
logical, parameter :: report_unused_default = .false.
logical, parameter :: unused_params_fatal_default = .false.
logical, parameter :: log_to_stdout_default = .false.
logical, parameter :: complete_doc_default = .true.
logical, parameter :: minimal_doc_default = .true.
+!!@}
+!> The valid lines extracted from an input parameter file without comments
type, private :: file_data_type ; private
- integer :: num_lines = 0
- character(len=INPUT_STR_LENGTH), pointer, dimension(:) :: line => NULL()
- logical, pointer, dimension(:) :: line_used => NULL()
+ integer :: num_lines = 0 !< The number of lines in this type
+ character(len=INPUT_STR_LENGTH), pointer, dimension(:) :: line => NULL() !< The line content
+ logical, pointer, dimension(:) :: line_used => NULL() !< If true, the line has been read
end type file_data_type
+!> A link in the list of variables that have already had override warnings issued
type :: link_parameter ; private
- type(link_parameter), pointer :: next => NULL() ! Facilitates linked list
- character(len=80) :: name ! Parameter name
- logical :: hasIssuedOverrideWarning = .false. ! Has a default value
+ type(link_parameter), pointer :: next => NULL() !< Facilitates linked list
+ character(len=80) :: name !< Parameter name
+ logical :: hasIssuedOverrideWarning = .false. !< Has a default value
end type link_parameter
+!> Specify the active parameter block
type :: parameter_block ; private
- character(len=240) :: name = '' ! Parameter name
+ character(len=240) :: name = '' !< The active parameter block name
end type parameter_block
+!> A structure that can be parsed to read and document run-time parameters.
type, public :: param_file_type ; private
integer :: nfiles = 0 !< The number of open files.
- integer :: iounit(MAX_PARAM_FILES) !< The unit numbers of open files.
+ integer :: iounit(MAX_PARAM_FILES) !< The unit numbers of open files.
character(len=FILENAME_LENGTH) :: filename(MAX_PARAM_FILES) !< The names of the open files.
logical :: NetCDF_file(MAX_PARAM_FILES) !< If true, the input file is in NetCDF.
! This is not yet implemented.
@@ -88,7 +68,8 @@ module MOM_file_parser
logical :: log_to_stdout = log_to_stdout_default !< If true, all log
!! messages are also sent to stdout.
logical :: log_open = .false. !< True if the log file has been opened.
- integer :: stdout, stdlog !< The units from stdout() and stdlog().
+ integer :: stdout !< The unit number from stdout().
+ integer :: stdlog !< The unit number from stdlog().
character(len=240) :: doc_file !< A file where all run-time parameters, their
!! settings and defaults are documented.
logical :: complete_doc = complete_doc_default !< If true, document all
@@ -117,7 +98,7 @@ module MOM_file_parser
log_param_char, log_param_time, &
log_param_int_array, log_param_real_array
end interface
-!> An overloaded interface to log the values of various types of parameters
+!> An overloaded interface to read and log the values of various types of parameters
interface get_param
module procedure get_param_int, get_param_real, get_param_logical, &
get_param_char, get_param_char_array, get_param_time, &
@@ -143,10 +124,11 @@ subroutine open_param_file(filename, CS, checkable, component, doc_file_dir)
character(len=*), optional, intent(in) :: doc_file_dir !< An optional directory in which to write out
!! the documentation files. The default is effectively './'.
+ ! Local variables
logical :: file_exists, unit_in_use, Netcdf_file, may_check
integer :: ios, iounit, strlen, i
character(len=240) :: doc_path
- type(parameter_block), pointer :: block
+ type(parameter_block), pointer :: block => NULL()
may_check = .true. ; if (present(checkable)) may_check = checkable
@@ -263,14 +245,11 @@ subroutine close_param_file(CS, quiet_close, component)
!! logging with this call.
character(len=*), optional, intent(in) :: component !< If present, this component name is used
!! to generate parameter documentation file names
-! Arguments: CS - the param_file_type to close
-! (in,opt) quiet_close - if present and true, do not do any logging with this
-! call.
-
+ ! Local variables
character(len=128) :: docfile_default
character(len=40) :: mdl ! This module's name.
-! This include declares and sets the variable "version".
-#include "version_variable.h"
+ ! This include declares and sets the variable "version".
+# include "version_variable.h"
integer :: i, n, num_unused
if (present(quiet_close)) then ; if (quiet_close) then
@@ -361,13 +340,14 @@ subroutine populate_param_data(iounit, filename, param_data)
type(file_data_type), intent(inout) :: param_data !< A list of the input lines that set parameters
!! after comments have been stripped out.
+ ! Local variables
character(len=INPUT_STR_LENGTH) :: line
integer :: num_lines
logical :: inMultiLineComment
-! Find the number of keyword lines in a parameter file
-! Allocate the space to hold the lines in param_data%line
-! Populate param_data%line with the keyword lines from parameter file
+ ! Find the number of keyword lines in a parameter file
+ ! Allocate the space to hold the lines in param_data%line
+ ! Populate param_data%line with the keyword lines from parameter file
if (iounit <= 0) return
@@ -456,8 +436,10 @@ end subroutine populate_param_data
function openMultiLineComment(string)
character(len=*), intent(in) :: string !< The input string to process
logical :: openMultiLineComment
-! True if a /* appears on this line without a closing */
+
+ ! Local variables
integer :: icom, last
+
openMultiLineComment = .false.
last = lastNonCommentIndex(string)+1
icom = index(string(last:), "/*")
@@ -482,9 +464,11 @@ end function closeMultiLineComment
function lastNonCommentIndex(string)
character(len=*), intent(in) :: string !< The input string to process
integer :: lastNonCommentIndex
-! Find position of last character before any comments
-! This s/r is the only place where a comment needs to be defined
+
+ ! Local variables
integer :: icom, last
+
+ ! This subroutine is the only place where a comment needs to be defined
last = len_trim(string)
icom = index(string(:last), "!") ; if (icom > 0) last = icom-1 ! F90 style
icom = index(string(:last), "//") ; if (icom > 0) last = icom-1 ! C++ style
@@ -496,7 +480,7 @@ end function lastNonCommentIndex
function lastNonCommentNonBlank(string)
character(len=*), intent(in) :: string !< The input string to process
integer :: lastNonCommentNonBlank
-! Find position of last non-blank character before any comments
+
lastNonCommentNonBlank = len_trim(string(:lastNonCommentIndex(string))) ! Ignore remaining trailing blanks
end function lastNonCommentNonBlank
@@ -504,8 +488,9 @@ end function lastNonCommentNonBlank
function replaceTabs(string)
character(len=*), intent(in) :: string !< The input string to process
character(len=len(string)) :: replaceTabs
-! Returns string with tabs replaced by a blank
+
integer :: i
+
do i=1, len(string)
if (string(i:i)==achar(9)) then
replaceTabs(i:i)=" "
@@ -519,8 +504,9 @@ end function replaceTabs
function removeComments(string)
character(len=*), intent(in) :: string !< The input string to process
character(len=len(string)) :: removeComments
-! Trims comments and leading blanks from string
+
integer :: last
+
removeComments=repeat(" ",len(string))
last = lastNonCommentNonBlank(string)
removeComments(:last)=adjustl(string(:last)) ! Copy only the non-comment part of string
@@ -531,11 +517,12 @@ end function removeComments
function simplifyWhiteSpace(string)
character(len=*), intent(in) :: string !< A string to modify to simpify white space
character(len=len(string)+16) :: simplifyWhiteSpace
-! Constructs a string with all repeated whitespace replaced with single blanks
-! and insert white space where it helps delineate tokens (e.g. around =)
+
+ ! Local variables
integer :: i,j
logical :: nonBlank = .false., insideString = .false.
character(len=1) :: quoteChar=" "
+
nonBlank = .false.; insideString = .false. ! NOTE: For some reason this line is needed??
i=0
simplifyWhiteSpace=repeat(" ",len(string)+16)
@@ -589,11 +576,7 @@ subroutine read_param_int(CS, varname, value, fail_if_missing)
!! read from the parameter file
logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
!! if this variable is not found in the parameter file
-! This subroutine determines the value of an integer model parameter
-! from a parameter file. The arguments are the unit of the open file
-! which is to be read, the (case-sensitive) variable name, the variable
-! where the value is to be stored, and (optionally) a flag indicating
-! whether to fail if this parameter can not be found.
+ ! Local variables
character(len=INPUT_STR_LENGTH) :: value_string(1)
logical :: found, defined
@@ -625,11 +608,7 @@ subroutine read_param_int_array(CS, varname, value, fail_if_missing)
!! read from the parameter file
logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
!! if this variable is not found in the parameter file
-! This subroutine determines the value of an integer model parameter
-! from a parameter file. The arguments are the unit of the open file
-! which is to be read, the (case-sensitive) variable name, the variable
-! where the value is to be stored, and (optionally) a flag indicating
-! whether to fail if this parameter can not be found.
+ ! Local variables
character(len=INPUT_STR_LENGTH) :: value_string(1)
logical :: found, defined
@@ -654,25 +633,25 @@ subroutine read_param_int_array(CS, varname, value, fail_if_missing)
end subroutine read_param_int_array
!> This subroutine reads the value of a real model parameter from a parameter file.
-subroutine read_param_real(CS, varname, value, fail_if_missing)
- type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
+subroutine read_param_real(CS, varname, value, fail_if_missing, scale)
+ type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
!! it is also a structure to parse for run-time parameters
- character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
- real, intent(inout) :: value !< The value of the parameter that may be
+ character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
+ real, intent(inout) :: value !< The value of the parameter that may be
!! read from the parameter file
- logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
+ logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
!! if this variable is not found in the parameter file
-! This subroutine determines the value of an integer model parameter
-! from a parameter file. The arguments are the unit of the open file
-! which is to be read, the (case-sensitive) variable name, the variable
-! where the value is to be stored, and (optionally) a flag indicating
-! whether to fail if this parameter can not be found.
+ real, optional, intent(in) :: scale !< A scaling factor that the parameter is multiplied
+ !! by before it is returned.
+
+ ! Local variables
character(len=INPUT_STR_LENGTH) :: value_string(1)
logical :: found, defined
call get_variable_line(CS, varname, found, defined, value_string)
if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then
read(value_string(1),*,err=1003) value
+ if (present(scale)) value = scale*value
else
if (present(fail_if_missing)) then ; if (fail_if_missing) then
if (.not.found) then
@@ -690,26 +669,27 @@ subroutine read_param_real(CS, varname, value, fail_if_missing)
end subroutine read_param_real
!> This subroutine reads the values of an array of real model parameters from a parameter file.
-subroutine read_param_real_array(CS, varname, value, fail_if_missing)
- type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
+subroutine read_param_real_array(CS, varname, value, fail_if_missing, scale)
+ type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
!! it is also a structure to parse for run-time parameters
- character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
- real, dimension(:), intent(inout) :: value !< The value of the parameter that may be
+ character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
+ real, dimension(:), intent(inout) :: value !< The value of the parameter that may be
!! read from the parameter file
- logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
+ logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
!! if this variable is not found in the parameter file
-! This subroutine determines the value of an integer model parameter
-! from a parameter file. The arguments are the unit of the open file
-! which is to be read, the (case-sensitive) variable name, the variable
-! where the value is to be stored, and (optionally) a flag indicating
-! whether to fail if this parameter can not be found.
+ real, optional, intent(in) :: scale !< A scaling factor that the parameter is multiplied
+ !! by before it is returned.
+
+ ! Local variables
character(len=INPUT_STR_LENGTH) :: value_string(1)
logical :: found, defined
call get_variable_line(CS, varname, found, defined, value_string)
if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then
read(value_string(1),*,end=991,err=1004) value
- 991 return
+991 continue
+ if (present(scale)) value(:) = scale*value(:)
+ return
else
if (present(fail_if_missing)) then ; if (fail_if_missing) then
if (.not.found) then
@@ -735,11 +715,7 @@ subroutine read_param_char(CS, varname, value, fail_if_missing)
!! read from the parameter file
logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
!! if this variable is not found in the parameter file
-! This subroutine determines the value of an integer model parameter
-! from a parameter file. The arguments are the unit of the open file
-! which is to be read, the (case-sensitive) variable name, the variable
-! where the value is to be stored, and (optionally) a flag indicating
-! whether to fail if this parameter can not be found.
+ ! Local variables
character(len=INPUT_STR_LENGTH) :: value_string(1)
logical :: found, defined
@@ -762,11 +738,8 @@ subroutine read_param_char_array(CS, varname, value, fail_if_missing)
!! read from the parameter file
logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
!! if this variable is not found in the parameter file
-! This subroutine determines the value of an integer model parameter
-! from a parameter file. The arguments are the unit of the open file
-! which is to be read, the (case-sensitive) variable name, the variable
-! where the value is to be stored, and (optionally) a flag indicating
-! whether to fail if this parameter can not be found.
+
+ ! Local variables
character(len=INPUT_STR_LENGTH) :: value_string(1), loc_string
logical :: found, defined
integer :: i, i_out
@@ -803,11 +776,8 @@ subroutine read_param_logical(CS, varname, value, fail_if_missing)
!! read from the parameter file
logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
!! if this variable is not found in the parameter file
-! This subroutine determines the value of an integer model parameter
-! from a parameter file. The arguments are the unit of the open file
-! which is to be read, the (case-sensitive) variable name, the variable
-! where the value is to be stored, and (optionally) a flag indicating
-! whether to fail if this parameter can not be found.
+
+ ! Local variables
character(len=INPUT_STR_LENGTH) :: value_string(1)
logical :: found, defined
@@ -833,17 +803,13 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f
logical, optional, intent(out) :: date_format !< If present, this indicates whether this
!! parameter was read in a date format, so that it can
!! later be logged in the same format.
-! This subroutine determines the value of an time-type model parameter
-! from a parameter file. The arguments are the unit of the open file
-! which is to be read, the (case-sensitive) variable name, the variable
-! where the value is to be stored, and (optionally) a flag indicating
-! whether to fail if this parameter can not be found. The unique argument
-! to read time is the number of seconds to use as the unit of time being read.
+
+ ! Local variables
character(len=INPUT_STR_LENGTH) :: value_string(1)
character(len=240) :: err_msg
logical :: found, defined
real :: real_time, time_unit
- integer :: days, secs, vals(7)
+ integer :: vals(7)
if (present(date_format)) date_format = .false.
@@ -876,10 +842,8 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f
else
time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit
read( value_string(1), *) real_time
- days = int(real_time*(time_unit/86400.0))
- secs = int(floor((real_time*(time_unit/86400.0)-days)*86400.0 + 0.5))
- value = set_time(secs, days)
- endif
+ value = real_to_time(real_time*time_unit)
+ endif
else
if (present(fail_if_missing)) then ; if (fail_if_missing) then
if (.not.found) then
@@ -930,6 +894,7 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL
logical, optional, intent(in) :: paramIsLogical !< If true, this is a logical parameter
!! that can be simply defined without parsing a value_string.
+ ! Local variables
character(len=INPUT_STR_LENGTH) :: val_str, lname, origLine
character(len=INPUT_STR_LENGTH) :: line, continuationBuffer, blockName
character(len=FILENAME_LENGTH) :: filename
@@ -1248,11 +1213,13 @@ end subroutine flag_line_as_read
!> Returns true if an override warning has been issued for the variable varName
function overrideWarningHasBeenIssued(chain, varName)
- type(link_parameter), pointer :: chain
+ type(link_parameter), pointer :: chain !< The linked list of variables that have already had
+ !! override warnings issued
character(len=*), intent(in) :: varName !< The name of the variable being queried for warnings
logical :: overrideWarningHasBeenIssued
-! Returns true if an override warning has been issued for the variable varName
- type(link_parameter), pointer :: newLink, this
+ ! Local variables
+ type(link_parameter), pointer :: newLink => NULL(), this => NULL()
+
overrideWarningHasBeenIssued = .false.
this => chain
do while( associated(this) )
@@ -1314,15 +1281,14 @@ subroutine log_param_int(CS, modulename, varname, value, desc, units, &
character(len=*), intent(in) :: varname !< The name of the parameter to log
integer, intent(in) :: value !< The value of the parameter to log
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
integer, optional, intent(in) :: default !< The default value of the parameter
- logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
!! logged in the layout parameter file
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
-! This subroutine writes the value of an integer parameter to a log file,
-! along with its name and the module it came from.
+
character(len=240) :: mesg, myunits
write(mesg, '(" ",a," ",a,": ",a)') trim(modulename), trim(varname), trim(left_int(value))
@@ -1347,15 +1313,14 @@ subroutine log_param_int_array(CS, modulename, varname, value, desc, &
character(len=*), intent(in) :: varname !< The name of the parameter to log
integer, dimension(:), intent(in) :: value !< The value of the parameter to log
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
integer, optional, intent(in) :: default !< The default value of the parameter
- logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
!! logged in the layout parameter file
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
-! This subroutine writes the value of an integer parameter to a log file,
-! along with its name and the module it came from.
+
character(len=1320) :: mesg
character(len=240) :: myunits
@@ -1381,13 +1346,12 @@ subroutine log_param_real(CS, modulename, varname, value, desc, units, &
character(len=*), intent(in) :: varname !< The name of the parameter to log
real, intent(in) :: value !< The value of the parameter to log
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
real, optional, intent(in) :: default !< The default value of the parameter
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
-! This subroutine writes the value of a real parameter to a log file,
-! along with its name and the module it came from.
+
character(len=240) :: mesg, myunits
write(mesg, '(" ",a," ",a,": ",a)') &
@@ -1413,11 +1377,10 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, &
character(len=*), intent(in) :: varname !< The name of the parameter to log
real, dimension(:), intent(in) :: value !< The value of the parameter to log
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
real, optional, intent(in) :: default !< The default value of the parameter
-! This subroutine writes the value of a real parameter to a log file,
-! along with its name and the module it came from.
+
character(len=1320) :: mesg
character(len=240) :: myunits
@@ -1446,15 +1409,14 @@ subroutine log_param_logical(CS, modulename, varname, value, desc, &
character(len=*), intent(in) :: varname !< The name of the parameter to log
logical, intent(in) :: value !< The value of the parameter to log
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
logical, optional, intent(in) :: default !< The default value of the parameter
- logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
!! logged in the layout parameter file
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
-! This subroutine writes the value of a logical parameter to a log file,
-! along with its name and the module it came from.
+
character(len=240) :: mesg, myunits
if (value) then
@@ -1483,15 +1445,14 @@ subroutine log_param_char(CS, modulename, varname, value, desc, units, &
character(len=*), intent(in) :: varname !< The name of the parameter to log
character(len=*), intent(in) :: value !< The value of the parameter to log
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
character(len=*), optional, intent(in) :: default !< The default value of the parameter
- logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
!! logged in the layout parameter file
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
-! This subroutine writes the value of a character string parameter to a log
-! file, along with its name and the module it came from.
+
character(len=240) :: mesg, myunits
write(mesg, '(" ",a," ",a,": ",a)') &
@@ -1518,18 +1479,19 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, &
character(len=*), intent(in) :: varname !< The name of the parameter to log
type(time_type), intent(in) :: value !< The value of the parameter to log
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
type(time_type), optional, intent(in) :: default !< The default value of the parameter
real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for
!! real-number output.
logical, optional, intent(in) :: log_date !< If true, log the time_type in date format.
!! If missing the default is false.
- logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
!! logged in the layout parameter file
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
+ ! Local variables
real :: real_time, real_default
logical :: use_timeunit, date_format
character(len=240) :: mesg, myunits
@@ -1603,6 +1565,7 @@ function convert_date_to_string(date) result(date_string)
type(time_type), intent(in) :: date !< The date to be translated into a string.
character(len=40) :: date_string !< A date string in a format like YYYY-MM-DD HH:MM:SS.sss
+ ! Local variables
character(len=40) :: sub_string
real :: real_secs
integer :: yrs, mons, days, hours, mins, secs, ticks, ticks_per_sec
@@ -1639,7 +1602,7 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, &
integer, intent(inout) :: value !< The value of the parameter that may be
!! read from the parameter file and logged
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
integer, optional, intent(in) :: default !< The default value of the parameter
integer, optional, intent(in) :: static_value !< If this parameter is static, it takes
@@ -1651,12 +1614,11 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, &
!! value for this parameter, although it might be logged.
logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
!! parameter to the documentation files
- logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
!! logged in the layout parameter file
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
-! This subroutine writes the value of a real parameter to a log file,
-! along with its name and the module it came from.
+
logical :: do_read, do_log
do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
@@ -1687,7 +1649,7 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, &
integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be reset
!! from the parameter file
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
integer, optional, intent(in) :: default !< The default value of the parameter
integer, optional, intent(in) :: static_value !< If this parameter is static, it takes
@@ -1699,12 +1661,11 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, &
!! value for this parameter, although it might be logged.
logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
!! parameter to the documentation files
- logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
!! logged in the layout parameter file
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
-! This subroutine writes the value of a real parameter to a log file,
-! along with its name and the module it came from.
+
logical :: do_read, do_log
do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
@@ -1727,7 +1688,7 @@ end subroutine get_param_int_array
!! and logs it in documentation files.
subroutine get_param_real(CS, modulename, varname, value, desc, units, &
default, fail_if_missing, do_not_read, do_not_log, &
- static_value, debuggingParam)
+ static_value, debuggingParam, scale, unscaled)
type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
!! it is also a structure to parse for run-time parameters
character(len=*), intent(in) :: modulename !< The name of the calling module
@@ -1735,7 +1696,7 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, &
real, intent(inout) :: value !< The value of the parameter that may be
!! read from the parameter file and logged
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
real, optional, intent(in) :: default !< The default value of the parameter
real, optional, intent(in) :: static_value !< If this parameter is static, it takes
@@ -1747,10 +1708,13 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, &
!! value for this parameter, although it might be logged.
logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
!! parameter to the documentation files
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
-! This subroutine writes the value of a real parameter to a log file,
-! along with its name and the module it came from.
+ real, optional, intent(in) :: scale !< A scaling factor that the parameter is
+ !! multiplied by before it is returned.
+ real, optional, intent(out) :: unscaled !< The value of the parameter that would be
+ !! returned without any multiplication by a scaling factor.
+
logical :: do_read, do_log
do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
@@ -1767,12 +1731,15 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, &
default, debuggingParam)
endif
+ if (present(unscaled)) unscaled = value
+ if (present(scale)) value = scale*value
+
end subroutine get_param_real
!> This subroutine reads the values of an array of real model parameters from a parameter file
!! and logs them in documentation files.
subroutine get_param_real_array(CS, modulename, varname, value, desc, units, &
- default, fail_if_missing, do_not_read, do_not_log, static_value)
+ default, fail_if_missing, do_not_read, do_not_log, static_value, scale, unscaled)
type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
!! it is also a structure to parse for run-time parameters
character(len=*), intent(in) :: modulename !< The name of the calling module
@@ -1780,7 +1747,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, &
real, dimension(:), intent(inout) :: value !< The value of the parameter that may be
!! read from the parameter file and logged
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
real, optional, intent(in) :: default !< The default value of the parameter
real, optional, intent(in) :: static_value !< If this parameter is static, it takes
@@ -1792,6 +1759,10 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, &
!! value for this parameter, although it might be logged.
logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
!! parameter to the documentation files
+ real, optional, intent(in) :: scale !< A scaling factor that the parameter is
+ !! multiplied by before it is returned.
+ real, dimension(:), optional, intent(out) :: unscaled !< The value of the parameter that would be
+ !! returned without any multiplication by a scaling factor.
logical :: do_read, do_log
@@ -1809,6 +1780,9 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, &
units, default)
endif
+ if (present(unscaled)) unscaled(:) = value(:)
+ if (present(scale)) value(:) = scale*value(:)
+
end subroutine get_param_real_array
!> This subroutine reads the value of a character string model parameter from a parameter file
@@ -1823,7 +1797,7 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, &
character(len=*), intent(inout) :: value !< The value of the parameter that may be
!! read from the parameter file and logged
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
character(len=*), optional, intent(in) :: default !< The default value of the parameter
character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes
@@ -1835,12 +1809,11 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, &
!! value for this parameter, although it might be logged.
logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
!! parameter to the documentation files
- logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
!! logged in the layout parameter file
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
-! This subroutine writes the value of a real parameter to a log file,
-! along with its name and the module it came from.
+
logical :: do_read, do_log
do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
@@ -1870,7 +1843,7 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, &
character(len=*), dimension(:), intent(inout) :: value !< The value of the parameter that may be
!! read from the parameter file and logged
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
character(len=*), optional, intent(in) :: default !< The default value of the parameter
character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes
@@ -1882,8 +1855,8 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, &
!! value for this parameter, although it might be logged.
logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
!! parameter to the documentation files
-! This subroutine writes the value of a real parameter to a log file,
-! along with its name and the module it came from.
+
+ ! Local variables
logical :: do_read, do_log
integer :: i, len_tot, len_val
character(len=240) :: cat_val
@@ -1924,7 +1897,7 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, &
logical, intent(inout) :: value !< The value of the parameter that may be
!! read from the parameter file and logged
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
logical, optional, intent(in) :: default !< The default value of the parameter
logical, optional, intent(in) :: static_value !< If this parameter is static, it takes
@@ -1936,12 +1909,11 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, &
!! value for this parameter, although it might be logged.
logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
!! parameter to the documentation files
- logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
!! logged in the layout parameter file
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
-! This subroutine writes the value of a real parameter to a log file,
-! along with its name and the module it came from.
+
logical :: do_read, do_log
do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
@@ -1973,7 +1945,7 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, &
type(time_type), intent(inout) :: value !< The value of the parameter that may be
!! read from the parameter file and logged
character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
- !! present, this paramter is not written to a doc file
+ !! present, this parameter is not written to a doc file
character(len=*), optional, intent(in) :: units !< The units of this parameter
type(time_type), optional, intent(in) :: default !< The default value of the parameter
type(time_type), optional, intent(in) :: static_value !< If this parameter is static, it takes
@@ -1987,14 +1959,13 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, &
!! parameter to the documentation files
real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for
!! real-number input to be translated to a time.
- logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
!! logged in the layout parameter file
- logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is
+ logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
!! logged in the debugging parameter file
logical, optional, intent(in) :: log_as_date !< If true, log the time_type in date
!! format. The default is false.
-! This subroutine writes the value of a real parameter to a log file,
-! along with its name and the module it came from.
+
logical :: do_read, do_log, date_format, log_date
do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
@@ -2022,8 +1993,8 @@ end subroutine get_param_time
subroutine clearParameterBlock(CS)
type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
!! it is also a structure to parse for run-time parameters
-! Resets the parameter block name to blank
- type(parameter_block), pointer :: block
+
+ type(parameter_block), pointer :: block => NULL()
if (associated(CS%blockName)) then
block => CS%blockName
block%name = ''
@@ -2039,8 +2010,8 @@ subroutine openParameterBlock(CS,blockName,desc)
!! it is also a structure to parse for run-time parameters
character(len=*), intent(in) :: blockName !< The name of a parameter block being added
character(len=*), optional, intent(in) :: desc !< A description of the parameter block being added
-! Tags blockName onto the end of the active parameter block name
- type(parameter_block), pointer :: block
+
+ type(parameter_block), pointer :: block => NULL()
if (associated(CS%blockName)) then
block => CS%blockName
block%name = pushBlockLevel(block%name,blockName)
@@ -2055,8 +2026,8 @@ end subroutine openParameterBlock
subroutine closeParameterBlock(CS)
type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
!! it is also a structure to parse for run-time parameters
-! Remove the lowest level of recursion from the active block name
- type(parameter_block), pointer :: block
+
+ type(parameter_block), pointer :: block => NULL()
if (associated(CS%blockName)) then
block => CS%blockName
@@ -2076,7 +2047,7 @@ function pushBlockLevel(oldblockName,newBlockName)
character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names
character(len=*), intent(in) :: newBlockName !< A new block name to add to the end of the sequence
character(len=len(oldBlockName)+40) :: pushBlockLevel
-! Extends block name (deeper level of parameter block)
+
if (len_trim(oldBlockName)>0) then
pushBlockLevel=trim(oldBlockName)//'%'//trim(newBlockName)
else
@@ -2088,7 +2059,7 @@ end function pushBlockLevel
function popBlockLevel(oldblockName)
character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names
character(len=len(oldBlockName)+40) :: popBlockLevel
-! Truncates block name (shallower level of parameter block)
+
integer :: i
i = index(trim(oldBlockName), '%', .true.)
if (i>1) then
@@ -2101,4 +2072,29 @@ function popBlockLevel(oldblockName)
endif
end function popBlockLevel
+!> \namespace mom_file_parser
+!!
+!! By Robert Hallberg and Alistair Adcroft, updated 9/2013.
+!!
+!! The subroutines here parse a set of input files for the value
+!! a named parameter and sets that parameter at run time. Currently
+!! these files use use one of several formats:
+!! \#define VAR ! To set the logical VAR to true.
+!! VAR = True ! To set the logical VAR to true.
+!! \#undef VAR ! To set the logical VAR to false.
+!! VAR = False ! To set the logical VAR to false.
+!! \#define VAR 999 ! To set the real or integer VAR to 999.
+!! VAR = 999 ! To set the real or integer VAR to 999.
+!! \#override VAR = 888 ! To override a previously set value.
+!! VAR = 1.1, 2.2, 3.3 ! To set an array of real values.
+ ! Note that in the comments above, dOxygen translates \# to # .
+!!
+!! In addition, when set by the get_param interface, the values of
+!! parameters are automatically logged, along with defaults, units,
+!! and a description. It is an error for a variable to be overridden
+!! more than once, and MOM6 has a facility to check for unused lines
+!! to set variables, which may indicate miss-spelled or archaic
+!! parameters. Parameter names are case-specific, and lines may use
+!! a F90 or C++ style comment, starting with ! or //.
+
end module MOM_file_parser
diff --git a/src/framework/MOM_hor_index.F90 b/src/framework/MOM_hor_index.F90
index 5a626dd934..2fda7bd68d 100644
--- a/src/framework/MOM_hor_index.F90
+++ b/src/framework/MOM_hor_index.F90
@@ -48,6 +48,7 @@ module MOM_hor_index
logical :: symmetric !< True if symmetric memory is used.
end type hor_index_type
+!> Copy the contents of one horizontal index type into another
interface assignment(=); module procedure HIT_assign ; end interface
contains
diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90
index d4f8dbff57..afadf6bdfa 100644
--- a/src/framework/MOM_horizontal_regridding.F90
+++ b/src/framework/MOM_horizontal_regridding.F90
@@ -1,4 +1,6 @@
+!> Horizontal interpolation
module MOM_horizontal_regridding
+
! This file is part of MOM6. See LICENSE.md for the license.
use MOM_debugging, only : hchksum
@@ -17,7 +19,7 @@ module MOM_horizontal_regridding
use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE, MULTIPLE
use MOM_io, only : slasher, vardesc, write_field
use MOM_string_functions, only : uppercase
-use MOM_time_manager, only : time_type, set_time, get_external_field_size
+use MOM_time_manager, only : time_type, get_external_field_size
use MOM_time_manager, only : init_external_field, time_interp_external
use MOM_time_manager, only : get_external_field_axes, get_external_field_missing
use MOM_variables, only : thermo_var_ptrs
@@ -38,28 +40,32 @@ module MOM_horizontal_regridding
public :: horiz_interp_and_extrap_tracer, myStats
-character(len=40) :: mdl = "MOM_horizontal_regridding" ! This module's name.
+! character(len=40) :: mdl = "MOM_horizontal_regridding" ! This module's name.
+!> Fill grid edges
interface fill_boundaries
module procedure fill_boundaries_real
module procedure fill_boundaries_int
end interface
+!> Extrapolate and interpolate data
interface horiz_interp_and_extrap_tracer
module procedure horiz_interp_and_extrap_tracer_record
module procedure horiz_interp_and_extrap_tracer_fms_id
end interface
-real, parameter :: epsln=1.e-10
-
contains
-
+!> Write to the terminal some basic statistics about the k-th level of an array
subroutine myStats(array, missing, is, ie, js, je, k, mesg)
- real, dimension(:,:), intent(in) :: array
- real, intent(in) :: missing
- integer :: is,ie,js,je,k
- character(len=*) :: mesg
+ real, dimension(:,:), intent(in) :: array !< input array (ND)
+ real, intent(in) :: missing !< missing value (ND)
+ !!@{
+ !> Horizontal loop bounds to calculate statistics for
+ integer :: is,ie,js,je
+ !!@}
+ integer :: k !< Level to calculate statistics for
+ character(len=*) :: mesg !< Label to use in message
! Local variables
real :: minA, maxA
integer :: i,j
@@ -97,17 +103,6 @@ end subroutine myStats
!! Then use a previous guess (prev). Optionally (smooth)
!! blend the filled points to achieve a more desirable result.
subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug,debug)
- !
- !# Use ICE-9 algorithm to populate points (fill=1) with
- !# valid data (good=1). If no information is available,
- !# Then use a previous guess (prev). Optionally (smooth)
- !# blend the filled points to achieve a more desirable result.
- !
- ! (in) a : input 2-d array with missing values
- ! (in) good : valid data mask for incoming array (1==good data; 0==missing data)
- ! (in) fill : same shape array of points which need filling (1==please fill;0==leave it alone)
- ! (in) prev : first guess where isolated holes exist,
- !
use MOM_coms, only : sum_across_PEs
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
@@ -118,26 +113,23 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug
!! (1==good data; 0==missing data).
real, dimension(SZI_(G),SZJ_(G)), &
intent(in) :: fill !< Same shape array of points which need
- !! filling (1==please fill;0==leave
- !! it alone).
+ !! filling (1==fill;0==dont fill)
real, dimension(SZI_(G),SZJ_(G)), &
optional, intent(in) :: prev !< First guess where isolated holes exist.
logical, optional, intent(in) :: smooth !< If present and true, apply a number of
- !! Laplacian smoothing passes to the interpolated data
- integer, optional, intent(in) :: num_pass !< The maximum number of smoothing passes
- !! to apply.
- real, optional, intent(in) :: relc !< A nondimensional relaxation coefficient for
- !! the smoothing passes.
- real, optional, intent(in) :: crit !< A minimal value for changes in the array
- !! at which point the smoothing is stopped.
+ !! Laplacian iterations to the interpolated data
+ integer, optional, intent(in) :: num_pass !< The maximum number of iterations
+ real, optional, intent(in) :: relc !< A relaxation coefficient for Laplacian (ND)
+ real, optional, intent(in) :: crit !< A minimal value for deltas between iterations.
logical, optional, intent(in) :: keep_bug !< Use an algorithm with a bug that dates
- !! to the "sienna" code release.
+ !! to the "sienna" code release.
logical, optional, intent(in) :: debug !< If true, write verbose debugging messages.
real, dimension(SZI_(G),SZJ_(G)) :: b,r
real, dimension(SZI_(G),SZJ_(G)) :: fill_pts,good_,good_new
+ character(len=256) :: mesg ! The text of an error message
integer :: i,j,k
real :: east,west,north,south,sor
real :: ge,gw,gn,gs,ngood
@@ -226,11 +218,12 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug
enddo
enddo
elseif (nfill == nfill_prev) then
- print *,&
+ call MOM_error(WARNING, &
'Unable to fill missing points using either data at the same vertical level from a connected basin'//&
'or using a point from a previous vertical level. Make sure that the original data has some valid'//&
- 'data in all basins.'
- print *,'nfill=',nfill
+ 'data in all basins.', .true.)
+ write(mesg,*) 'nfill=',nfill
+ call MOM_error(WARNING, mesg, .true.)
endif
nfill = sum(fill_pts(is:ie,js:je))
@@ -265,7 +258,8 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug
do j=js,je
do i=is,ie
if (good_(i,j) == 0.0 .and. fill_pts(i,j) == 1.0) then
- print *,'in fill_miss, fill, good,i,j= ',fill_pts(i,j),good_(i,j),i,j
+ write(mesg,*) 'In fill_miss, fill, good,i,j= ',fill_pts(i,j),good_(i,j),i,j
+ call MOM_error(WARNING, mesg, .true.)
call MOM_error(FATAL,"MOM_initialize: "// &
"fill is true and good is false after fill_miss, how did this happen? ")
endif
@@ -276,6 +270,7 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug
end subroutine fill_miss_2d
+!> Extrapolate and interpolate from a file record
subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, recnum, G, tr_z, mask_z, z_in, &
z_edges_in, missing_value, reentrant_x, tripolar_n, homogenize )
@@ -297,10 +292,10 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion,
logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data
!! to produce perfectly "flat" initial conditions
- real, dimension(:,:), allocatable :: tr_in,tr_inp !< A 2-d array for holding input data on
- !! native horizontal grid and extended grid
- !! with poles.
- real, dimension(:,:), allocatable :: mask_in !< A 2-d mask for extended input grid.
+ real, dimension(:,:), allocatable :: tr_in,tr_inp ! A 2-d array for holding input data on
+ ! native horizontal grid and extended grid
+ ! with poles.
+ real, dimension(:,:), allocatable :: mask_in ! A 2-d mask for extended input grid.
real :: PI_180
integer :: rcode, ncid, varid, ndims, id, jd, kd, jdp
@@ -451,7 +446,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion,
allocate(mask_in(id,jdp)) ; mask_in(:,:)=0.0
allocate(last_row(id)) ; last_row(:)=0.0
- max_depth = maxval(G%bathyT)
+ max_depth = G%Zd_to_m*maxval(G%bathyT)
call mpp_max(max_depth)
if (z_edges_in(kd+1) Extrapolate and interpolate using a FMS time interpolation handle
subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, tr_z, mask_z, z_in, &
z_edges_in, missing_value, reentrant_x, tripolar_n, homogenize )
@@ -727,7 +724,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t
allocate(mask_in(id,jdp)) ; mask_in(:,:)=0.0
allocate(last_row(id)) ; last_row(:)=0.0
- max_depth = maxval(G%bathyT)
+ max_depth = G%Zd_to_m*maxval(G%bathyT)
call mpp_max(max_depth)
if (z_edges_in(kd+1) Create a 2d-mesh of grid coordinates from 1-d arrays.
+subroutine meshgrid(x,y,x_T,y_T)
+real, dimension(:), intent(in) :: x !< input 1-dimensional vector
+real, dimension(:), intent(in) :: y !< input 1-dimensional vector
+real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T !< output 2-dimensional array
+real, dimension(size(x,1),size(y,1)), intent(inout) :: y_T !< output 2-dimensional array
integer :: ni,nj,i,j
@@ -893,15 +893,17 @@ subroutine meshgrid(x,y,x_T,y_T)
return
end subroutine meshgrid
+
+
+!> Fill grid edges for integer data
function fill_boundaries_int(m,cyclic_x,tripolar_n) result(mp)
-!
-! fill grid edges
-!
-integer, dimension(:,:), intent(in) :: m
-logical, intent(in) :: cyclic_x, tripolar_n
+integer, dimension(:,:), intent(in) :: m !< input array (ND)
+logical, intent(in) :: cyclic_x !< True if domain is zonally re-entrant
+logical, intent(in) :: tripolar_n !< True if domain has an Arctic fold
+integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp
+
real, dimension(size(m,1),size(m,2)) :: m_real
real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real
-integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp
m_real = real(m)
@@ -913,11 +915,11 @@ function fill_boundaries_int(m,cyclic_x,tripolar_n) result(mp)
end function fill_boundaries_int
+!> Fill grid edges for real data
function fill_boundaries_real(m,cyclic_x,tripolar_n) result(mp)
-!< fill grid edges
-
-real, dimension(:,:), intent(in) :: m
-logical, intent(in) :: cyclic_x, tripolar_n
+real, dimension(:,:), intent(in) :: m !< input array (ND)
+logical, intent(in) :: cyclic_x !< True if domain is zonally re-entrant
+logical, intent(in) :: tripolar_n !< True if domain has an Arctic fold
real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp
integer :: ni,nj,i,j
@@ -947,20 +949,21 @@ function fill_boundaries_real(m,cyclic_x,tripolar_n) result(mp)
end function fill_boundaries_real
-subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n)
-!< Solve del2 (zi) = 0 using successive iterations
+!> Solve del2 (zi) = 0 using successive iterations
!! with a 5 point stencil. Only points fill==1 are
!! modified. Except where bad==1, information propagates
!! isotropically in index space. The resulting solution
!! in each region is an approximation to del2(zi)=0 subject to
!! boundary conditions along the valid points curve bounding this region.
+subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n)
-real, dimension(:,:), intent(inout) :: zi
-integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill
-integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad
-real, intent(in) :: sor
-integer, intent(in) :: niter
-logical, intent(in) :: cyclic_x, tripolar_n
+real, dimension(:,:), intent(inout) :: zi !< input and output array (ND)
+integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill !< same shape as zi, 1=fill
+integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad !< same shape as zi, 1=bad data
+real, intent(in) :: sor !< relaxation coefficient (ND)
+integer, intent(in) :: niter !< maximum number of iterations
+logical, intent(in) :: cyclic_x !< true if domain is zonally reentrant
+logical, intent(in) :: tripolar_n !< true if domain has an Arctic fold
integer :: i,j,k,n
integer :: ni,nj
diff --git a/src/framework/MOM_intrinsic_functions.F90 b/src/framework/MOM_intrinsic_functions.F90
index 664f87ad3f..fdda8849ae 100644
--- a/src/framework/MOM_intrinsic_functions.F90
+++ b/src/framework/MOM_intrinsic_functions.F90
@@ -1,14 +1,9 @@
+!> A module with intrinsic functions that are used by MOM but are not supported
+!! by some compilers.
module MOM_intrinsic_functions
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* This module holds intrinsic functions which are used by MOM but *
-!* are not supported by some compilers. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
implicit none ; private
public :: invcosh
diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90
index 178924d0d7..db0afa3d8a 100644
--- a/src/framework/MOM_io.F90
+++ b/src/framework/MOM_io.F90
@@ -6,6 +6,7 @@ module MOM_io
use MOM_error_handler, only : MOM_error, NOTE, FATAL, WARNING
use MOM_domains, only : MOM_domain_type, AGRID, BGRID_NE, CGRID_NE
+use MOM_domains, only : get_simple_array_i_ind, get_simple_array_j_ind
use MOM_file_parser, only : log_version, param_file_type
use MOM_grid, only : ocean_grid_type
use MOM_dyn_horgrid, only : dyn_horgrid_type
@@ -17,7 +18,7 @@ module MOM_io
use fms_io_mod, only : file_exist, field_size, read_data
use fms_io_mod, only : field_exists => field_exist, io_infra_end=>fms_io_exit
use fms_io_mod, only : get_filename_appendix => get_filename_appendix
-use mpp_domains_mod, only : domain1d, mpp_get_domain_components
+use mpp_domains_mod, only : domain1d, domain2d, mpp_get_domain_components
use mpp_domains_mod, only : CENTER, CORNER, NORTH_FACE=>NORTH, EAST_FACE=>EAST
use mpp_io_mod, only : open_file => mpp_open, close_file => mpp_close
use mpp_io_mod, only : mpp_write_meta, write_field => mpp_write, mpp_get_info
@@ -30,7 +31,7 @@ module MOM_io
use mpp_io_mod, only : MPP_APPEND, MPP_MULTI, MPP_OVERWR, MPP_NETCDF, MPP_RDONLY
use mpp_io_mod, only : get_file_info=>mpp_get_info, get_file_atts=>mpp_get_atts
use mpp_io_mod, only : get_file_fields=>mpp_get_fields, get_file_times=>mpp_get_times
-use mpp_io_mod, only : read_field=>mpp_read, io_infra_init=>mpp_io_init
+use mpp_io_mod, only : io_infra_init=>mpp_io_init
use netcdf
@@ -38,7 +39,7 @@ module MOM_io
public :: close_file, create_file, field_exists, field_size, fieldtype, get_filename_appendix
public :: file_exists, flush_file, get_file_info, get_file_atts, get_file_fields
-public :: get_file_times, open_file, read_axis_data, read_data, read_field
+public :: get_file_times, open_file, read_axis_data, read_data
public :: num_timelevels, MOM_read_data, MOM_read_vector, ensembler
public :: reopen_file, slasher, write_field, write_version_number, MOM_io_init
public :: open_namelist_file, check_nml_error, io_infra_init, io_infra_end
@@ -63,11 +64,13 @@ module MOM_io
!! convert from intensive to extensive
end type vardesc
+!> Indicate whether a file exists, perhaps with domain decomposition
interface file_exists
- module procedure file_exist
+ module procedure FMS_file_exists
module procedure MOM_file_exists
end interface
+!> Read a data field from a file
interface MOM_read_data
module procedure MOM_read_data_4d
module procedure MOM_read_data_3d
@@ -75,6 +78,7 @@ module MOM_io
module procedure MOM_read_data_1d
end interface
+!> Read a pair of data fields representing the two components of a vector from a file
interface MOM_read_vector
module procedure MOM_read_vector_3d
module procedure MOM_read_vector_2d
@@ -151,9 +155,7 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit
endif
one_file = .true.
- if (domain_set) then
- one_file = ((thread == SINGLE_FILE) .or. .not.Domain%use_io_layout)
- endif
+ if (domain_set) one_file = (thread == SINGLE_FILE)
if (one_file) then
call open_file(unit, filename, MPP_OVERWR, MPP_NETCDF, threading=thread)
@@ -395,9 +397,7 @@ subroutine reopen_file(unit, filename, vars, novars, fields, threading, timeunit
endif
one_file = .true.
- if (domain_set) then
- one_file = ((thread == SINGLE_FILE) .or. .not.Domain%use_io_layout)
- endif
+ if (domain_set) one_file = (thread == SINGLE_FILE)
if (one_file) then
call open_file(unit, filename, MPP_APPEND, MPP_NETCDF, threading=thread)
@@ -830,24 +830,43 @@ function MOM_file_exists(filename, MOM_Domain)
end function MOM_file_exists
+!> Returns true if the named file or its domain-decomposed variant exists.
+function FMS_file_exists(filename, domain, no_domain)
+ character(len=*), intent(in) :: filename !< The name of the file being inquired about
+ type(domain2d), optional, intent(in) :: domain !< The mpp domain2d that describes the decomposition
+ logical, optional, intent(in) :: no_domain !< This file does not use domain decomposition
+! This function uses the fms_io function file_exist to determine whether
+! a named file (or its decomposed variant) exists.
+
+ logical :: FMS_file_exists
+
+ FMS_file_exists = file_exist(filename, domain, no_domain)
+
+end function FMS_file_exists
!> This function uses the fms_io function read_data to read 1-D
!! data field named "fieldname" from file "filename".
-subroutine MOM_read_data_1d(filename, fieldname, data, timelevel)
+subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale)
character(len=*), intent(in) :: filename !< The name of the file to read
character(len=*), intent(in) :: fieldname !< The variable name of the data in the file
real, dimension(:), intent(inout) :: data !< The 1-dimensional array into which the data
integer, optional, intent(in) :: timelevel !< The time level in the file to read
+ real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied
+ !! by before they are returned.
call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.)
+ if (present(scale)) then ; if (scale /= 1.0) then
+ data(:) = scale*data(:)
+ endif ; endif
+
end subroutine MOM_read_data_1d
!> This function uses the fms_io function read_data to read a distributed
!! 2-D data field named "fieldname" from file "filename". Valid values for
!! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE.
subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, &
- timelevel, position)
+ timelevel, position, scale)
character(len=*), intent(in) :: filename !< The name of the file to read
character(len=*), intent(in) :: fieldname !< The variable name of the data in the file
real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data
@@ -855,17 +874,27 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, &
type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition
integer, optional, intent(in) :: timelevel !< The time level in the file to read
integer, optional, intent(in) :: position !< A flag indicating where this data is located
+ real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied
+ !! by before they are returned.
+
+ integer :: is, ie, js, je
call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, &
timelevel=timelevel, position=position)
+ if (present(scale)) then ; if (scale /= 1.0) then
+ call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie)
+ call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je)
+ data(is:ie,js:je) = scale*data(is:ie,js:je)
+ endif ; endif
+
end subroutine MOM_read_data_2d
!> This function uses the fms_io function read_data to read a distributed
!! 3-D data field named "fieldname" from file "filename". Valid values for
!! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE.
subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, &
- timelevel, position)
+ timelevel, position, scale)
character(len=*), intent(in) :: filename !< The name of the file to read
character(len=*), intent(in) :: fieldname !< The variable name of the data in the file
real, dimension(:,:,:), intent(inout) :: data !< The 3-dimensional array into which the data
@@ -873,17 +902,27 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, &
type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition
integer, optional, intent(in) :: timelevel !< The time level in the file to read
integer, optional, intent(in) :: position !< A flag indicating where this data is located
+ real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied
+ !! by before they are returned.
+
+ integer :: is, ie, js, je
call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, &
timelevel=timelevel, position=position)
+ if (present(scale)) then ; if (scale /= 1.0) then
+ call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie)
+ call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je)
+ data(is:ie,js:je,:) = scale*data(is:ie,js:je,:)
+ endif ; endif
+
end subroutine MOM_read_data_3d
!> This function uses the fms_io function read_data to read a distributed
!! 4-D data field named "fieldname" from file "filename". Valid values for
!! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE.
subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, &
- timelevel, position)
+ timelevel, position, scale)
character(len=*), intent(in) :: filename !< The name of the file to read
character(len=*), intent(in) :: fieldname !< The variable name of the data in the file
real, dimension(:,:,:,:), intent(inout) :: data !< The 4-dimensional array into which the data
@@ -891,10 +930,20 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, &
type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition
integer, optional, intent(in) :: timelevel !< The time level in the file to read
integer, optional, intent(in) :: position !< A flag indicating where this data is located
+ real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied
+ !! by before they are returned.
+
+ integer :: is, ie, js, je
call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, &
timelevel=timelevel, position=position)
+ if (present(scale)) then ; if (scale /= 1.0) then
+ call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie)
+ call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je)
+ data(is:ie,js:je,:,:) = scale*data(is:ie,js:je,:,:)
+ endif ; endif
+
end subroutine MOM_read_data_4d
@@ -902,7 +951,7 @@ end subroutine MOM_read_data_4d
!! 2-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for
!! "stagger" include CGRID_NE, BGRID_NE, and AGRID.
subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, &
- timelevel, stagger, scalar_pair)
+ timelevel, stagger, scalar_pair, scale)
character(len=*), intent(in) :: filename !< The name of the file to read
character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file
character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file
@@ -913,8 +962,10 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data
type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition
integer, optional, intent(in) :: timelevel !< The time level in the file to read
integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized
- logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized
-
+ logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized
+ real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied
+ !! by before they are returned.
+ integer :: is, ie, js, je
integer :: u_pos, v_pos
u_pos = EAST_FACE ; v_pos = NORTH_FACE
@@ -929,6 +980,15 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data
call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, &
timelevel=timelevel, position=v_pos)
+ if (present(scale)) then ; if (scale /= 1.0) then
+ call get_simple_array_i_ind(MOM_Domain, size(u_data,1), is, ie)
+ call get_simple_array_j_ind(MOM_Domain, size(u_data,2), js, je)
+ u_data(is:ie,js:je) = scale*u_data(is:ie,js:je)
+ call get_simple_array_i_ind(MOM_Domain, size(v_data,1), is, ie)
+ call get_simple_array_j_ind(MOM_Domain, size(v_data,2), js, je)
+ v_data(is:ie,js:je) = scale*v_data(is:ie,js:je)
+ endif ; endif
+
end subroutine MOM_read_vector_2d
@@ -936,7 +996,7 @@ end subroutine MOM_read_vector_2d
!! 3-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for
!! "stagger" include CGRID_NE, BGRID_NE, and AGRID.
subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, &
- timelevel, stagger, scalar_pair)
+ timelevel, stagger, scalar_pair, scale)
character(len=*), intent(in) :: filename !< The name of the file to read
character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file
character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file
@@ -947,8 +1007,11 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data
type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition
integer, optional, intent(in) :: timelevel !< The time level in the file to read
integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized
- logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized
+ logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized
+ real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied
+ !! by before they are returned.
+ integer :: is, ie, js, je
integer :: u_pos, v_pos
u_pos = EAST_FACE ; v_pos = NORTH_FACE
@@ -963,6 +1026,15 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data
call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, &
timelevel=timelevel, position=v_pos)
+ if (present(scale)) then ; if (scale /= 1.0) then
+ call get_simple_array_i_ind(MOM_Domain, size(u_data,1), is, ie)
+ call get_simple_array_j_ind(MOM_Domain, size(u_data,2), js, je)
+ u_data(is:ie,js:je,:) = scale*u_data(is:ie,js:je,:)
+ call get_simple_array_i_ind(MOM_Domain, size(v_data,1), is, ie)
+ call get_simple_array_j_ind(MOM_Domain, size(v_data,2), js, je)
+ v_data(is:ie,js:je,:) = scale*v_data(is:ie,js:je,:)
+ endif ; endif
+
end subroutine MOM_read_vector_3d
@@ -996,7 +1068,7 @@ end subroutine MOM_io_init
!!
!! * write_field: write a field to an open file.
!! * write_time: write a value of the time axis to an open file.
-!! * read_field: read a field from an open file.
+!! * read_data: read a variable from an open file.
!! * read_time: read a time from an open file.
!!
!! * name_output_file: provide a name for an output file based on a
diff --git a/src/framework/MOM_memory_macros.h b/src/framework/MOM_memory_macros.h
index 7de33e4949..0fc771f856 100644
--- a/src/framework/MOM_memory_macros.h
+++ b/src/framework/MOM_memory_macros.h
@@ -7,127 +7,185 @@
!//! \file MOM_memory_macros.h
#ifdef STATIC_MEMORY_
+!/* Static memory allocation section */
+
+!/// Deallocates array x when using dynamic memory mode. Does nothing in static memory mode.
# define DEALLOC_(x)
+!/// Allocates array x when using dynamic memory mode. Does nothing in static memory mode.
# define ALLOC_(x)
+!/// Attaches the ALLOCATABLE attribute to an array in dynamic memory mode. Does nothing in static memory mode.
# define ALLOCABLE_
+!/// Attaches the POINTER attribute to an array in dynamic memory mode. Does nothing in static memory mode.
# define PTR_
+!/// Nullify a pointer in dynamic memory mode. Does nothing in static memory mode.
# define TO_NULL_
-! NIMEM and NJMEM are the maximum number of grid points in the
-! x- and y-directions on each processsor.
+!/* These are the macros that should be used when setting up ALLOCABLE_ or PTR_ (heap) variables. */
+
+!/// Expands to : in dynamic memory mode, or is the i-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at h- or v- points.
# define NIMEM_ (((NIGLOBAL_-1)/NIPROC_)+1+2*NIHALO_)
+!/// Expands to : in dynamic memory mode, or is the j-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at h- or u- points.
# define NJMEM_ (((NJGLOBAL_-1)/NJPROC_)+1+2*NJHALO_)
-! These are the macros that should be used when setting up ALLOCABLE_ or
-! PTR_ (heap) variables.
# ifdef SYMMETRIC_MEMORY_
+!/// Expands to : or 0: in dynamic memory mode, or is the staggered i-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at q- or u- points.
# define NIMEMB_ 0:NIMEM_
+!/// Expands to : or 0: in dynamic memory mode, or is the staggered j-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at q- or v- points.
# define NJMEMB_ 0:NJMEM_
# else
+!/// Expands to : or 0: in dynamic memory mode, or is the staggered i-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at q- or u- points.
# define NIMEMB_ NIMEM_
+!/// Expands to : or 0: in dynamic memory mode, or is the staggered j-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at q- or v- points.
# define NJMEMB_ NJMEM_
# endif
+!/// Expands to : in dynamic memory mode, or to NIMEMB_ in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at h- or v- points.
# define NIMEMB_PTR_ NIMEMB_
+!/// Expands to : in dynamic memory mode, or to NJMEMB_ in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at h- or u- points.
# define NJMEMB_PTR_ NJMEMB_
+!/// Expands to 0: in dynamic memory mode, or is the staggered i-shape of a tile in static memory mode.
+!/// Use for always-symmetric heap (ALLOCABLE_ or PTR_) variables at q- or u- points.
# define NIMEMB_SYM_ 0:NIMEM_
+!/// Expands to 0: in dynamic memory mode, or is the staggered j-shape of a tile in static memory mode.
+!/// Use for always-symmetric heap (ALLOCABLE_ or PTR_) variables at q- or v- points.
# define NJMEMB_SYM_ 0:NJMEM_
+!/// Expands to : in dynamic memory mode or is to the number of layers in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) layer variables.
# define NKMEM_ NK_
+!/// Expands to 0: in dynamic memory mode or to 0:NK_ in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) interface variables.
# define NKMEM0_ 0:NK_
+!/// Expands to : in dynamic memory mode or to NK_+1 in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) interface variables.
# define NK_INTERFACE_ NK_+1
+!/// Expands to : or 1. UNKNOWN PURPOSE!
# define C1_ 1
+!/// Expands to : or 2. UNKNOWN PURPOSE!
# define C2_ 2
+!/// Expands to : or 3. UNKNOWN PURPOSE!
# define C3_ 3
-! These are the macros that should be used for subroutine arguments
-! or for automatically allocated (stack) variables.
+
+!/* These are the macros that should be used for subroutine arguments or for automatically allocated (stack) variables. */
+
+!/// The i-shape of a dummy argument staggered at h- or v-points.
# define SZI_(G) NIMEM_
+!/// The j-shape of a dummy argument staggered at h- or u-points.
# define SZJ_(G) NJMEM_
+!/// The k-shape of a layer dummy argument.
# define SZK_(G) NK_
+!/// The k-shape of an interface dummy argument.
# define SZK0_(G) 0:NK_
+!/// The i-shape of a dummy argument staggered at q- or u-points.
# define SZIB_(G) NIMEMB_
+!/// The j-shape of a dummy argument staggered at q- or v-points.
# define SZJB_(G) NJMEMB_
+!/// The i-shape of a symmetric dummy argument staggered at q- or u-points.
# define SZIBS_(G) 0:NIMEM_
+!/// The j-shape of a symmetric dummy argument staggered at q- or v-points.
# define SZJBS_(G) 0:NJMEM_
#else
!/* Dynamic memory allocation section */
-!/*! Deallocates array x when using dynamic memory mode. Does nothing in static memory mode.*/
+!/// Deallocates array x when using dynamic memory mode. Does nothing in static memory mode.
# define DEALLOC_(x) deallocate(x)
-!/*! Allocates array x when using dynamic memory mode. Does nothing in static memory mode.*/
+!/// Allocates array x when using dynamic memory mode. Does nothing in static memory mode.
# define ALLOC_(x) allocate(x)
-!/*! Attaches the ALLOCATABLE attribute to an array in dynamic memory mode. Does nothing in static memory mode.*/
+!/// Attaches the ALLOCATABLE attribute to an array in dynamic memory mode. Does nothing in static memory mode.
# define ALLOCABLE_ ,allocatable
-!/*! Attaches the POINTER attribute to an array in dynamic memory mode. Does nothing in static memory mode.*/
+!/// Attaches the POINTER attribute to an array in dynamic memory mode. Does nothing in static memory mode.
# define PTR_ ,pointer
-!/*! Nullify a pointer in dynamic memory mode. Does nothing in static memory mode.*/
+!/// Nullify a pointer in dynamic memory mode. Does nothing in static memory mode.
# define TO_NULL_ =>NULL()
!/* These are the macros that should be used when setting up ALLOCABLE_ or PTR_ (heap) variables. */
-!/*! Expands to : in dynamic memory mode, or is the i-shape of a tile in static memory mode. Use for heap (ALLOCABLE_ or PTR_) variables at h- or v- points. */
+!/// Expands to : in dynamic memory mode, or is the i-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at h- or v- points.
# define NIMEM_ :
-!/*! Expands to : in dynamic memory mode, or is the j-shape of a tile in static memory mode. Use for heap (ALLOCABLE_ or PTR_) variables at h- or u- points. */
+!/// Expands to : in dynamic memory mode, or is the j-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at h- or u- points.
# define NJMEM_ :
-!/*! Expands to : in dynamic memory mode, or to NIMEMB_ in static memory mode. Use for heap (ALLOCABLE_ or PTR_) variables at h- or v- points. */
+!/// Expands to : in dynamic memory mode, or to NIMEMB_ in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at h- or v- points.
# define NIMEMB_PTR_ :
-!/*! Expands to : in dynamic memory mode, or to NJMEMB_ in static memory mode. Use for heap (ALLOCABLE_ or PTR_) variables at h- or u- points. */
+!/// Expands to : in dynamic memory mode, or to NJMEMB_ in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at h- or u- points.
# define NJMEMB_PTR_ :
# ifdef SYMMETRIC_MEMORY_
-!/*! Expands to : or 0: in dynamic memory mode, or is the staggered i-shape of a tile in static memory mode. Use for heap (ALLOCABLE_ or PTR_) variables at q- or u- points. */
+!/// Expands to : or 0: in dynamic memory mode, or is the staggered i-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at q- or u- points.
# define NIMEMB_ 0:
-!/*! Expands to : or 0: in dynamic memory mode, or is the staggered j-shape of a tile in static memory mode. Use for heap (ALLOCABLE_ or PTR_) variables at q- or v- points. */
+!/// Expands to : or 0: in dynamic memory mode, or is the staggered j-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at q- or v- points.
# define NJMEMB_ 0:
# else
+!/// Expands to : or 0: in dynamic memory mode, or is the staggered i-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at q- or u- points.
# define NIMEMB_ :
+!/// Expands to : or 0: in dynamic memory mode, or is the staggered j-shape of a tile in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) variables at q- or v- points.
# define NJMEMB_ :
# endif
-!/*! Expands to 0: in dynamic memory mode, or is the staggered i-shape of a tile in static memory mode. Use for always-symmetric heap (ALLOCABLE_ or PTR_) variables at q- or u- points. */
+!/// Expands to 0: in dynamic memory mode, or is the staggered i-shape of a tile in static memory mode.
+!/// Use for always-symmetric heap (ALLOCABLE_ or PTR_) variables at q- or u- points.
# define NIMEMB_SYM_ 0:
-!/*! Expands to 0: in dynamic memory mode, or is the staggered j-shape of a tile in static memory mode. Use for always-symmetric heap (ALLOCABLE_ or PTR_) variables at q- or v- points. */
+!/// Expands to 0: in dynamic memory mode, or is the staggered j-shape of a tile in static memory mode.
+!/// Use for always-symmetric heap (ALLOCABLE_ or PTR_) variables at q- or v- points.
# define NJMEMB_SYM_ 0:
-!/*! Expands to : in dynamic memory mode or is to the number of layers in static memory mode. Use for heap (ALLOCABLE_ or PTR_) layer variables. */
+!/// Expands to : in dynamic memory mode or is to the number of layers in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) layer variables.
# define NKMEM_ :
-!/*! Expands to 0: in dynamic memory mode or to 0:NK_ in static memory mode. Use for heap (ALLOCABLE_ or PTR_) interface variables. */
+!/// Expands to 0: in dynamic memory mode or to 0:NK_ in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) interface variables.
# define NKMEM0_ 0:
-!/*! Expands to : in dynamic memory mode or to NK_+1 in static memory mode. Use for heap (ALLOCABLE_ or PTR_) interface variables. */
+!/// Expands to : in dynamic memory mode or to NK_+1 in static memory mode.
+!/// Use for heap (ALLOCABLE_ or PTR_) interface variables.
# define NK_INTERFACE_ :
-!/*! Expands to : or 1. UNKNOWN PURPOSE! */
+!/// Expands to : or 1. UNKNOWN PURPOSE!
# define C1_ :
-!/*! Expands to : or 2. UNKNOWN PURPOSE! */
+!/// Expands to : or 2. UNKNOWN PURPOSE!
# define C2_ :
-!/*! Expands to : or 3. UNKNOWN PURPOSE! */
+!/// Expands to : or 3. UNKNOWN PURPOSE!
# define C3_ :
-!/*! \todo Explain or remove C1_, C2_ and C3_ */
+!/// \todo Explain or remove C1_, C2_ and C3_
!/* These are the macros that should be used for subroutine arguments or for automatically allocated (stack) variables. */
-!/*! The i-shape of a dummy argument staggered at h- or v-points. */
+!/// The i-shape of a dummy argument staggered at h- or v-points.
# define SZI_(G) G%isd:G%ied
-!/*! The j-shape of a dummy argument staggered at h- or u-points. */
+!/// The j-shape of a dummy argument staggered at h- or u-points.
# define SZJ_(G) G%jsd:G%jed
-!/*! The k-shape of a layer dummy argument. */
+!/// The k-shape of a layer dummy argument.
# define SZK_(G) G%ke
-!/*! The k-shape of an interface dummy argument. */
+!/// The k-shape of an interface dummy argument.
# define SZK0_(G) 0:G%ke
-!/*! The i-shape of a dummy argument staggered at q- or u-points. */
+!/// The i-shape of a dummy argument staggered at q- or u-points.
# define SZIB_(G) G%IsdB:G%IedB
-!/*! The j-shape of a dummy argument staggered at q- or v-points. */
+!/// The j-shape of a dummy argument staggered at q- or v-points.
# define SZJB_(G) G%JsdB:G%JedB
-!/*! The i-shape of a symmetric dummy argument staggered at q- or u-points. */
+!/// The i-shape of a symmetric dummy argument staggered at q- or u-points.
# define SZIBS_(G) G%isd-1:G%ied
-!/*! The j-shape of a symmetric dummy argument staggered at q- or v-points. */
+!/// The j-shape of a symmetric dummy argument staggered at q- or v-points.
# define SZJBS_(G) G%jsd-1:G%jed
#endif
!/* These dynamic size macros always give the same results (for now). */
-!/*! The i-shape of a dynamic dummy argument staggered at h- or v-points. */
+!/// The i-shape of a dynamic dummy argument staggered at h- or v-points.
#define SZDI_(G) G%isd:G%ied
-!/*! The i-shape of a dynamic dummy argument staggered at q- or u-points. */
+!/// The i-shape of a dynamic dummy argument staggered at q- or u-points.
#define SZDIB_(G) G%IsdB:G%IedB
-!/*! The j-shape of a dynamic dummy argument staggered at h- or u-points. */
+!/// The j-shape of a dynamic dummy argument staggered at h- or u-points.
#define SZDJ_(G) G%jsd:G%jed
-!/*! The j-shape of a dynamic dummy argument staggered at q- or v-points. */
+!/// The j-shape of a dynamic dummy argument staggered at q- or v-points.
#define SZDJB_(G) G%JsdB:G%JedB
diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90
index 4e8234f697..4d89dccc7b 100644
--- a/src/framework/MOM_restart.F90
+++ b/src/framework/MOM_restart.F90
@@ -1,63 +1,23 @@
+!> The MOM6 facility for reading and writing restart files, and querying what has been read.
module MOM_restart
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, April 1994 - June 2002 *
-!* *
-!* This file contains four subroutines associated with saving *
-!* restart files or restoring the model state from files. *
-!* *
-!* register_restart_field is used to specify the fields that will *
-!* be written to restart files. *
-!* *
-!* Save_restart saves a restart file from which a simulation can *
-!* be restarted with results that are identical to those which would *
-!* have been attained if there had been no interruption. If this *
-!* file would be larger than 2 Gbytes, it is broken up into a number *
-!* of smaller files. *
-!* *
-!* The subroutine restore_state initializes the fields for the *
-!* simulations from a number of restart files or other NetCDF files. *
-!* Each restart field is initialized from the first file in the *
-!* list in which it is found. The files are separated by spaces, *
-!* and all must be in the specified directory. If 'r' is included *
-!* in the list, it is expanded to include all of the restart files *
-!* that are found in the directory. *
-!* *
-!* query_initialized returns true if a field (or the entire restart *
-!* file) has been initialized from a restart file and false otherwise.*
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q, CoriolisBu *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, bathyT, tr *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 *
-!* i i+1 *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_domains, only : pe_here, num_PEs
use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, is_root_pe
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_string_functions, only : lowercase
use MOM_grid, only : ocean_grid_type
use MOM_io, only : create_file, fieldtype, file_exists, open_file, close_file
-use MOM_io, only : read_field, write_field, MOM_read_data, read_data, get_filename_appendix
+use MOM_io, only : write_field, MOM_read_data, read_data, get_filename_appendix
use MOM_io, only : get_file_info, get_file_atts, get_file_fields, get_file_times
use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc
use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE
use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE
-use MOM_time_manager, only : time_type, get_time, get_date, set_date, set_time
-use MOM_time_manager, only : days_in_month
+use MOM_time_manager, only : time_type, time_type_to_real, real_to_time
+use MOM_time_manager, only : days_in_month, get_date, set_date
use MOM_verticalGrid, only : verticalGrid_type
-use mpp_mod, only: mpp_chksum
+use mpp_mod, only: mpp_chksum,mpp_pe
use mpp_io_mod, only: mpp_attribute_exist, mpp_get_atts
implicit none ; private
@@ -66,66 +26,73 @@ module MOM_restart
public save_restart, query_initialized, restart_init_end, vardesc
public restart_files_exist, determine_is_new_run, is_new_run
+!> A type for making arrays of pointers to 4-d arrays
type p4d
- real, dimension(:,:,:,:), pointer :: p => NULL()
+ real, dimension(:,:,:,:), pointer :: p => NULL() !< A pointer to a 4d array
end type p4d
+!> A type for making arrays of pointers to 3-d arrays
type p3d
- real, dimension(:,:,:), pointer :: p => NULL()
+ real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3d array
end type p3d
+!> A type for making arrays of pointers to 2-d arrays
type p2d
- real, dimension(:,:), pointer :: p => NULL()
+ real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2d array
end type p2d
+!> A type for making arrays of pointers to 1-d arrays
type p1d
- real, dimension(:), pointer :: p => NULL()
+ real, dimension(:), pointer :: p => NULL() !< A pointer to a 1d array
end type p1d
+!> A type for making arrays of pointers to scalars
type p0d
- real, pointer :: p => NULL()
+ real, pointer :: p => NULL() !< A pointer to a scalar
end type p0d
+!> A structure with information about a single restart field
type field_restart
- type(vardesc) :: vars ! Descriptions of the fields that
- ! are to be read from or written
- ! to the restart file.
- logical :: mand_var ! If .true. the run will abort if this
- ! field is not successfully read
- ! from the restart file.
- logical :: initialized ! .true. if this field has been read
- ! from the restart file.
- character(len=32) :: var_name ! A name by which a variable may be queried.
+ type(vardesc) :: vars !< Description of a field that is to be read from or written
+ !! to the restart file.
+ logical :: mand_var !< If .true. the run will abort if this field is not successfully
+ !! read from the restart file.
+ logical :: initialized !< .true. if this field has been read from the restart file.
+ character(len=32) :: var_name !< A name by which a variable may be queried.
end type field_restart
+!> A restart registry and the control structure for restarts
type, public :: MOM_restart_CS ; private
- logical :: restart ! restart is set to .true. if the run has been started
- ! from a full restart file. Otherwise some fields must
- ! be initialized approximately.
- integer :: novars = 0 ! The number of restart fields that have been registered.
- logical :: parallel_restartfiles ! If true, each PE writes its own restart file,
- ! otherwise they are combined internally.
- logical :: large_file_support ! If true, NetCDF 3.6 or later is being used
- ! and large-file-support is enabled.
- logical :: new_run ! If true, the input filenames and restart file
- ! existence will result in a new run that is not
- ! initializedfrom restart files.
- logical :: new_run_set = .false. ! If true, new_run has been determined for this restart_CS.
- logical :: checksum_required ! If true, require the restart checksums to match and error out otherwise.
- ! Users may want to avoid this comparison if for example the restarts are
- ! made from a run with a different mask_table than the current run,
- ! in which case the checksums will not match and cause crash.
- character(len=240) :: restartfile ! The name or name root for MOM restart files.
-
+ logical :: restart !< restart is set to .true. if the run has been started from a full restart
+ !! file. Otherwise some fields must be initialized approximately.
+ integer :: novars = 0 !< The number of restart fields that have been registered.
+ logical :: parallel_restartfiles !< If true, each PE writes its own restart file,
+ !! otherwise they are combined internally.
+ logical :: large_file_support !< If true, NetCDF 3.6 or later is being used
+ !! and large-file-support is enabled.
+ logical :: new_run !< If true, the input filenames and restart file existence will
+ !! result in a new run that is not initialized from restart files.
+ logical :: new_run_set = .false. !< If true, new_run has been determined for this restart_CS.
+ logical :: checksum_required !< If true, require the restart checksums to match and error out otherwise.
+ !! Users may want to avoid this comparison if for example the restarts are
+ !! made from a run with a different mask_table than the current run,
+ !! in which case the checksums will not match and cause crash.
+ character(len=240) :: restartfile !< The name or name root for MOM restart files.
+
+ !> An array of descriptions of the registered fields
type(field_restart), pointer :: restart_field(:) => NULL()
+
+ !>@{ Pointers to the fields that have been registered for restarts
type(p0d), pointer :: var_ptr0d(:) => NULL()
type(p1d), pointer :: var_ptr1d(:) => NULL()
type(p2d), pointer :: var_ptr2d(:) => NULL()
type(p3d), pointer :: var_ptr3d(:) => NULL()
type(p4d), pointer :: var_ptr4d(:) => NULL()
- integer :: max_fields
+ !!@}
+ integer :: max_fields !< The maximum number of restart fields
end type MOM_restart_CS
+!> Register fields for restarts
interface register_restart_field
module procedure register_restart_field_ptr4d, register_restart_field_4d
module procedure register_restart_field_ptr3d, register_restart_field_3d
@@ -134,6 +101,7 @@ module MOM_restart
module procedure register_restart_field_ptr0d, register_restart_field_0d
end interface
+!> Indicate whether a field has been read from a restart file
interface query_initialized
module procedure query_initialized_name
module procedure query_initialized_0d, query_initialized_0d_name
@@ -443,10 +411,7 @@ function query_initialized_name(name, CS) result(query_initialized)
logical :: query_initialized
! This subroutine returns .true. if the field referred to by name has
! initialized from a restart file, and .false. otherwise.
-!
-! Arguments: name - A pointer to the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m,n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -480,10 +445,7 @@ function query_initialized_0d(f_ptr, CS) result(query_initialized)
logical :: query_initialized
! This subroutine tests whether the field pointed to by f_ptr has
! been initialized from a restart file.
-!
-! Arguments: f_ptr - A pointer to the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m,n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -510,10 +472,7 @@ function query_initialized_1d(f_ptr, CS) result(query_initialized)
logical :: query_initialized
! This subroutine tests whether the field pointed to by f_ptr has
! been initialized from a restart file.
-!
-! Arguments: f_ptr - A pointer to the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m,n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -541,10 +500,7 @@ function query_initialized_2d(f_ptr, CS) result(query_initialized)
logical :: query_initialized
! This subroutine tests whether the field pointed to by f_ptr has
! been initialized from a restart file.
-!
-! Arguments: f_ptr - A pointer to the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m,n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -572,10 +528,7 @@ function query_initialized_3d(f_ptr, CS) result(query_initialized)
logical :: query_initialized
! This subroutine tests whether the field pointed to by f_ptr has
! been initialized from a restart file.
-!
-! Arguments: f_ptr - A pointer to the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m,n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -603,10 +556,7 @@ function query_initialized_4d(f_ptr, CS) result(query_initialized)
logical :: query_initialized
! This subroutine tests whether the field pointed to by f_ptr has
! been initialized from a restart file.
-!
-! Arguments: f_ptr - A pointer to the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m,n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -635,11 +585,7 @@ function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized)
logical :: query_initialized
! This subroutine tests whether the field pointed to by f_ptr or with the
! specified variable name has been initialized from a restart file.
-!
-! Arguments: f_ptr - A pointer to the field that is being queried.
-! (in) name - The name of the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m,n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -675,11 +621,7 @@ function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized)
logical :: query_initialized
! This subroutine tests whether the field pointed to by f_ptr or with the
! specified variable name has been initialized from a restart file.
-!
-! Arguments: f_ptr - A pointer to the field that is being queried.
-! (in) name - The name of the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m,n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -715,11 +657,7 @@ function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized)
logical :: query_initialized
! This subroutine tests whether the field pointed to by f_ptr or with the
! specified variable name has been initialized from a restart file.
-!
-! Arguments: f_ptr - A pointer to the field that is being queried.
-! (in) name - The name of the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m,n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -755,11 +693,7 @@ function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized)
logical :: query_initialized
! This subroutine tests whether the field pointed to by f_ptr or with the
! specified variable name has been initialized from a restart file.
-!
-! Arguments: f_ptr - A pointer to the field that is being queried.
-! (in) name - The name of the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m, n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -795,11 +729,7 @@ function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized)
logical :: query_initialized
! This subroutine tests whether the field pointed to by f_ptr or with the
! specified variable name has been initialized from a restart file.
-!
-! Arguments: f_ptr - A pointer to the field that is being queried.
-! (in) name - The name of the field that is being queried.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
+
integer :: m, n
if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // &
"query_initialized: Module must be initialized before it is used.")
@@ -837,16 +767,8 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV)
!! to the restart file names.
character(len=*), optional, intent(in) :: filename !< A filename that overrides the name in CS%restartfile.
type(verticalGrid_type), optional, intent(in) :: GV !< The ocean's vertical grid structure
-! Arguments: directory - The directory where the restart file goes.
-! (in) time - The time of this restart file.
-! (in) G - The ocean's grid structure.
-! (in) CS - The control structure returned by a previous call to
-! restart_init.
-! (in, opt) time_stamped - If true, the restart file names include
-! a unique time stamp. The default is false.
-! (in, opt) filename - A filename that overrides the name in CS%restartfile.
-!
-! (in, opt) GV - The ocean's vertical grid structure.
+
+ ! Local variables
type(vardesc) :: vars(CS%max_fields) ! Descriptions of the fields that
! are to be read from the restart file.
type(fieldtype) :: fields(CS%max_fields) !
@@ -879,15 +801,14 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV)
! With parallel read & write, it is possible to disable the following...
-! jgj: this was set to 4294967292, changed to 4294967295 (see mpp_parameter.F90)
- if (CS%large_file_support) max_file_size = 4294967295_8
+ ! The maximum file size is 4294967292, according to the NetCDF documentation.
+ if (CS%large_file_support) max_file_size = 4294967292_8
num_files = 0
next_var = 0
nz = 1 ; if (present(GV)) nz = GV%ke
- call get_time(time,seconds,days)
- restart_time = real(days) + real(seconds)/86400.0
+ restart_time = time_type_to_real(time) / 86400.0
restartname = trim(CS%restartfile)
if (present(filename)) restartname = trim(filename)
@@ -996,7 +917,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV)
elseif (associated(CS%var_ptr1d(m)%p)) then
check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr1d(m)%p)
elseif (associated(CS%var_ptr0d(m)%p)) then
- check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr0d(m)%p)
+ check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr0d(m)%p,pelist=(/mpp_pe()/))
endif
enddo
@@ -1051,16 +972,7 @@ subroutine restore_state(filename, directory, day, G, CS)
! generated files. All restart variables are read from the first
! file in the input filename list in which they are found.
-! Arguments: filename - A series of space delimited strings, each of
-! which is either "r" or the name of a file
-! from which the run is to be restarted.
-! (in) directory - The directory where the restart or save
-! files should be found.
-! (out) day - The time of the restarted run.
-! (in) G - The ocean's grid structure.
-! (in/out) CS - The control structure returned by a previous call to
-! restart_init.
-
+ ! Local variables
character(len=200) :: filepath ! The path (dir/file) to the file being opened.
character(len=80) :: fname ! The name of the current file.
character(len=8) :: suffix ! A suffix (like "_2") that is added to any
@@ -1069,7 +981,7 @@ subroutine restore_state(filename, directory, day, G, CS)
character(len=80) :: varname ! A variable's name.
integer :: num_file ! The number of files (restart files and others
! explicitly in filename) that are open.
- integer :: i, n, m, start_of_day, num_days, missing_fields
+ integer :: i, n, m, missing_fields
integer :: isL, ieL, jsL, jeL, is0, js0
integer :: sizes(7)
integer :: ndim, nvar, natt, ntime, pos
@@ -1115,9 +1027,7 @@ subroutine restore_state(filename, directory, day, G, CS)
t1 = time_vals(1)
deallocate(time_vals)
- start_of_day = INT((t1 - INT(t1)) *86400) ! Number of seconds.
- num_days = INT(t1)
- day = set_time(start_of_day, num_days)
+ day = real_to_time(t1*86400.0)
exit
enddo
@@ -1183,117 +1093,46 @@ subroutine restore_state(filename, directory, day, G, CS)
call mpp_get_atts(fields(i),checksum=checksum_file)
is_there_a_checksum = .true.
endif
- if (.NOT. CS%checksum_required ) is_there_a_checksum = .false. ! Do not need to do data checksumming.
+ if (.NOT. CS%checksum_required) is_there_a_checksum = .false. ! Do not need to do data checksumming.
if (associated(CS%var_ptr1d(m)%p)) then
! Read a 1d array, which should be invariant to domain decomposition.
call read_data(unit_path(n), varname, CS%var_ptr1d(m)%p, &
- no_domain=.true., timelevel=1)
- if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p)
+ G%Domain%mpp_domain, timelevel=1)
+ if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p)
elseif (associated(CS%var_ptr0d(m)%p)) then ! Read a scalar...
call read_data(unit_path(n), varname, CS%var_ptr0d(m)%p, &
- no_domain=.true., timelevel=1)
- if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p)
- elseif ((pos == 0) .and. associated(CS%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array.
- ! Probably should query the field type to make sure that the sizes are right.
- call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, &
- no_domain=.true., timelevel=1)
- if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL))
- elseif ((pos == 0) .and. associated(CS%var_ptr3d(m)%p)) then ! Read a non-decomposed 3d array.
- ! Probably should query the field type to make sure that the sizes are right.
- call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, &
- no_domain=.true., timelevel=1)
- if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:))
- elseif ((pos == 0) .and. associated(CS%var_ptr4d(m)%p)) then ! Read a non-decomposed 4d array.
- ! Probably should query the field type to make sure that the sizes are right.
- call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, &
- no_domain=.true., timelevel=1)
- if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:))
- elseif (unit_is_global(n) .or. G%Domain%use_io_layout) then
- if (associated(CS%var_ptr3d(m)%p)) then
- ! Read 3d array... Time level 1 is always used.
- call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, &
- G%Domain, 1, position=pos)
- if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:))
- elseif (associated(CS%var_ptr2d(m)%p)) then ! Read 2d array...
+ G%Domain%mpp_domain, timelevel=1)
+ if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p,pelist=(/mpp_pe()/))
+ elseif (associated(CS%var_ptr2d(m)%p)) then ! Read a 2d array.
+ if (pos /= 0) then
call MOM_read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, &
- G%Domain, 1, position=pos)
- if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL))
- elseif (associated(CS%var_ptr4d(m)%p)) then ! Read 4d array...
- call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, &
- G%Domain, 1, position=pos)
- if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:))
- else
- call MOM_error(FATAL, "MOM_restart restore_state: "//&
- "No pointers set for "//trim(varname))
- endif
- else ! Do not use an io_layout. !### GET RID OF THIS BRANCH ONCE read_data_4d_new IS AVAILABLE.
- ! This file is decomposed onto the current processors. We need
- ! to check whether the sizes look right, and abort if not.
- call get_file_atts(fields(i),ndim=ndim,siz=sizes)
-
- ! NOTE: The index ranges f var_ptrs always start with 1, so with
- ! symmetric memory the staggering is swapped from NE to SW!
- is0 = 1-G%isd
- if ((pos == EAST_FACE) .or. (pos == CORNER)) is0 = 1-G%IsdB
- if (sizes(1) == G%iec-G%isc+1) then
- isL = G%isc+is0 ; ieL = G%iec+is0
- elseif (sizes(1) == G%IecB-G%IscB+1) then
- isL = G%IscB+is0 ; ieL = G%IecB+is0
- elseif (((pos == EAST_FACE) .or. (pos == CORNER)) .and. &
- (G%IscB == G%isc) .and. (sizes(1) == G%iec-G%isc+2)) then
- ! This is reading a symmetric file in a non-symmetric model.
- isL = G%isc-1+is0 ; ieL = G%iec+is0
- else
- call MOM_error(WARNING, "MOM_restart restore_state, "//trim(varname)//&
- " has the wrong i-size in "//trim(unit_path(n)))
- exit
+ G%Domain, timelevel=1, position=pos)
+ else ! This array is not domain-decomposed. This variant may be under-tested.
+ call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, &
+ no_domain=.true., timelevel=1)
endif
-
- js0 = 1-G%jsd
- if ((pos == NORTH_FACE) .or. (pos == CORNER)) js0 = 1-G%JsdB
- if (sizes(2) == G%jec-G%jsc+1) then
- jsL = G%jsc+js0 ; jeL = G%jec+js0
- elseif (sizes(2) == G%jecB-G%jscB+1) then
- jsL = G%jscB+js0 ; jeL = G%jecB+js0
- elseif (((pos == NORTH_FACE) .or. (pos == CORNER)) .and. &
- (G%JscB == G%jsc) .and. (sizes(2) == G%jec-G%jsc+2)) then
- ! This is reading a symmetric file in a non-symmetric model.
- jsL = G%jsc-1+js0 ; jeL = G%jec+js0
- else
- call MOM_error(WARNING, "MOM_restart restore_state, "//trim(varname)//&
- " has the wrong j-size in "//trim(unit_path(n)))
- exit
+ if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL))
+ elseif (associated(CS%var_ptr3d(m)%p)) then ! Read a 3d array.
+ if (pos /= 0) then
+ call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, &
+ G%Domain, timelevel=1, position=pos)
+ else ! This array is not domain-decomposed. This variant may be under-tested.
+ call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, &
+ no_domain=.true., timelevel=1)
endif
-
- if (associated(CS%var_ptr3d(m)%p)) then
- if (ntime == 0) then
- call read_field(unit(n), fields(i), &
- CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:))
- else
- call read_field(unit(n), fields(i), &
- CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:), 1)
- endif
- elseif (associated(CS%var_ptr2d(m)%p)) then
- if (ntime == 0) then
- call read_field(unit(n), fields(i), &
- CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL))
- else
- call read_field(unit(n), fields(i), &
- CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL), 1)
- endif
- elseif (associated(CS%var_ptr4d(m)%p)) then
- if (ntime == 0) then
- call read_field(unit(n), fields(i), &
- CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:))
- else
- call read_field(unit(n), fields(i), &
- CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:), 1)
- endif
- else
- call MOM_error(FATAL, "MOM_restart restore_state: "//&
- "No pointers set for "//trim(varname))
+ if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:))
+ elseif (associated(CS%var_ptr4d(m)%p)) then ! Read a 4d array.
+ if (pos /= 0) then
+ call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, &
+ G%Domain, timelevel=1, position=pos)
+ else ! This array is not domain-decomposed. This variant may be under-tested.
+ call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, &
+ no_domain=.true., timelevel=1)
endif
+ if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:))
+ else
+ call MOM_error(FATAL, "MOM_restart restore_state: No pointers set for "//trim(varname))
endif
if (is_root_pe() .and. is_there_a_checksum .and. (checksum_file(1) /= checksum_data)) then
@@ -1430,15 +1269,7 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, &
! generated files. All restart variables are read from the first
! file in the input filename list in which they are found.
-! Arguments: filename - A series of space delimited strings, each of
-! which is either "r" or the name of a file
-! from which the run is to be restarted.
-! (in) directory - The directory where the restart or save
-! files should be found.
-! (in) G - The ocean's grid structure.
-! (in/out) CS - The control structure returned by a previous call to
-! restart_init.
-
+ ! Local variables
character(len=256) :: filepath ! The path (dir/file) to the file being opened.
character(len=256) :: fname ! The name of the current file.
character(len=8) :: suffix ! A suffix (like "_2") that is added to any
@@ -1466,8 +1297,12 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, &
enddo
fname = filename(start_char:m-1)
start_char = m
- do while ((start_char <= len_trim(filename)) .and. (filename(start_char:start_char) == ' '))
- start_char = start_char + 1
+ do while (start_char <= len_trim(filename))
+ if (filename(start_char:start_char) == ' ') then
+ start_char = start_char + 1
+ else
+ exit
+ endif
enddo
if ((fname(1:1)=='r') .and. ( len_trim(fname) == 1)) then
@@ -1506,24 +1341,11 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, &
threading = MULTIPLE, fileset = SINGLE_FILE)
if (present(global_files)) global_files(n) = .true.
elseif (CS%parallel_restartfiles) then
- if (G%Domain%use_io_layout) then
- ! Look for decomposed files using the I/O Layout.
- fexists = file_exists(filepath, G%Domain)
- if (fexists .and. (present(units))) &
- call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, &
- domain=G%Domain%mpp_domain)
- else
- ! Look for any PE-specific files of the form NAME.nc.####.
- if (num_PEs()>10000) then
- write(filepath, '(a,i6.6)' ) trim(filepath)//'.', pe_here()
- else
- write(filepath, '(a,i4.4)' ) trim(filepath)//'.', pe_here()
- endif
- inquire(file=filepath, exist=fexists)
- if (fexists .and. (present(units))) &
- call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, &
- threading = MULTIPLE, fileset = SINGLE_FILE)
- endif
+ ! Look for decomposed files using the I/O Layout.
+ fexists = file_exists(filepath, G%Domain)
+ if (fexists .and. (present(units))) &
+ call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, &
+ domain=G%Domain%mpp_domain)
if (fexists .and. present(global_files)) global_files(n) = .false.
endif
@@ -1570,13 +1392,7 @@ subroutine restart_init(param_file, CS, restart_root)
intent(in) :: restart_root !< A filename root that overrides the value
!! set by RESTARTFILE to enable the use of this module by
!! other components than MOM.
-! Arguments: param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module.
-! (in,opt) restart_root - A filename root that overrides the value in
-! RESTARTFILE. This will enable the use of this
-! module by other components.
+
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "MOM_restart" ! This module's name.
@@ -1651,8 +1467,7 @@ end subroutine restart_end
subroutine restart_error(CS)
type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object
-! Arguments: CS - A pointer that is set to point to the control structure
-! for this module. (Intent in.)
+
character(len=16) :: num ! String for error messages
if (CS%novars > CS%max_fields) then
diff --git a/src/framework/MOM_safe_alloc.F90 b/src/framework/MOM_safe_alloc.F90
index 5b4d331645..75f5fda74e 100644
--- a/src/framework/MOM_safe_alloc.F90
+++ b/src/framework/MOM_safe_alloc.F90
@@ -1,15 +1,9 @@
+!> Convenience functions for safely allocating memory without
+!! accidentally reallocating pointer and causing memory leaks.
module MOM_safe_alloc
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* The subroutines here provide a convenient way to safely allocate *
-!* memory without accidentally reallocating a pointer and causing a *
-!* memory leak. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
implicit none ; private
public safe_alloc_ptr, safe_alloc_alloc
@@ -54,7 +48,8 @@ end subroutine safe_alloc_ptr_1d
!> Allocate a pointer to a 2-d array based on its dimension sizes
subroutine safe_alloc_ptr_2d_2arg(ptr, ni, nj)
real, dimension(:,:), pointer :: ptr !< A pointer to allocate
- integer, intent(in) :: ni, nj !< The sizes of the 1st and 2nd dimensions of the array
+ integer, intent(in) :: ni !< The size of the 1st dimension of the array
+ integer, intent(in) :: nj !< The size of the 2nd dimension of the array
if (.not.associated(ptr)) then
allocate(ptr(ni,nj))
ptr(:,:) = 0.0
@@ -64,8 +59,9 @@ end subroutine safe_alloc_ptr_2d_2arg
!> Allocate a pointer to a 3-d array based on its dimension sizes
subroutine safe_alloc_ptr_3d_2arg(ptr, ni, nj, nk)
real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate
- integer, intent(in) :: ni, nj !< The sizes of the 1st and 2nd dimensions of the array
- integer, intent(in) :: nk !< The size to allocate for the 3rd dimension
+ integer, intent(in) :: ni !< The size of the 1st dimension of the array
+ integer, intent(in) :: nj !< The size of the 2nd dimension of the array
+ integer, intent(in) :: nk !< The size of the 3rd dimension of the array
if (.not.associated(ptr)) then
allocate(ptr(ni,nj,nk))
ptr(:,:,:) = 0.0
@@ -75,8 +71,10 @@ end subroutine safe_alloc_ptr_3d_2arg
!> Allocate a pointer to a 2-d array based on its index starting and ending values
subroutine safe_alloc_ptr_2d(ptr, is, ie, js, je)
real, dimension(:,:), pointer :: ptr !< A pointer to allocate
- integer, intent(in) :: is, ie !< The start and end indices to allocate for the 1st dimension
- integer, intent(in) :: js, je !< The start and end indices to allocate for the 2nd dimension
+ integer, intent(in) :: is !< The start index to allocate for the 1st dimension
+ integer, intent(in) :: ie !< The end index to allocate for the 1st dimension
+ integer, intent(in) :: js !< The start index to allocate for the 2nd dimension
+ integer, intent(in) :: je !< The end index to allocate for the 2nd dimension
if (.not.associated(ptr)) then
allocate(ptr(is:ie,js:je))
ptr(:,:) = 0.0
@@ -86,8 +84,10 @@ end subroutine safe_alloc_ptr_2d
!> Allocate a pointer to a 3-d array based on its index starting and ending values
subroutine safe_alloc_ptr_3d(ptr, is, ie, js, je, nk)
real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate
- integer, intent(in) :: is, ie !< The start and end indices to allocate for the 1st dimension
- integer, intent(in) :: js, je !< The start and end indices to allocate for the 2nd dimension
+ integer, intent(in) :: is !< The start index to allocate for the 1st dimension
+ integer, intent(in) :: ie !< The end index to allocate for the 1st dimension
+ integer, intent(in) :: js !< The start index to allocate for the 2nd dimension
+ integer, intent(in) :: je !< The end index to allocate for the 2nd dimension
integer, intent(in) :: nk !< The size to allocate for the 3rd dimension
if (.not.associated(ptr)) then
allocate(ptr(is:ie,js:je,nk))
@@ -98,8 +98,10 @@ end subroutine safe_alloc_ptr_3d
!> Allocate a 2-d allocatable array based on its index starting and ending values
subroutine safe_alloc_allocatable_2d(ptr, is, ie, js, je)
real, dimension(:,:), allocatable :: ptr !< An allocatable array to allocate
- integer, intent(in) :: is, ie !< The start and end indices to allocate for the 1st dimension
- integer, intent(in) :: js, je !< The start and end indices to allocate for the 2nd dimension
+ integer, intent(in) :: is !< The start index to allocate for the 1st dimension
+ integer, intent(in) :: ie !< The end index to allocate for the 1st dimension
+ integer, intent(in) :: js !< The start index to allocate for the 2nd dimension
+ integer, intent(in) :: je !< The end index to allocate for the 2nd dimension
if (.not.allocated(ptr)) then
allocate(ptr(is:ie,js:je))
ptr(:,:) = 0.0
@@ -109,8 +111,10 @@ end subroutine safe_alloc_allocatable_2d
!> Allocate a 3-d allocatable array based on its index starting and ending values
subroutine safe_alloc_allocatable_3d(ptr, is, ie, js, je, nk)
real, dimension(:,:,:), allocatable :: ptr !< An allocatable array to allocate
- integer, intent(in) :: is, ie !< The start and end indices to allocate for the 1st dimension
- integer, intent(in) :: js, je !< The start and end indices to allocate for the 2nd dimension
+ integer, intent(in) :: is !< The start index to allocate for the 1st dimension
+ integer, intent(in) :: ie !< The end index to allocate for the 1st dimension
+ integer, intent(in) :: js !< The start index to allocate for the 2nd dimension
+ integer, intent(in) :: je !< The end index to allocate for the 2nd dimension
integer, intent(in) :: nk !< The size to allocate for the 3rd dimension
if (.not.allocated(ptr)) then
allocate(ptr(is:ie,js:je,nk))
diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90
index 9e2d312887..281b38c10a 100644
--- a/src/framework/MOM_spatial_means.F90
+++ b/src/framework/MOM_spatial_means.F90
@@ -1,3 +1,4 @@
+!> Functions and routines to take area, volume, mass-weighted, layerwise, zonal or meridional means
module MOM_spatial_means
! This file is part of MOM6. See LICENSE.md for the license.
@@ -170,14 +171,7 @@ subroutine global_i_mean(array, i_mean, G, mask)
real, dimension(SZI_(G),SZJ_(G)), &
optional, intent(in) :: mask !< An array used for weighting the i-mean
-! This subroutine determines the global mean of a field along rows of
-! constant i, returning it in a 1-d array using the local indexing.
-
-! Arguments: array - The 2-d array whose i-mean is to be taken.
-! (out) i_mean - Global mean of array along its i-axis.
-! (in) G - The ocean's grid structure.
-! (in) mask - An array used for weighting the i-mean.
-
+ ! Local variables
type(EFP_type), allocatable, dimension(:) :: asum, mask_sum
real :: mask_sum_r
integer :: is, ie, js, je, idg_off, jdg_off
@@ -251,14 +245,7 @@ subroutine global_j_mean(array, j_mean, G, mask)
real, dimension(SZI_(G),SZJ_(G)), &
optional, intent(in) :: mask !< An array used for weighting the j-mean
-! This subroutine determines the global mean of a field along rows of
-! constant j, returning it in a 1-d array using the local indexing.
-
-! Arguments: array - The 2-d array whose j-mean is to be taken.
-! (out) j_mean - Global mean of array along its j-axis.
-! (in) G - The ocean's grid structure.
-! (in) mask - An array used for weighting the j-mean.
-
+ ! Local variables
type(EFP_type), allocatable, dimension(:) :: asum, mask_sum
real :: mask_sum_r
integer :: is, ie, js, je, idg_off, jdg_off
diff --git a/src/framework/MOM_string_functions.F90 b/src/framework/MOM_string_functions.F90
index 643b150219..0a4058995a 100644
--- a/src/framework/MOM_string_functions.F90
+++ b/src/framework/MOM_string_functions.F90
@@ -1,17 +1,8 @@
+!> Handy functions for manipulating strings
module MOM_string_functions
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Alistair Adcroft and Robert Hallberg, last updated Sept. 2013. *
-!* *
-!* The functions here perform a set of useful manipulations of *
-!* character strings. Although they are a part of MOM6, the do not *
-!* require any other MOM software to be useful. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
implicit none ; private
public lowercase, uppercase
@@ -417,4 +408,12 @@ function slasher(dir)
endif
end function slasher
+!> \namespace mom_string_functions
+!!
+!! By Alistair Adcroft and Robert Hallberg, last updated Sept. 2013.
+!!
+!! The functions here perform a set of useful manipulations of
+!! character strings. Although they are a part of MOM6, the do not
+!! require any other MOM software to be useful.
+
end module MOM_string_functions
diff --git a/src/framework/MOM_time_manager.F90 b/src/framework/MOM_time_manager.F90
index 25c367c1ef..229c3ded3a 100644
--- a/src/framework/MOM_time_manager.F90
+++ b/src/framework/MOM_time_manager.F90
@@ -20,8 +20,9 @@ module MOM_time_manager
implicit none ; private
-public :: time_type, get_time, set_time, time_type_to_real, real_to_time_type
-public :: set_ticks_per_second , get_ticks_per_second
+public :: time_type, get_time, set_time
+public :: time_type_to_real, real_to_time_type, real_to_time
+public :: set_ticks_per_second, get_ticks_per_second
public :: operator(+), operator(-), operator(*), operator(/)
public :: operator(>), operator(<), operator(>=), operator(<=)
public :: operator(==), operator(/=), operator(//)
@@ -35,4 +36,29 @@ module MOM_time_manager
public :: get_external_field_axes
public :: get_external_field_missing
+contains
+
+!> This is an alternate implementation of the FMS function real_to_time_type that is accurate over
+!! a larger range of input values. With 32 bit signed integers, this version should work over the
+!! entire valid range (2^31 days or ~5.8835 million years) of time_types, whereas the standard
+!! version in the FMS time_manager stops working for conversions of times greater than 2^31 seconds,
+!! or ~68.1 years.
+function real_to_time(x, err_msg)
+ type(time_type) :: real_to_time !< The output time as a time_type
+ real, intent(in) :: x !< The input time in real seconds.
+ character(len=*), intent(out), optional :: err_msg !< An optional returned error message.
+
+ ! Local variables
+ integer :: seconds, days, ticks
+ real :: real_subsecond_remainder
+
+ days = floor(x/86400.)
+ seconds = floor(x - 86400.*days)
+ real_subsecond_remainder = x - (days*86400. + seconds)
+ ticks = nint(real_subsecond_remainder * get_ticks_per_second())
+
+ real_to_time = set_time(seconds=seconds, days=days, ticks=ticks, err_msg=err_msg)
+end function real_to_time
+
+
end module MOM_time_manager
diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90
index 98e7c57e4f..c85e3ecb7b 100644
--- a/src/framework/MOM_write_cputime.F90
+++ b/src/framework/MOM_write_cputime.F90
@@ -1,21 +1,10 @@
+!> A module to monitor the overall CPU time used by MOM6 and project when to stop the model
module MOM_write_cputime
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, May 2006. *
-!* *
-!* This file contains the subroutine (write_cputime) that writes *
-!* the summed CPU time across all processors to an output file. In *
-!* addition, write_cputime estimates how many more time steps can be *
-!* taken before 95% of the available CPU time is used, so that the *
-!* model can be checkpointed at that time. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_coms, only : sum_across_PEs, pe_here, num_pes
-use MOM_error_handler, only : MOM_error, FATAL, is_root_pe
+use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, is_root_pe
use MOM_io, only : open_file, APPEND_FILE, ASCII_FILE, WRITEONLY_FILE
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_time_manager, only : time_type, get_time, operator(>)
@@ -26,25 +15,26 @@ module MOM_write_cputime
!-----------------------------------------------------------------------
-integer :: CLOCKS_PER_SEC = 1000
-integer :: MAX_TICKS = 1000
+integer :: CLOCKS_PER_SEC = 1000 !< The number of clock cycles per second, used by the system clock
+integer :: MAX_TICKS = 1000 !< The number of ticks per second, used by the system clock
+!> A control structure that regulates the writing of CPU time
type, public :: write_cputime_CS ; private
- real :: maxcpu ! The maximum amount of cpu time per processor
- ! for which MOM should run before saving a restart
- ! file and quiting with a return value that
- ! indicates that further execution is required to
- ! complete the simulation, in wall-clock seconds.
- type(time_type) :: Start_time ! The start time of the simulation.
- ! Start_time is set in MOM_initialization.F90
- real :: startup_cputime ! The CPU time used in the startup phase of the model.
- real :: prev_cputime = 0.0 ! The last measured CPU time.
- real :: dn_dcpu_min = -1.0 ! The minimum derivative of timestep with CPU time.
- real :: cputime2 = 0.0 ! The accumulated cpu time.
- integer :: previous_calls = 0 ! The number of times write_CPUtime has been called.
- integer :: prev_n = 0 ! The value of n from the last call.
- integer :: fileCPU_ascii ! The unit number of the CPU time file.
- character(len=200) :: CPUfile ! The name of the CPU time file.
+ real :: maxcpu !< The maximum amount of cpu time per processor
+ !! for which MOM should run before saving a restart
+ !! file and quiting with a return value that
+ !! indicates that further execution is required to
+ !! complete the simulation, in wall-clock seconds.
+ type(time_type) :: Start_time !< The start time of the simulation.
+ !! Start_time is set in MOM_initialization.F90
+ real :: startup_cputime !< The CPU time used in the startup phase of the model.
+ real :: prev_cputime = 0.0 !< The last measured CPU time.
+ real :: dn_dcpu_min = -1.0 !< The minimum derivative of timestep with CPU time.
+ real :: cputime2 = 0.0 !< The accumulated cpu time.
+ integer :: previous_calls = 0 !< The number of times write_CPUtime has been called.
+ integer :: prev_n = 0 !< The value of n from the last call.
+ integer :: fileCPU_ascii !< The unit number of the CPU time file.
+ character(len=200) :: CPUfile !< The name of the CPU time file.
end type write_cputime_CS
contains
@@ -53,8 +43,6 @@ module MOM_write_cputime
subroutine write_cputime_start_clock(CS)
type(write_cputime_CS), pointer :: CS !< The control structure set up by a previous
!! call to MOM_write_cputime_init.
-! Argument: CS - A pointer that is set to point to the control structure
-! for this module
integer :: new_cputime ! The CPU time returned by SYSTEM_CLOCK
if (.not.associated(CS)) allocate(CS)
@@ -69,12 +57,8 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS)
type(time_type), intent(in) :: Input_start_time !< The start model time of the simulation.
type(write_cputime_CS), pointer :: CS !< A pointer that may be set to point to the
!! control structure for this module.
-! Arguments: param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) directory - The directory where the energy file goes.
-! (in) Input_start_time - The start time of the simulation.
-! (in/out) CS - A pointer that may be set to point to the control structure
-! for this module.
+
+ ! Local variables
integer :: new_cputime ! The CPU time returned by SYSTEM_CLOCK
! This include declares and sets the variable "version".
#include "version_variable.h"
@@ -119,21 +103,13 @@ subroutine write_cputime(day, n, nmax, CS)
!! that the simulation will not run out of CPU time.
type(write_cputime_CS), pointer :: CS !< The control structure set up by a previous
!! call to MOM_write_cputime_init.
-! This subroutine assesses how much CPU time the model has
-! taken and determines how long the model should be run before it
-! saves a restart file and stops itself.
-
-! Arguments: day - The current model time.
-! (in) n - The time step number of the current execution.
-! (out) nmax - The number of iterations after which to stop so
-! that the simulation will not run out of CPU time.
-! (in) G - The ocean's grid structure.
-! (in) CS - The control structure returned by a previous call to
-! MOM_write_cputime_init.
+
+ ! Local variables
real :: d_cputime ! The change in CPU time since the last call
! this subroutine.
integer :: new_cputime ! The CPU time returned by SYSTEM_CLOCK
real :: reday ! A real version of day.
+ character(len=256) :: mesg ! The text of an error message
integer :: start_of_day, num_days
if (.not.associated(CS)) call MOM_error(FATAL, &
@@ -167,9 +143,8 @@ subroutine write_cputime(day, n, nmax, CS)
nmax = n + INT( CS%dn_dcpu_min * &
(0.95*CS%maxcpu * REAL(num_pes())*CLOCKS_PER_SEC - &
(CS%startup_cputime + CS%cputime2)) )
-! if (is_root_pe() ) then
-! write(*,*) "Resetting nmax to ",nmax," at day",reday
-! endif
+! write(mesg,*) "Resetting nmax to ",nmax," at day",reday
+! call MOM_mesg(mesg)
endif
endif
CS%prev_cputime = new_cputime ; CS%prev_n = n
@@ -203,4 +178,14 @@ subroutine write_cputime(day, n, nmax, CS)
end subroutine write_cputime
+!> \namespace mom_write_cputime
+!!
+!! By Robert Hallberg, May 2006.
+!!
+!! This file contains the subroutine (write_cputime) that writes
+!! the summed CPU time across all processors to an output file. In
+!! addition, write_cputime estimates how many more time steps can be
+!! taken before 95% of the available CPU time is used, so that the
+!! model can be checkpointed at that time.
+
end module MOM_write_cputime
diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90
index 77a4cc82a5..3a27c988c9 100644
--- a/src/ice_shelf/MOM_ice_shelf.F90
+++ b/src/ice_shelf/MOM_ice_shelf.F90
@@ -25,7 +25,7 @@ module MOM_ice_shelf
use MOM_io, only : write_field, close_file, SINGLE_FILE, MULTIPLE
use MOM_restart, only : register_restart_field, query_initialized, save_restart
use MOM_restart, only : restart_init, restore_state, MOM_restart_CS
-use MOM_time_manager, only : time_type, set_time, time_type_to_real
+use MOM_time_manager, only : time_type, time_type_to_real, time_type_to_real, real_to_time
use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid
use MOM_variables, only : surface
use MOM_forcing_type, only : forcing, allocate_forcing_type, MOM_forcing_chksum
@@ -47,7 +47,7 @@ module MOM_ice_shelf
use MOM_checksums, only : hchksum, qchksum, chksum, uchksum, vchksum, uvchksum
use time_interp_external_mod, only : init_external_field, time_interp_external
use time_interp_external_mod, only : time_interp_external_init
-use time_manager_mod, only : print_time, time_type_to_real, real_to_time_type
+use time_manager_mod, only : print_time
implicit none ; private
#include
@@ -71,7 +71,7 @@ module MOM_ice_shelf
!! The rest is private
real :: flux_factor = 1.0 !< A factor that can be used to turn off ice shelf
!! melting (flux_factor = 0).
- character(len=128) :: restart_output_dir = ' '
+ character(len=128) :: restart_output_dir = ' ' !< The directory in which to write restart files
type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe
!! the ice-shelf state
type(ice_shelf_dyn_CS), pointer :: dCS => NULL() !< The control structure for the ice-shelf dynamics.
@@ -119,11 +119,12 @@ module MOM_ice_shelf
!! it is to estimate the gravitational driving force at the
!! shelf front(until we think of a better way to do it-
!! but any difference will be negligible)
- logical :: calve_to_mask
- real :: min_thickness_simple_calve ! min. ice shelf thickness criteria for calving
- real :: T0, S0 ! temp/salt at ocean surface in the restoring region
- real :: input_flux
- real :: input_thickness
+ logical :: calve_to_mask !< If true, calve any ice that passes outside of a masked area
+ real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving
+ real :: T0 !< temperature at ocean surface in the restoring region, in degC
+ real :: S0 !< Salinity at ocean surface in the restoring region, in ppt.
+ real :: input_flux !< Ice volume flux at an upstream open boundary, in m3 s-1.
+ real :: input_thickness !< Ice thickness at an upstream open boundary, in m.
type(time_type) :: Time !< The component's time.
type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the
@@ -143,15 +144,16 @@ module MOM_ice_shelf
logical :: constant_sea_level !< if true, apply an evaporative, heat and salt
!! fluxes. It will avoid large increase in sea level.
real :: cutoff_depth !< depth above which melt is set to zero (>= 0).
- real :: lambda1, lambda2, lambda3 !< liquidus coeffs. Needed if find_salt_root = true
- !>@{
- ! Diagnostic handles
+ real :: lambda1 !< liquidus coeff., Needed if find_salt_root = true
+ real :: lambda2 !< liquidus coeff., Needed if find_salt_root = true
+ real :: lambda3 !< liquidus coeff., Needed if find_salt_root = true
+ !>@{ Diagnostic handles
integer :: id_melt = -1, id_exch_vel_s = -1, id_exch_vel_t = -1, &
id_tfreeze = -1, id_tfl_shelf = -1, &
id_thermal_driving = -1, id_haline_driving = -1, &
id_u_ml = -1, id_v_ml = -1, id_sbdry = -1, &
id_h_shelf = -1, id_h_mask = -1, &
-! id_surf_elev = -1, id_bathym = -1, &
+ id_surf_elev = -1, id_bathym = -1, &
id_area_shelf_h = -1, &
id_ustar_shelf = -1, id_shelf_mass = -1, id_mass_flux = -1
!>@}
@@ -162,13 +164,15 @@ module MOM_ice_shelf
!! the ice shelf mass read from a file
type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output.
- type(user_ice_shelf_CS), pointer :: user_CS => NULL()
+ type(user_ice_shelf_CS), pointer :: user_CS => NULL() !< A pointer to the control structure for
+ !! user-supplied modifications to the ice shelf code.
logical :: debug !< If true, write verbose checksums for debugging purposes
!! and use reproducible sums
end type ice_shelf_CS
-integer :: id_clock_shelf, id_clock_pass !< Clock for group pass calls
+integer :: id_clock_shelf !< CPU Clock for the ice shelf code
+integer :: id_clock_pass !< CPU Clock for group pass calls
contains
@@ -254,6 +258,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces)
! coupled ice-ocean dynamics.
real, parameter :: c2_3 = 2.0/3.0
+ character(len=160) :: mesg ! The text of an error message
integer :: i, j, is, ie, js, je, ied, jed, it1, it3
real, parameter :: rho_fw = 1000.0 ! fresh water density
@@ -380,14 +385,16 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces)
state%sst(i,j))-LF*CS%Gamma_T_3EQ/35.0
S_c = LF*(CS%Gamma_T_3EQ/35.0)*state%sss(i,j)
+ !### Depending on the sign of S_b, one of these will be inaccurate!
Sbdry1 = (-S_b + SQRT(S_b*S_b-4*S_a*S_c))/(2*S_a)
Sbdry2 = (-S_b - SQRT(S_b*S_b-4*S_a*S_c))/(2*S_a)
Sbdry(i,j) = MAX(Sbdry1, Sbdry2)
! Safety check
if (Sbdry(i,j) < 0.) then
- write(*,*)'state%sss(i,j)',state%sss(i,j)
- write(*,*)'S_a, S_b, S_c',S_a, S_b, S_c
- write(*,*)'I,J,Sbdry1,Sbdry2',i,j,Sbdry1,Sbdry2
+ write(mesg,*) 'state%sss(i,j) = ',state%sss(i,j), 'S_a, S_b, S_c', S_a, S_b, S_c
+ call MOM_error(WARNING, mesg, .true.)
+ write(mesg,*) 'I,J,Sbdry1,Sbdry2',i,j,Sbdry1,Sbdry2
+ call MOM_error(WARNING, mesg, .true.)
call MOM_error(FATAL, "shelf_calc_flux: Negative salinity (Sbdry).")
endif
else
@@ -593,20 +600,18 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces)
! haline_driving = state%sss - Sbdry
!if (fluxes%iceshelf_melt(i,j) /= 0.0) then
! if (haline_driving(i,j) /= (state%sss(i,j) - Sbdry(i,j))) then
- ! write(*,*)'Something is wrong at i,j',i,j
- ! write(*,*)'haline_driving, sss-Sbdry',haline_driving(i,j), &
- ! (state%sss(i,j) - Sbdry(i,j))
+ ! write(mesg,*) 'at i,j=',i,j,' haline_driving, sss-Sbdry',haline_driving(i,j), &
+ ! (state%sss(i,j) - Sbdry(i,j))
! call MOM_error(FATAL, &
- ! "shelf_calc_flux: Inconsistency in melt and haline_driving")
+ ! "shelf_calc_flux: Inconsistency in melt and haline_driving"//trim(mesg))
! endif
!endif
- ! 2) check if |melt| > 0 when star_shelf = 0.
+ ! 2) check if |melt| > 0 when ustar_shelf = 0.
! this should never happen
if ((abs(fluxes%iceshelf_melt(i,j))>0.0) .and. (fluxes%ustar_shelf(i,j) == 0.0)) then
- write(*,*)'Something is wrong at i,j',i,j
- call MOM_error(FATAL, &
- "shelf_calc_flux: |melt| > 0 and star_shelf = 0.")
+ write(mesg,*) "|melt| = ",fluxes%iceshelf_melt(i,j)," > 0 and ustar_shelf = 0. at i,j", i, j
+ call MOM_error(FATAL, "shelf_calc_flux: "//trim(mesg))
endif
endif ! area_shelf_h
!!!!!!!!!!!!!!!!!!!!!!!!!!!!End of safety checks !!!!!!!!!!!!!!!!!!!
@@ -749,6 +754,10 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area)
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed
+ if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. &
+ (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) &
+ call MOM_error(FATAL,"add_shelf_forces: Incompatible ocean and ice shelf grids.")
+
ISS => CS%ISS
find_area = .true. ; if (present(do_shelf_area)) find_area = do_shelf_area
@@ -818,6 +827,10 @@ subroutine add_shelf_pressure(G, CS, fluxes)
integer :: i, j, is, ie, js, je, isd, ied, jsd, jed
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
+ if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. &
+ (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) &
+ 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)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j))
if (associated(fluxes%p_surf)) then
@@ -867,10 +880,15 @@ subroutine add_shelf_flux(G, CS, state, fluxes)
real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1.
real, parameter :: rho_fw = 1000.0 ! fresh water density
+ character(len=160) :: mesg ! The text of an error message
integer :: i, j, is, ie, js, je, isd, ied, jsd, jed
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed
+ if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. &
+ (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) &
+ call MOM_error(FATAL,"add_shelf_flux: Incompatible ocean and ice shelf grids.")
+
ISS => CS%ISS
call add_shelf_pressure(G, CS, fluxes)
@@ -973,7 +991,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes)
! just compute changes in mass after first time step
if (t0>0.0) then
- Time0 = real_to_time_type(t0)
+ Time0 = real_to_time(t0)
last_hmask(:,:) = ISS%hmask(:,:) ; last_area_shelf_h(:,:) = ISS%area_shelf_h(:,:)
call time_interp_external(CS%id_read_mass, Time0, last_mass_shelf)
last_h_shelf = last_mass_shelf/CS%density_ice
@@ -1000,7 +1018,8 @@ subroutine add_shelf_flux(G, CS, state, fluxes)
delta_mass_shelf = (shelf_mass1 - shelf_mass0)/CS%time_step
! delta_mass_shelf = (shelf_mass1 - shelf_mass0)* &
! (rho_fw/CS%density_ice)/CS%time_step
-! if (is_root_pe()) write(*,*)'delta_mass_shelf',delta_mass_shelf
+! write(mesg,*)'delta_mass_shelf = ',delta_mass_shelf
+! call MOM_mesg(mesg,5)
else! first time step
delta_mass_shelf = 0.0
endif
@@ -1025,7 +1044,8 @@ subroutine add_shelf_flux(G, CS, state, fluxes)
enddo ; enddo
if (CS%DEBUG) then
- if (is_root_pe()) write(*,*)'Mean melt flux (kg/(m^2 s)),dt',mean_melt_flux,CS%time_step
+ write(mesg,*) 'Mean melt flux (kg/(m^2 s)), dt = ', mean_melt_flux, CS%time_step
+ call MOM_mesg(mesg)
call MOM_forcing_chksum("After constant sea level", fluxes, G, haloshift=0)
endif
@@ -1090,16 +1110,17 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl
call set_grid_metrics(dG, param_file)
! call set_diag_mediator_grid(CS%grid, CS%diag)
- ! The ocean grid is possibly different
- if (associated(ocn_grid)) CS%ocn_grid => ocn_grid
+ ! The ocean grid possibly uses different symmetry.
+ if (associated(ocn_grid)) then ; CS%ocn_grid => ocn_grid
+ else ; CS%ocn_grid => CS%grid ; endif
! Convenience pointers
G => CS%grid
OG => CS%ocn_grid
if (is_root_pe()) then
- write(0,*) 'OG: ', OG%isd, OG%isc, OG%iec, OG%ied, OG%jsd, OG%jsc, OG%jsd, OG%jed
- write(0,*) 'IG: ', G%isd, G%isc, G%iec, G%ied, G%jsd, G%jsc, G%jsd, G%jed
+ write(0,*) 'OG: ', OG%isd, OG%isc, OG%iec, OG%ied, OG%jsd, OG%jsc, OG%jsd, OG%jed
+ write(0,*) 'IG: ', G%isd, G%isc, G%iec, G%ied, G%jsd, G%jsc, G%jsd, G%jed
endif
CS%Time = Time ! ### This might not be in the right place?
@@ -1294,11 +1315,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl
"A typical density of ice.", units="kg m-3", default=917.0)
call get_param(param_file, mdl, "INPUT_FLUX_ICE_SHELF", CS%input_flux, &
- "volume flux at upstream boundary", &
- units="m2 s-1", default=0.)
+ "volume flux at upstream boundary", units="m2 s-1", default=0.)
call get_param(param_file, mdl, "INPUT_THICK_ICE_SHELF", CS%input_thickness, &
- "flux thickness at upstream boundary", &
- units="m", default=1000.)
+ "flux thickness at upstream boundary", units="m", default=1000.)
else
! This is here because of inconsistent defaults. I don't know why. RWH
call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, &
@@ -1338,10 +1357,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl
! when SHELF_THERMO = True. These fluxes are necessary if one wants to
! use either ENERGETICS_SFC_PBL (ALE mode) or BULKMIXEDLAYER (layer mode).
if (present(fluxes)) &
- call allocate_forcing_type(G, fluxes, ustar=.true., shelf=.true., &
+ call allocate_forcing_type(CS%ocn_grid, fluxes, ustar=.true., shelf=.true., &
press=.true., water=CS%isthermo, heat=CS%isthermo)
if (present(forces)) &
- call allocate_mech_forcing(G, forces, ustar=.true., shelf=.true., press=.true.)
+ call allocate_mech_forcing(CS%ocn_grid, forces, ustar=.true., shelf=.true., press=.true.)
else
call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: allocating fluxes in solo mode.")
if (present(fluxes)) &
@@ -1358,6 +1377,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl
call destroy_dyn_horgrid(dG)
+ !### Rescale the topography in the grid, and record the units.
+
! Set up the restarts.
call restart_init(param_file, CS%restart_CSp, "Shelf.res")
call register_restart_field(ISS%mass_shelf, "shelf_mass", .true., CS%restart_CSp, &
diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90
index 5cf01b10ac..eea9ee322a 100644
--- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90
+++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90
@@ -1,6 +1,5 @@
-!> Implements the thermodynamic aspects of ocean / ice-shelf interactions,
-!! along with a crude placeholder for a later implementation of full
-!! ice shelf dynamics, all using the MOM framework and coding style.
+!> Implements a crude placeholder for a later implementation of full
+!! ice shelf dynamics.
module MOM_ice_shelf_dynamics
! This file is part of MOM6. See LICENSE.md for the license.
@@ -18,7 +17,7 @@ module MOM_ice_shelf_dynamics
use MOM_io, only : file_exists, slasher, MOM_read_data
use MOM_restart, only : register_restart_field, query_initialized
use MOM_restart, only : MOM_restart_CS
-use MOM_time_manager, only : time_type, set_time, time_type_to_real
+use MOM_time_manager, only : time_type, set_time
!MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary
use MOM_ice_shelf_state, only : ice_shelf_state
use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs
@@ -34,57 +33,55 @@ module MOM_ice_shelf_dynamics
!> The control structure for the ice shelf dynamics.
type, public :: ice_shelf_dyn_CS ; private
- real, pointer, dimension(:,:) :: &
- u_shelf => NULL(), & !< the zonal (?) velocity of the ice shelf/sheet,
- !! in meters per second??? on q-points (B grid)
- v_shelf => NULL(), & !< the meridional velocity of the ice shelf/sheet,
- !! in m/s ?? on q-points (B grid)
-
- u_face_mask => NULL(), & !> masks for velocity boundary conditions
- v_face_mask => NULL(), & !! on *C GRID* - this is because the FEM
- !! cares about FACES THAT GET INTEGRATED OVER,
- !! not vertices. Will represent boundary conditions
- !! on computational boundary (or permanent boundary
- !! between fast-moving and near-stagnant ice
- !! FOR NOW: 1=interior bdry, 0=no-flow boundary,
- !! 2=stress bdry condition, 3=inhomogeneous
- !! dirichlet boundary, 4=flux boundary: at these
- !! faces a flux will be specified which will
- !! override velocities; a homogeneous velocity
- !! condition will be specified (this seems to give
- !! the solver less difficulty)
- u_face_mask_bdry => NULL(), &
- v_face_mask_bdry => NULL(), &
- u_flux_bdry_val => NULL(), &
- v_flux_bdry_val => NULL(), &
+ real, pointer, dimension(:,:) :: u_shelf => NULL() !< the zonal (?) velocity of the ice shelf/sheet,
+ !! in meters per second??? on q-points (B grid)
+ real, pointer, dimension(:,:) :: v_shelf => NULL() !< the meridional velocity of the ice shelf/sheet,
+ !! in m/s ?? on q-points (B grid)
+
+ real, pointer, dimension(:,:) :: u_face_mask => NULL() !< mask for velocity boundary conditions on the C-grid
+ !! u-face - this is because the FEM cares about FACES THAT GET INTEGRATED OVER,
+ !! not vertices. Will represent boundary conditions on computational boundary
+ !! (or permanent boundary between fast-moving and near-stagnant ice
+ !! FOR NOW: 1=interior bdry, 0=no-flow boundary, 2=stress bdry condition,
+ !! 3=inhomogeneous dirichlet boundary, 4=flux boundary: at these faces a flux
+ !! will be specified which will override velocities; a homogeneous velocity
+ !! condition will be specified (this seems to give the solver less difficulty)
+ real, pointer, dimension(:,:) :: v_face_mask => NULL() !< A mask for velocity boundary conditions on the C-grid
+ !! v-face, with valued defined similarly to u_face_mask.
+ real, pointer, dimension(:,:) :: u_face_mask_bdry => NULL() !< A duplicate copy of u_face_mask?
+ real, pointer, dimension(:,:) :: v_face_mask_bdry => NULL() !< A duplicate copy of v_face_mask?
+ real, pointer, dimension(:,:) :: u_flux_bdry_val => NULL() !< The ice volume flux into the cell through open boundary
+ !! u-faces (where u_face_mask=4), in m3 s-1???
+ real, pointer, dimension(:,:) :: v_flux_bdry_val => NULL() !< The ice volume flux into the cell through open boundary
+ !! v-faces (where v_face_mask=4), in m3 s-1???
! needed where u_face_mask is equal to 4, similary for v_face_mask
- umask => NULL(), vmask => NULL(), & !< masks on the actual degrees of freedom (B grid)
- !! 1=normal node, 3=inhomogeneous boundary node,
- !! 0 - no flow node (will also get ice-free nodes)
- calve_mask => NULL(), & !< a mask to prevent the ice shelf front from
- !! advancing past its initial position (but it may
- !! retreat)
- t_shelf => NULL(), & !< Veritcally integrated temperature in the ice shelf/stream, in degC
- !< on corner-points (B grid)
- tmask => NULL(), &
- ! masks for temperature boundary conditions ???
- ice_visc => NULL(), &
- thickness_bdry_val => NULL(), &
- u_bdry_val => NULL(), &
- v_bdry_val => NULL(), &
- h_bdry_val => NULL(), &
- t_bdry_val => NULL(), &
-
- taub_beta_eff => NULL(), & ! nonlinear part of "linearized" basal stress -
- ! exact form depends on basal law exponent
- ! and/or whether flow is "hybridized" a la Goldberg 2011
-
- OD_rt => NULL(), & !< A running total for calulating OD_av.
- float_frac_rt => NULL(), & !< A running total for calculating float_frac.
- OD_av => NULL(), & !< The time average open ocean depth, in m.
- float_frac => NULL() !< Fraction of the time a cell is "exposed", i.e. the column
+ real, pointer, dimension(:,:) :: umask => NULL() !< u-mask on the actual degrees of freedom (B grid)
+ !! 1=normal node, 3=inhomogeneous boundary node,
+ !! 0 - no flow node (will also get ice-free nodes)
+ real, pointer, dimension(:,:) :: vmask => NULL() !< v-mask on the actual degrees of freedom (B grid)
+ !! 1=normal node, 3=inhomogeneous boundary node,
+ !! 0 - no flow node (will also get ice-free nodes)
+ real, pointer, dimension(:,:) :: calve_mask => NULL() !< a mask to prevent the ice shelf front from
+ !! advancing past its initial position (but it may retreat)
+ real, pointer, dimension(:,:) :: t_shelf => NULL() !< Veritcally integrated temperature in the ice shelf/stream,
+ !! in degC on corner-points (B grid)
+ real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice.
+ real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, perhaps in m.
+ real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary, in m.
+ real, pointer, dimension(:,:) :: u_bdry_val => NULL() !< The zonal ice velocity at inflowing boundaries in m/s???
+ real, pointer, dimension(:,:) :: v_bdry_val => NULL() !< The meridional ice velocity at inflowing boundaries in m/s???
+ real, pointer, dimension(:,:) :: h_bdry_val => NULL() !< The ice thickness at inflowing boundaries, in m.
+ real, pointer, dimension(:,:) :: t_bdry_val => NULL() !< The ice temperature at inflowing boundaries, in deg C.
+
+ real, pointer, dimension(:,:) :: taub_beta_eff => NULL() !< nonlinear part of "linearized" basal stress.
+ !! The exact form depends on basal law exponent and/or whether flow is "hybridized" a la Goldberg 2011
+
+ real, pointer, dimension(:,:) :: OD_rt => NULL() !< A running total for calculating OD_av.
+ real, pointer, dimension(:,:) :: float_frac_rt => NULL() !< A running total for calculating float_frac.
+ real, pointer, dimension(:,:) :: OD_av => NULL() !< The time average open ocean depth, in m.
+ real, pointer, dimension(:,:) :: float_frac => NULL() !< Fraction of the time a cell is "exposed", i.e. the column
!! thickness is below a threshold.
- !! [if float_frac = 1 ==> grounded; obv. counterintuitive; might fix]
+ !### [if float_frac = 1 ==> grounded; obviously counterintuitive; might fix]
integer :: OD_rt_counter = 0 !< A counter of the number of contributions to OD_rt.
real :: velocity_update_time_step !< The time in s to update the ice shelf velocity through the
@@ -106,33 +103,35 @@ module MOM_ice_shelf_dynamics
!! divided into nxn equally-sized rectangles, over which
!! basal contribution is integrated (iterative quadrature)
logical :: GL_couple !< whether to let the floatation condition be
- !!determined by ocean column thickness means update_OD_ffrac
+ !! determined by ocean column thickness means update_OD_ffrac
!! will be called (note: GL_regularize and GL_couple
!! should be exclusive)
real :: CFL_factor !< A factor used to limit subcycled advective timestep in uncoupled runs
!! i.e. dt <= CFL_factor * min(dx / u)
- real :: A_glen_isothermal
- real :: n_glen
- real :: eps_glen_min
- real :: C_basal_friction
- real :: n_basal_friction
+ real :: A_glen_isothermal !< Ice viscosity parameter in Glen's Lawa, in Pa-1/3 a.
+ real :: n_glen !< Nonlinearity exponent in Glen's Law
+ real :: eps_glen_min !< Min. strain rate to avoid infinite Glen's law viscosity, in a-1.
+ real :: C_basal_friction !< Ceofficient in sliding law tau_b = C u^(n_basal_friction), in
+ !! units="Pa (m-a)-(n_basal_friction)
+ real :: n_basal_friction !< Exponent in sliding law tau_b = C u^(m_slide)
real :: density_ocean_avg !< this does not affect ocean circulation OR thermodynamics
!! it is to estimate the gravitational driving force at the
!! shelf front(until we think of a better way to do it-
!! but any difference will be negligible)
- real :: thresh_float_col_depth ! the water column depth over which the shelf if considered to be floating
- logical :: moving_shelf_front
- logical :: calve_to_mask
- real :: min_thickness_simple_calve ! min. ice shelf thickness criteria for calving
-
-
- real :: cg_tolerance
- real :: nonlinear_tolerance
- integer :: cg_max_iterations
- integer :: nonlin_solve_err_mode ! 1: exit vel solve based on nonlin residual
- ! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol where | | is infty-norm
+ real :: thresh_float_col_depth !< The water column depth over which the shelf if considered to be floating
+ logical :: moving_shelf_front !< Specify whether to advance shelf front (and calve).
+ logical :: calve_to_mask !< If true, calve off the ice shelf when it passes the edge of a mask.
+ real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving, in m
+
+ real :: cg_tolerance !< The tolerance in the CG solver, relative to initial residual, that
+ !! deterimnes when to stop the conguage gradient iterations.
+ real :: nonlinear_tolerance !< The fractional nonlinear tolerance, relative to the initial error,
+ !! that sets when to stop the iterative velocity solver
+ integer :: cg_max_iterations !< The maximum number of iterations that can be used in the CG solver
+ integer :: nonlin_solve_err_mode !< 1: exit vel solve based on nonlin residual
+ !! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol where | | is infty-norm
logical :: use_reproducing_sums !< use new reproducing sums of Bob & Alistair for global sums.
! ids for outputting intermediate thickness in advection subroutine (debugging)
@@ -142,12 +141,11 @@ module MOM_ice_shelf_dynamics
!! and use reproducible sums
logical :: module_is_initialized = .false. !< True if this module has been initialized.
- !>@{
- ! Diagnostic handles
+ !>@{ Diagnostic handles
integer :: id_u_shelf = -1, id_v_shelf = -1, id_t_shelf = -1, &
id_float_frac = -1, id_col_thick = -1, id_OD_av = -1, &
id_u_mask = -1, id_v_mask = -1, id_t_mask = -1
- !>@}
+ !!@}
! ids for outputting intermediate thickness in advection subroutine (debugging)
!integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1
@@ -525,18 +523,18 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, Time)
type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf.
type(time_type), intent(in) :: Time !< The current model time
- integer :: i, j, iters, isd, ied, jsd, jed
- real :: rhoi, rhow, OD
- type(time_type) :: dummy_time
+ integer :: i, j, iters, isd, ied, jsd, jed
+ real :: rhoi, rhow, OD
+ type(time_type) :: dummy_time
rhoi = CS%density_ice
rhow = CS%density_ocean_avg
- dummy_time = set_time (0,0)
+ dummy_time = set_time(0,0)
isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
do j=jsd,jed
do i=isd,ied
- OD = G%bathyT(i,j) - rhoi/rhow * ISS%h_shelf(i,j)
+ OD = G%Zd_to_m*G%bathyT(i,j) - rhoi/rhow * ISS%h_shelf(i,j)
if (OD >= 0) then
! ice thickness does not take up whole ocean column -> floating
CS%OD_av(i,j) = OD
@@ -776,6 +774,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time)
u_last, v_last, H_node
real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond ! An array indicating where the ice
! shelf is floating: 0 if floating, 1 if not.
+ character(len=160) :: mesg ! The text of an error message
integer :: conv_flag, i, j, k,l, iter
integer :: isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, isumstart, jsumstart, nodefloat, nsub
real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi, rhow
@@ -830,7 +829,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time)
do k=0,1
do l=0,1
if ((ISS%hmask(i,j) == 1) .and. &
- (rhoi/rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then
+ (rhoi/rhow * H_node(i-1+k,j-1+l) - G%Zd_to_m*G%bathyT(i,j) <= 0)) then
nodefloat = nodefloat + 1
endif
enddo
@@ -889,7 +888,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time)
Au(:,:) = 0.0 ; Av(:,:) = 0.0
call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, &
- CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, &
+ CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, G%areaT, &
G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow)
err_init = 0 ; err_tempu = 0; err_tempv = 0
@@ -909,7 +908,8 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time)
call max_across_PEs(err_init)
- if (is_root_pe()) print *,"INITIAL nonlinear residual: ",err_init
+ write(mesg,*) "ice_shelf_solve_outer: INITIAL nonlinear residual = ",err_init
+ call MOM_mesg(mesg, 5)
u_last(:,:) = u(:,:) ; v_last(:,:) = v(:,:)
@@ -925,7 +925,8 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time)
call qchksum(v, "v shelf", G%HI, haloshift=2)
endif
- if (is_root_pe()) print *,"linear solve done",iters," iterations"
+ write(mesg,*) "ice_shelf_solve_outer: linear solve done in ",iters," iterations"
+ call MOM_mesg(mesg, 5)
call calc_shelf_visc(CS, ISS, G, u, v)
call pass_var(CS%ice_visc, G%domain)
@@ -946,7 +947,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time)
Au(:,:) = 0 ; Av(:,:) = 0
call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, &
- CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, &
+ CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, G%areaT, &
G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow)
err_max = 0
@@ -1001,11 +1002,12 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time)
endif
- if (is_root_pe()) print *,"nonlinear residual: ",err_max/err_init
+ write(mesg,*) "ice_shelf_solve_outer: nonlinear residual = ",err_max/err_init
+ call MOM_mesg(mesg, 5)
if (err_max <= CS%nonlinear_tolerance * err_init) then
- if (is_root_pe()) &
- print *,"exiting nonlinear solve after ",iter," iterations"
+ write(mesg,*) "ice_shelf_solve_outer: exiting nonlinear solve after ",iter," iterations"
+ call MOM_mesg(mesg, 5)
exit
endif
@@ -1109,7 +1111,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c
call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE)
call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, &
- H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, &
+ H_node, CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, &
G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg)
call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE)
@@ -1180,7 +1182,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c
Au(:,:) = 0 ; Av(:,:) = 0
call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, &
- H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, &
+ H_node, CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, &
G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg)
! Au, Av valid region moves in by 1
@@ -1882,6 +1884,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter)
integer :: iter_flag
real :: h_reference, dxh, dyh, dxdyh, rho, partial_vol, tot_flux
+ character(len=160) :: mesg ! The text of an error message
integer, dimension(4) :: mapi, mapj, new_partial
! real, dimension(size(flux_enter,1),size(flux_enter,2),size(flux_enter,2)) :: flux_enter_replace
real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter_replace
@@ -2011,7 +2014,10 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter)
call max_across_PEs(iter_count)
- if (is_root_pe() .and. (iter_count > 1)) print *, iter_count, "MAX ITERATIONS,ADVANCE FRONT"
+ if (is_root_pe() .and. (iter_count > 1)) then
+ write(mesg,*) "shelf_advance_front: ", iter_count, " max iterations"
+ call MOM_mesg(mesg, 5)
+ endif
end subroutine shelf_advance_front
@@ -2117,7 +2123,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD)
! prelim - go through and calculate S
! or is this faster?
- BASE(:,:) = -G%bathyT(:,:) + OD(:,:)
+ BASE(:,:) = -G%Zd_to_m*G%bathyT(:,:) + OD(:,:)
S(:,:) = BASE(:,:) + ISS%h_shelf(:,:)
do j=jsc-1,jec+1
@@ -2216,7 +2222,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD)
taud_y(I,J) = taud_y(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh
if (CS%float_frac(i,j) == 1) then
- neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * G%bathyT(i,j) ** 2)
+ neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * (G%Zd_to_m*G%bathyT(i,j)) ** 2)
else
neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j) ** 2
endif
@@ -2732,7 +2738,7 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati
enddo ; enddo
enddo ; enddo
if (float_cond(i,j) == 1) then
- Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j)
+ Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%Zd_to_m*G%bathyT(i,j)
Hcell(:,:) = H_node(i-1:i,j-1:j)
call CG_diagonal_subgrid_basal &
(Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr)
@@ -2947,7 +2953,7 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo
enddo ; enddo
if (float_cond(i,j) == 1) then
- Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j)
+ Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%Zd_to_m*G%bathyT(i,j)
Ucell(:,:) = CS%u_bdry_val(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_bdry_val(i-1:i,j-1:j)
Hcell(:,:) = H_node(i-1:i,j-1:j)
call CG_action_subgrid_basal &
@@ -3083,7 +3089,7 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf)
do j=jsd,jed
do i=isd,ied
- OD = G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j)
+ OD = G%Zd_to_m*G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j)
if (OD >= 0) then
! ice thickness does not take up whole ocean column -> floating
CS%OD_av(i,j) = OD
@@ -3328,7 +3334,7 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face
end select
enddo
- !if (CS%u_face_mask_bdry(i-1,j).geq.0) then !left boundary
+ !if (CS%u_face_mask_bdry(i-1,j) >= 0) then !left boundary
! u_face_mask(i-1,j) = CS%u_face_mask_bdry(i-1,j)
! umask(i-1,j-1:j) = 3.
! vmask(i-1,j-1:j) = 0.
@@ -3603,7 +3609,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f
type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf.
real, intent(in) :: time_step !< The time step for this update, in s.
real, dimension(SZDI_(G),SZDJ_(G)), &
- intent(inout) :: hmask !< A mask indicating which tracer points are
+ intent(in) :: hmask !< A mask indicating which tracer points are
!! partly or fully covered by an ice-shelf
real, dimension(SZDI_(G),SZDJ_(G)), &
intent(in) :: h0 !< The initial ice shelf thicknesses in m.
@@ -3844,7 +3850,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft
type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf.
real, intent(in) :: time_step !< The time step for this update, in s.
real, dimension(SZDI_(G),SZDJ_(G)), &
- intent(inout) :: hmask !< A mask indicating which tracer points are
+ intent(in) :: hmask !< A mask indicating which tracer points are
!! partly or fully covered by an ice-shelf
real, dimension(SZDI_(G),SZDJ_(G)), &
intent(in) :: h_after_uflux !< The ice shelf thicknesses after
@@ -4060,94 +4066,4 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft
end subroutine ice_shelf_advect_temp_y
-!> \namespace mom_ice_shelf_dynamics
-!!
-!! \section section_ICE_SHELF_dynamics
-!!
-!! This module implements the thermodynamic aspects of ocean/ice-shelf
-!! inter-actions, along with a crude placeholder for a later implementation of full
-!! ice shelf dynamics, all using the MOM framework and coding style.
-!!
-!! Derived from code by Chris Little, early 2010.
-!!
-!! The ice-sheet dynamics subroutines do the following:
-!! initialize_shelf_mass - Initializes the ice shelf mass distribution.
-!! - Initializes h_shelf, h_mask, area_shelf_h
-!! - CURRENTLY: initializes mass_shelf as well, but this is unnecessary, as mass_shelf is initialized based on
-!! h_shelf and density_ice immediately afterwards. Possibly subroutine should be renamed
-!! update_shelf_mass - updates ice shelf mass via netCDF file
-!! USER_update_shelf_mass (TODO).
-!! ice_shelf_solve_outer - Orchestrates the calls to calculate the shelf
-!! - outer loop calls ice_shelf_solve_inner
-!! stresses and checks for error tolerances.
-!! Max iteration count for outer loop currently fixed at 100 iteration
-!! - tolerance (and error evaluation) can be set through input file
-!! - updates u_shelf, v_shelf, ice_visc, taub_beta_eff
-!! ice_shelf_solve_inner - Conjugate Gradient solve of matrix solve for ice_shelf_solve_outer
-!! - Jacobi Preconditioner - basically diagonal of matrix (not sure if it is effective at all)
-!! - modifies u_shelf and v_shelf only
-!! - max iteration count can be set through input file
-!! - tolerance (and error evaluation) can be set through input file
-!! (ISSUE: Too many sum_across_PEs calls?)
-!! calc_shelf_driving_stress - Determine the driving stresses using h_shelf, (water) column thickness, bathymetry
-!! - does not modify any permanent arrays
-!! init_boundary_values -
-!! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and
-!! bilinear nodal basis
-!! calc_shelf_visc - Glen's law viscosity and nonlinear sliding law (called by ice_shelf_solve_outer)
-!! apply_boundary_values - same as CG_action, but input is zero except for dirichlet bdry conds
-!! CG_action - Effect of matrix (that is never explicitly constructed)
-!! on vector space of Degrees of Freedom (DoFs) in velocity solve
-!! ice_shelf_advect - Given the melt rate and velocities, it advects the ice shelf THICKNESS
-!! - modified h_shelf, area_shelf_h, hmask
-!! (maybe should updater mass_shelf as well ???)
-!! ice_shelf_advect_thickness_x, ice_shelf_advect_thickness_y - These
-!! subroutines determine the mass fluxes through the faces.
-!! (ISSUE: duplicative flux calls for shared faces?)
-!! ice_shelf_advance_front - Iteratively determine the ice-shelf front location.
-!! - IF ice_shelf_advect_thickness_x,y are modified to avoid
-!! dupe face processing, THIS NEEDS TO BE MODIFIED TOO
-!! as it depends on arrays modified in those functions
-!! (if in doubt consult DNG)
-!! update_velocity_masks - Controls which elements of u_shelf and v_shelf are considered DoFs in linear solve
-!! solo_time_step - called only in ice-only mode.
-!! shelf_calc_flux - after melt rate & fluxes are calculated, ice dynamics are done. currently mass_shelf is
-!! updated immediately after ice_shelf_advect.
-!!
-!!
-!! NOTES: be aware that hmask(:,:) has a number of functions; it is used for front advancement,
-!! for subroutines in the velocity solve, and for thickness boundary conditions (this last one may be removed).
-!! in other words, interfering with its updates will have implications you might not expect.
-!!
-!! Overall issues: Many variables need better documentation and units and the
-!! subgrid on which they are discretized.
-!!
-!! \subsection section_ICE_SHELF_equations ICE_SHELF equations
-!!
-!! The three fundamental equations are:
-!! Heat flux
-!! \f[ \qquad \rho_w C_{pw} \gamma_T (T_w - T_b) = \rho_i \dot{m} L_f \f]
-!! Salt flux
-!! \f[ \qquad \rho_w \gamma_s (S_w - S_b) = \rho_i \dot{m} S_b \f]
-!! Freezing temperature
-!! \f[ \qquad T_b = a S_b + b + c P \f]
-!!
-!! where ....
-!!
-!! \subsection section_ICE_SHELF_references References
-!!
-!! Asay-Davis, Xylar S., Stephen L. Cornford, Benjamin K. Galton-Fenzi, Rupert M. Gladstone, G. Hilmar Gudmundsson,
-!! David M. Holland, Paul R. Holland, and Daniel F. Martin. Experimental design for three interrelated marine ice sheet
-!! and ocean model intercomparison projects: MISMIP v. 3 (MISMIP+), ISOMIP v. 2 (ISOMIP+) and MISOMIP v. 1 (MISOMIP1).
-!! Geoscientific Model Development 9, no. 7 (2016): 2471.
-!!
-!! Goldberg, D. N., et al. Investigation of land ice-ocean interaction with a fully coupled ice-ocean model: 1.
-!! Model description and behavior. Journal of Geophysical Research: Earth Surface 117.F2 (2012).
-!!
-!! Goldberg, D. N., et al. Investigation of land ice-ocean interaction with a fully coupled ice-ocean model: 2.
-!! Sensitivity to external forcings. Journal of Geophysical Research: Earth Surface 117.F2 (2012).
-!!
-!! Holland, David M., and Adrian Jenkins. Modeling thermodynamic ice-ocean interactions at the base of an ice shelf.
-!! Journal of Physical Oceanography 29.8 (1999): 1787-1800.
-
end module MOM_ice_shelf_dynamics
diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90
index 8dcacb3e60..ec6ce0fffa 100644
--- a/src/ice_shelf/MOM_ice_shelf_initialize.F90
+++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90
@@ -1,3 +1,4 @@
+!> Initialize ice shelf variables
module MOM_ice_shelf_initialize
! This file is part of MOM6. See LICENSE.md for the license.
@@ -12,14 +13,13 @@ module MOM_ice_shelf_initialize
#include
-
!MJHpublic initialize_ice_shelf_boundary, initialize_ice_thickness
public initialize_ice_thickness
contains
-subroutine initialize_ice_thickness (h_shelf, area_shelf_h, hmask, G, PF)
-
+!> Initialize ice shelf thickness
+subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, PF)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZDI_(G),SZDJ_(G)), &
intent(inout) :: h_shelf !< The ice shelf thickness, in m.
@@ -48,9 +48,8 @@ subroutine initialize_ice_thickness (h_shelf, area_shelf_h, hmask, G, PF)
end subroutine initialize_ice_thickness
-
-subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, PF)
-
+!> Initialize ice shelf thickness from file
+subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, PF)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZDI_(G),SZDJ_(G)), &
intent(inout) :: h_shelf !< The ice shelf thickness, in m.
@@ -135,9 +134,8 @@ subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G,
end subroutine initialize_ice_thickness_from_file
-
-subroutine initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, PF)
-
+!> Initialize ice shelf thickness for a channel configuration
+subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, PF)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZDI_(G),SZDJ_(G)), &
intent(inout) :: h_shelf !< The ice shelf thickness, in m.
diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90
index dfd527169d..7e5bbe2620 100644
--- a/src/ice_shelf/user_shelf_init.F90
+++ b/src/ice_shelf/user_shelf_init.F90
@@ -18,16 +18,17 @@ module user_shelf_init
public USER_initialize_shelf_mass, USER_update_shelf_mass
public USER_init_ice_thickness
-logical :: first_call = .true.
+!> The control structure for the user_ice_shelf module
type, public :: user_ice_shelf_CS ; private
- real :: Rho_ocean ! The ocean's typical density, in kg m-3.
- real :: max_draft ! The maximum ocean draft of the ice shelf, in m.
- real :: min_draft ! The minimum ocean draft of the ice shelf, in m.
- real :: flat_shelf_width ! The range over which the shelf is min_draft thick.
- real :: shelf_slope_scale ! The range over which the shelf slopes.
- real :: pos_shelf_edge_0
- real :: shelf_speed
+ real :: Rho_ocean !< The ocean's typical density, in kg m-3.
+ real :: max_draft !< The maximum ocean draft of the ice shelf, in m.
+ real :: min_draft !< The minimum ocean draft of the ice shelf, in m.
+ real :: flat_shelf_width !< The range over which the shelf is min_draft thick.
+ real :: shelf_slope_scale !< The range over which the shelf slopes.
+ real :: pos_shelf_edge_0 !< The x-position of the shelf edge at time 0, in km.
+ real :: shelf_speed !< The ice shelf speed of translation, in km day-1
+ logical :: first_call = .true. !< If true, this module has not been called before.
end type user_ice_shelf_CS
contains
@@ -75,7 +76,8 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask,
if (.not.associated(CS)) allocate(CS)
! Read all relevant parameters and write them to the model log.
- if (first_call) call write_user_log(param_file)
+ if (CS%first_call) call write_user_log(param_file)
+ CS%first_call = .false.
call get_param(param_file, mdl, "RHO_0", CS%Rho_ocean, &
"The mean ocean density used with BOUSSINESQ true to \n"//&
"calculate accelerations and the mass for conservation \n"//&
@@ -213,7 +215,6 @@ subroutine write_user_log(param_file)
character(len=40) :: mdl = "user_shelf_init" ! This module's name.
call log_version(param_file, mdl, version, tagname)
- first_call = .false.
end subroutine write_user_log
diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90
index 5b4c497bcb..54728f61d9 100644
--- a/src/initialization/MOM_coord_initialization.F90
+++ b/src/initialization/MOM_coord_initialization.F90
@@ -24,11 +24,10 @@ module MOM_coord_initialization
public MOM_initialize_coord
-character(len=40) :: mdl = "MOM_coord_initialization" ! This module's name.
+character(len=40) :: mdl = "MOM_coord_initialization" !< This module's name.
contains
-! -----------------------------------------------------------------------------
!> MOM_initialize_coord sets up time-invariant quantities related to MOM6's
!! vertical coordinate.
subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth)
@@ -100,7 +99,7 @@ subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth)
"Unrecognized coordinate setup"//trim(config))
end select
if (debug) call chksum(GV%Rlay, "MOM_initialize_coord: Rlay ", 1, nz)
- if (debug) call chksum(GV%g_prime, "MOM_initialize_coord: g_prime ", 1, nz)
+ if (debug) call chksum(GV%Z_to_m*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz)
call setVerticalGridAxes( GV%Rlay, GV )
! Copy the maximum depth across from the input argument
@@ -112,25 +111,18 @@ subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth)
call callTree_leave('MOM_initialize_coord()')
end subroutine MOM_initialize_coord
-! -----------------------------------------------------------------------------
-! The set_coord routines deal with initializing aspects of the vertical grid.
-! -----------------------------------------------------------------------------
+! The set_coord routines deal with initializing aspects of the vertical grid.
+
+!> Sets the layer densities (Rlay) and the interface reduced gravities (g).
subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file)
real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values
!! (potential density).
- real, dimension(:), intent(out) :: g_prime !< A structure indicating the open file to
- !! parse for model parameter values.
+ real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces
+ !! in m2 Z-1 s-2.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
-! Arguments: Rlay - the layers' target coordinate values (potential density).
-! (out) g_prime - the reduced gravity across the interfaces, in m s-2.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
-! This subroutine sets the layer densities (Rlay) and the interface !
-! reduced gravities (g). !
+ ! Local variables
real :: g_int ! Reduced gravities across the internal interfaces, in m s-2.
real :: g_fs ! Reduced gravity across the free surface, in m s-2.
character(len=40) :: mdl = "set_coord_from_gprime" ! This subroutine's name.
@@ -141,10 +133,10 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file)
call get_param(param_file, mdl, "GFS" , g_fs, &
"The reduced gravity at the free surface.", units="m s-2", &
- default=GV%g_Earth)
+ default=(GV%g_Earth*GV%m_to_Z), scale=GV%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.)
+ units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m)
g_prime(1) = g_fs
do k=2,nz ; g_prime(k) = g_int ; enddo
@@ -154,24 +146,16 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file)
call callTree_leave(trim(mdl)//'()')
end subroutine set_coord_from_gprime
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+!> Sets the layer densities (Rlay) and the interface reduced gravities (g).
subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file)
real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values
!! (potential density).
- real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces,
- !! in m s-2.
+ real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces
+ !! in m2 Z-1 s-2.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
-! Arguments: Rlay - the layers' target coordinate values (potential density).
-! (out) g_prime - the reduced gravity across the interfaces, in m s-2.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
-! This subroutine sets the layer densities (Rlay) and the interface !
-! reduced gravities (g). !
+ ! Local variables
real :: g_fs ! Reduced gravity across the free surface, in m s-2.
real :: Rlay_Ref! The surface layer's target density, in kg m-3.
real :: RLay_range ! The range of densities, in kg m-3.
@@ -183,7 +167,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file)
call get_param(param_file, mdl, "GFS", g_fs, &
"The reduced gravity at the free surface.", units="m s-2", &
- default=GV%g_Earth)
+ default=(GV%g_Earth*GV%m_to_Z), scale=GV%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=GV%Rho0)
@@ -203,31 +187,21 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file)
call callTree_leave(trim(mdl)//'()')
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, param_file, eqn_of_state, &
P_Ref)
real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values
!! (potential density).
- real, dimension(:), intent(out) :: g_prime !< the reduced gravity across the interfaces,
- !! in m s-2.
+ real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces
+ !! in m2 Z-1 s-2.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
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
!! in Pa.
-! Arguments: Rlay - the layers' target coordinate values (potential density).
-! (out) g_prime - the reduced gravity across the interfaces, in m s-2.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) eqn_of_state - integer selecting the equation of state
-! (in) P_Ref - The coordinate-density reference pressure in Pa.
-
-! This subroutine sets the layer densities (Rlay) and the interface !
-! reduced gravities (g). !
+ ! Local variables
real :: T_ref ! Reference temperature
real :: S_ref ! Reference salinity
real :: g_int ! Reduced gravities across the internal interfaces, in m s-2.
@@ -245,10 +219,10 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, 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%g_Earth)
+ default=(GV%g_Earth*GV%m_to_Z), scale=GV%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.)
+ units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m)
!
! These statements set the interface reduced gravities. !
g_prime(1) = g_fs
@@ -264,31 +238,21 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, &
call callTree_leave(trim(mdl)//'()')
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, param_file, &
eqn_of_state, P_Ref)
real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values
!! (potential density).
- real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces,
- !! in m s-2.
+ real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces
+ !! in m2 Z-1 s-2.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
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
!! in Pa.
-! Arguments: Rlay - the layers' target coordinate values (potential density).
-! (out) g_prime - the reduced gravity across the interfaces, in m s-2.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) eqn_of_state - integer that selects equation of state
-! (in) P_Ref - The coordinate-density reference pressure in Pa.
-
-! This subroutine sets the layer densities (Rlay) and the interface !
-! reduced gravities (g). !
+ ! Local variables
real, dimension(GV%ke) :: T0, S0, Pref
real :: g_fs ! Reduced gravity across the free surface, in m s-2.
integer :: k, nz
@@ -300,7 +264,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, &
call get_param(param_file, mdl, "GFS", g_fs, &
"The reduced gravity at the free surface.", units="m s-2", &
- default=GV%g_Earth)
+ default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m)
call get_param(param_file, mdl, "COORD_FILE", coord_file, &
"The file from which the coordinate temperatures and \n"//&
"salinities are read.", fail_if_missing=.true.)
@@ -318,35 +282,24 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, &
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)
- do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo
+ do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo
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, param_file, &
eqn_of_state, P_Ref)
real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values
!! (potential density).
- real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces,
- !! in m s-2.
+ real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces
+ !! in m2 Z-1 s-2.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
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
!! in Pa.
-! Arguments: Rlay - the layers' target coordinate values (potential density).
-! (out) g_prime - the reduced gravity across the interfaces, in m s-2.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) eqn_of_state - integer that selects equation of state
-! (in) P_Ref - The coordinate-density reference pressure in Pa.
-
-! This subroutine sets the layer densities (Rlay) and the interface !
-! reduced gravities (g). !
real, dimension(GV%ke) :: T0, S0, Pref
real :: S_Ref, S_Light, S_Dense ! Salinity range parameters in PSU.
real :: T_Ref, T_Light, T_Dense ! Temperature range parameters in dec C.
@@ -390,7 +343,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, &
call get_param(param_file, mdl, "GFS", g_fs, &
"The reduced gravity at the free surface.", units="m s-2", &
- default=GV%g_Earth)
+ default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m)
k_light = GV%nk_rho_varies + 1
@@ -415,24 +368,16 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, &
call callTree_leave(trim(mdl)//'()')
end subroutine set_coord_from_TS_range
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+! Sets the layer densities (Rlay) and the interface reduced gravities (g) from data in file.
subroutine set_coord_from_file(Rlay, g_prime, GV, param_file)
real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values
!! (potential density).
- real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces,
- !! in m s-2.
+ real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces
+ !! in m2 Z-1 s-2.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
-! Arguments: Rlay - the layers' target coordinate values (potential density).
-! (out) g_prime - the reduced gravity across the interfaces, in m s-2.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
-! This subroutine sets the layer densities (Rlay) and the interface !
-! reduced gravities (g). !
+ ! Local variables
real :: g_fs ! Reduced gravity across the free surface, in m s-2.
integer :: k, nz
character(len=40) :: mdl = "set_coord_from_file" ! This subroutine's name.
@@ -444,7 +389,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file)
call get_param(param_file, mdl, "GFS", g_fs, &
"The reduced gravity at the free surface.", units="m s-2", &
- default=GV%g_Earth)
+ default=(GV%g_Earth*GV%m_to_Z), scale=GV%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, &
@@ -469,27 +414,20 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file)
call callTree_leave(trim(mdl)//'()')
end subroutine set_coord_from_file
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+!> Sets the layer densities (Rlay) and the interface
+!! reduced gravities (g) according to a linear profile starting at a
+!! reference surface layer density and spanning a range of densities
+!! to the bottom defined by the parameter RLAY_RANGE
+!! (defaulting to 2.0 if not defined)
subroutine set_coord_linear(Rlay, g_prime, GV, param_file)
real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values
!! (potential density).
- real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces,
- !! in m s-2.
+ real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces
+ !! in m2 Z-1 s-2.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
-! Arguments: Rlay - the layers' target coordinate values (potential density).
-! (out) g_prime - the reduced gravity across the interfaces, in m s-2.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
-! This subroutine sets the layer densities (Rlay) and the interface
-! reduced gravities (g) according to a linear profile starting at a
-! reference surface layer density and spanning a range of densities
-! to the bottom defined by the parameter RLAY_RANGE
-! (defaulting to 2.0 if not defined)
+ ! Local variables
character(len=40) :: mdl = "set_coord_linear" ! This subroutine
real :: Rlay_ref, Rlay_range, g_fs
integer :: k, nz
@@ -505,7 +443,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file)
"all interfaces.", units="kg m-3", default=2.0)
call get_param(param_file, mdl, "GFS", g_fs, &
"The reduced gravity at the free surface.", units="m s-2", &
- default=GV%g_Earth)
+ default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m)
! This following sets the target layer densities such that a the
! surface interface has density Rlay_ref and the bottom
@@ -528,10 +466,11 @@ end subroutine set_coord_linear
subroutine set_coord_to_none(Rlay, g_prime, GV, param_file)
real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values
!! (potential density).
- real, dimension(:), intent(out) :: g_prime !< A structure indicating the open file to
- !! parse for model parameter values.
+ real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces,
+ !! in m s-2.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ ! Local variables
real :: g_fs ! Reduced gravity across the free surface, in m s-2.
character(len=40) :: mdl = "set_coord_to_none" ! This subroutine's name.
integer :: k, nz
@@ -541,7 +480,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, param_file)
call get_param(param_file, mdl, "GFS" , g_fs, &
"The reduced gravity at the free surface.", units="m s-2", &
- default=GV%g_Earth)
+ default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m)
g_prime(1) = g_fs
do k=2,nz ; g_prime(k) = 0. ; enddo
@@ -552,18 +491,13 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, param_file)
end subroutine set_coord_to_none
-!> This subroutine writes out a file containing any available data related
+!> Writes out a file containing any available data related
!! to the vertical grid used by the MOM ocean model.
subroutine write_vertgrid_file(GV, param_file, directory)
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
character(len=*), intent(in) :: directory !< The directory into which to place the file.
-! This subroutine writes out a file containing any available data related
-! to the vertical grid used by the MOM ocean model.
-! Arguments: GV - The container for the vertical grid data.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) directory - The directory into which to place the file.
+ ! Local variables
character(len=240) :: filepath
type(vardesc) :: vars(2)
type(fieldtype) :: fields(2)
@@ -582,6 +516,5 @@ subroutine write_vertgrid_file(GV, param_file, directory)
call close_file(unit)
end subroutine write_vertgrid_file
-! -----------------------------------------------------------------------------
end module MOM_coord_initialization
diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90
index 0275bfc205..b754b19bcb 100644
--- a/src/initialization/MOM_fixed_initialization.F90
+++ b/src/initialization/MOM_fixed_initialization.F90
@@ -37,7 +37,6 @@ module MOM_fixed_initialization
use seamount_initialization, only : seamount_initialize_topography
use dumbbell_initialization, only : dumbbell_initialize_topography
use shelfwave_initialization, only : shelfwave_initialize_topography
-use supercritical_initialization, only : supercritical_initialize_topography
use Phillips_initialization, only : Phillips_initialize_topography
use dense_water_initialization, only : dense_water_initialize_topography
@@ -166,7 +165,8 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir)
end subroutine MOM_initialize_fixed
-!> MOM_initialize_topography makes the appropriate call to set up the bathymetry.
+!> MOM_initialize_topography makes the appropriate call to set up the bathymetry. At this
+!! point the topography is in units of m, but this can be changed later.
subroutine MOM_initialize_topography(D, max_depth, G, PF)
type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type
real, dimension(G%isd:G%ied,G%jsd:G%jed), &
@@ -177,7 +177,6 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF)
! This subroutine makes the appropriate call to set up the bottom depth.
! This is a separate subroutine so that it can be made public and shared with
! the ice-sheet code or other components.
-! Set up the bottom depth, G%bathyT either analytically or from file
character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name.
character(len=200) :: config
@@ -204,7 +203,6 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF)
" \t seamount - Gaussian bump for spontaneous motion test case.\n"//&
" \t dumbbell - Sloshing channel with reservoirs on both ends.\n"//&
" \t shelfwave - exponential slope for shelfwave test case.\n"//&
- " \t supercritical - flat but with 8.95 degree land mask.\n"//&
" \t Phillips - ACC-like idealized topography used in the Phillips config.\n"//&
" \t dense - Denmark Strait-like dense water formation and overflow.\n"//&
" \t USER - call a user modified routine.", &
@@ -226,7 +224,6 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF)
case ("seamount"); call seamount_initialize_topography(D, G, PF, max_depth)
case ("dumbbell"); call dumbbell_initialize_topography(D, G, PF, max_depth)
case ("shelfwave"); call shelfwave_initialize_topography(D, G, PF, max_depth)
- case ("supercritical"); call supercritical_initialize_topography(D, G, PF, max_depth)
case ("Phillips"); call Phillips_initialize_topography(D, G, PF, max_depth)
case ("dense"); call dense_water_initialize_topography(D, G, PF, max_depth)
case ("USER"); call user_initialize_topography(D, G, PF, max_depth)
diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90
index 78d2a3fb8c..0f5a8505ab 100644
--- a/src/initialization/MOM_grid_initialize.F90
+++ b/src/initialization/MOM_grid_initialize.F90
@@ -1,54 +1,8 @@
+!> Initializes horizontal grid
module MOM_grid_initialize
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, November 1998 - June 2002 *
-!* *
-!* This program contains 2 externally callable subroutines. *
-!* set_grid_metrics calculates the various metric terms that are used *
-!* by MOM. This routine is intended to be modified by the user to *
-!* enable the use of any general orthogonal grid. initialize_masks *
-!* initializes the land masks; it is in this file because it a key *
-!* part of the physical grid description. *
-!* *
-!* This subroutine is also used by MOM-related preprocessing and *
-!* postprocessing codes. *
-!* *
-!* The metric terms have the form Dzp, IDzp, or DXDYp, where z can *
-!* be X or Y, and p can be q, u, v, or h. z describes the direction *
-!* of the metric, while p describes the location. IDzp is the *
-!* inverse of Dzp, while DXDYp is the product of DXp and DYp except *
-!* that areaT is calculated analytically from the latitudes and *
-!* longitudes of the surrounding q points. *
-!* *
-!* On a sphere, a variety of grids can be implemented by defining *
-!* analytic expressions for dx_di, dy_dj (where x and y are latitude *
-!* and longitude, and i and j are grid indices) and the expressions *
-!* for the integrals of their inverses in the four subroutines *
-!* dy_dj, Int_dj_dy, dx_di, and Int_di_dx. *
-!* *
-!* initialize_masks sets up land masks based on the depth field. *
-!* The one argument is the minimum ocean depth. Depths that are *
-!* less than this are interpreted as land points. *
-!* *
-!* Macros written all in capital letters are from MOM_memory.h. *
-!* *
-!* A small fragment of the C-grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q, dxBu, IdxBu, dyBu, IdyBu, etc. *
-!* j+1 > o > o > At ^: v, dxCv, IdxCv, dyCv, IdyCv, etc. *
-!* j x ^ x ^ x At >: u, dxCu, IdxCu, dyCu, IdyCu, etc. *
-!* j > o > o > At o: h, dxT, IdxT, dyT, IdyT, areaT, etc. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_checksums, only : hchksum, Bchksum
use MOM_checksums, only : uvchksum, hchksum_pair, Bchksum_pair
use MOM_domains, only : pass_var, pass_vector, pe_here, root_PE, broadcast
@@ -69,6 +23,7 @@ module MOM_grid_initialize
public set_grid_metrics, initialize_masks, Adcroft_reciprocal
+!> Global positioning system (aka container for information to describe the grid)
type, public :: GPS ; private
real :: len_lon !< The longitudinal or x-direction length of the domain.
real :: len_lat !< The latitudinal or y-direction length of the domain.
@@ -95,24 +50,13 @@ module MOM_grid_initialize
contains
-
!> set_grid_metrics is used to set the primary values in the model's horizontal
-!! grid. The bathymetry, land-sea mask and any restricted channel widths are
-!! not known yet, so these are set later.
+!! grid. The bathymetry, land-sea mask and any restricted channel widths are
+!! not known yet, so these are set later.
subroutine set_grid_metrics(G, param_file)
type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type
type(param_file_type), intent(in) :: param_file !< Parameter file structure
-! Arguments:
-! (inout) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
-! Calculate the values of the metric terms that might be used
-! and save them in arrays.
-! Within this subroutine, the x- and y- grid spacings and their
-! inverses and the cell areas centered on h, q, u, and v points are
-! calculated, as are the geographic locations of each of these 4
-! sets of points.
+ ! Local variables
! This include declares and sets the variable "version".
#include "version_variable.h"
logical :: debug
@@ -147,7 +91,7 @@ subroutine set_grid_metrics(G, param_file)
"Unrecognized grid configuration "//trim(config))
end select
-! Calculate derived metrics (i.e. reciprocals and products)
+ ! Calculate derived metrics (i.e. reciprocals and products)
call callTree_enter("set_derived_metrics(), MOM_grid_initialize.F90")
call set_derived_dyn_horgrid(G)
call callTree_leave("set_derived_metrics()")
@@ -160,7 +104,7 @@ end subroutine set_grid_metrics
! ------------------------------------------------------------------------------
!> grid_metrics_chksum performs a set of checksums on metrics on the grid for
-!! debugging.
+!! debugging.
subroutine grid_metrics_chksum(parent, G)
character(len=*), intent(in) :: parent !< A string identifying the caller
type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type
@@ -214,17 +158,11 @@ end subroutine grid_metrics_chksum
! ------------------------------------------------------------------------------
-!> set_grid_metrics_from_mosaic sets the grid metrics from a mosaic file.
+!> Sets the grid metrics from a mosaic file.
subroutine set_grid_metrics_from_mosaic(G, param_file)
type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type
type(param_file_type), intent(in) :: param_file !< Parameter file structure
-! This subroutine sets the grid metrics from a mosaic file.
-!
-! Arguments:
-! (inout) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
+ ! Local variables
real, dimension(G%isd :G%ied ,G%jsd :G%jed ) :: tempH1, tempH2, tempH3, tempH4
real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: tempQ1, tempQ2, tempQ3, tempQ4
real, dimension(G%IsdB:G%IedB,G%jsd :G%jed ) :: tempE1, tempE2
@@ -245,6 +183,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file)
character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic"
integer :: err=0, ni, nj, global_indices(4)
type(MOM_domain_type) :: SGdom ! Supergrid domain
+ logical :: lon_bug ! If true use an older buggy answer in the tripolar longitude.
integer :: i, j, i2, j2
integer :: npei,npej
integer, dimension(:), allocatable :: exni,exnj
@@ -255,6 +194,10 @@ subroutine set_grid_metrics_from_mosaic(G, param_file)
call get_param(param_file, mdl, "GRID_FILE", grid_file, &
"Name of the file from which to read horizontal grid data.", &
fail_if_missing=.true.)
+ call get_param(param_file, mdl, "USE_TRIPOLAR_GEOLONB_BUG", lon_bug, &
+ "If true, use older code that incorrectly sets the longitude \n"//&
+ "in some points along the tripolar fold to be off by 360 degrees.", &
+ default=.true.)
call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
inputdir = slasher(inputdir)
filename = trim(adjustl(inputdir)) // trim(adjustl(grid_file))
@@ -263,16 +206,16 @@ subroutine set_grid_metrics_from_mosaic(G, param_file)
call MOM_error(FATAL," set_grid_metrics_from_mosaic: Unable to open "//&
trim(filename))
-! Initialize everything to 0.
+ ! Initialize everything to 0.
dxCu(:,:) = 0.0 ; dyCu(:,:) = 0.0
dxCv(:,:) = 0.0 ; dyCv(:,:) = 0.0
dxBu(:,:) = 0.0 ; dyBu(:,:) = 0.0 ; areaBu(:,:) = 0.0
-!
+ !
ni = 2*(G%iec-G%isc+1) ! i size of supergrid
nj = 2*(G%jec-G%jsc+1) ! j size of supergrid
-! Define a domain for the supergrid (SGdom)
+ ! Define a domain for the supergrid (SGdom)
npei = G%domain%layout(1) ; npej = G%domain%layout(2)
allocate(exni(npei)) ; allocate(exnj(npej))
call mpp_get_domain_extents(G%domain%mpp_domain, exni, exnj)
@@ -282,7 +225,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file)
SGdom%niglobal = 2*G%domain%niglobal
SGdom%njglobal = 2*G%domain%njglobal
SGdom%layout(:) = G%domain%layout(:)
- SGdom%use_io_layout = G%domain%use_io_layout
SGdom%io_layout(:) = G%domain%io_layout(:)
global_indices(1) = 1+SGdom%nihalo
global_indices(2) = SGdom%niglobal+SGdom%nihalo
@@ -303,16 +245,19 @@ subroutine set_grid_metrics_from_mosaic(G, param_file)
symmetry=.true., name="MOM_MOSAIC")
endif
- if (SGdom%use_io_layout) &
- call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout)
+ call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout)
deallocate(exni)
deallocate(exnj)
-! Read X from the supergrid
+ ! Read X from the supergrid
tmpZ(:,:) = 999.
call MOM_read_data(filename, 'x', tmpZ, SGdom, position=CORNER)
- call pass_var(tmpZ, SGdom, position=CORNER)
+ if (lon_bug) then
+ call pass_var(tmpZ, SGdom, position=CORNER)
+ else
+ call pass_var(tmpZ, SGdom, position=CORNER, inner_halo=0)
+ endif
call extrapolate_metric(tmpZ, 2*(G%jsc-G%jsd)+2, missing=999.)
do j=G%jsd,G%jed ; do i=G%isd,G%ied ; i2 = 2*i ; j2 = 2*j
G%geoLonT(i,j) = tmpZ(i2-1,j2-1)
@@ -326,10 +271,10 @@ subroutine set_grid_metrics_from_mosaic(G, param_file)
do J=G%JsdB,G%JedB ; do i=G%isd,G%ied ; i2 = 2*i ; j2 = 2*J
G%geoLonCv(i,J) = tmpZ(i2-1,j2)
enddo ; enddo
- ! For some reason, this messes up the solution...
- ! call pass_var(G%geoLonBu, G%domain, position=CORNER)
+ ! For some reason, this messes up the solution...
+ ! call pass_var(G%geoLonBu, G%domain, position=CORNER)
-! Read Y from the supergrid
+ ! Read Y from the supergrid
tmpZ(:,:) = 999.
call MOM_read_data(filename, 'y', tmpZ, SGdom, position=CORNER)
@@ -348,7 +293,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file)
G%geoLatCv(i,J) = tmpZ(i2-1,j2)
enddo ; enddo
-! Read DX,DY from the supergrid
+ ! Read DX,DY from the supergrid
tmpU(:,:) = 0. ; tmpV(:,:) = 0.
call MOM_read_data(filename,'dx',tmpV,SGdom,position=NORTH_FACE)
call MOM_read_data(filename,'dy',tmpU,SGdom,position=EAST_FACE)
@@ -376,7 +321,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file)
dyBu(I,J) = tmpU(i2,j2) + tmpU(i2,j2+1)
enddo ; enddo
-! Read AREA from the supergrid
+ ! Read AREA from the supergrid
tmpT(:,:) = 0.
call MOM_read_data(filename, 'area', tmpT, SGdom)
call pass_var(tmpT, SGdom)
@@ -456,21 +401,17 @@ end subroutine set_grid_metrics_from_mosaic
! ------------------------------------------------------------------------------
+!> Calculate the values of the metric terms for a Cartesian grid that
+!! might be used and save them in arrays.
+!!
+!! Within this subroutine, the x- and y- grid spacings and their
+!! inverses and the cell areas centered on h, q, u, and v points are
+!! calculated, as are the geographic locations of each of these 4
+!! sets of points.
subroutine set_grid_metrics_cartesian(G, param_file)
type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type
type(param_file_type), intent(in) :: param_file !< Parameter file structure
-
-! Arguments:
-! (inout) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
-! Calculate the values of the metric terms for a Cartesian grid that
-! might be used and save them in arrays.
-! Within this subroutine, the x- and y- grid spacings and their
-! inverses and the cell areas centered on h, q, u, and v points are
-! calculated, as are the geographic locations of each of these 4
-! sets of points.
+ ! Local variables
integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off
integer :: niglobal, njglobal
real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB)
@@ -593,21 +534,17 @@ end subroutine set_grid_metrics_cartesian
! ------------------------------------------------------------------------------
+!> Calculate the values of the metric terms that might be used
+!! and save them in arrays.
+!!
+!! Within this subroutine, the x- and y- grid spacings and their
+!! inverses and the cell areas centered on h, q, u, and v points are
+!! calculated, as are the geographic locations of each of these 4
+!! sets of points.
subroutine set_grid_metrics_spherical(G, param_file)
type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type
type(param_file_type), intent(in) :: param_file !< Parameter file structure
-
-! Arguments:
-! (inout) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
-! Calculate the values of the metric terms that might be used
-! and save them in arrays.
-! Within this subroutine, the x- and y- grid spacings and their
-! inverses and the cell areas centered on h, q, u, and v points are
-! calculated, as are the geographic locations of each of these 4
-! sets of points.
+ ! Local variables
real :: PI, PI_180! PI = 3.1415926... as 4*atan(1)
integer :: i, j, isd, ied, jsd, jed
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB
@@ -684,8 +621,8 @@ subroutine set_grid_metrics_spherical(G, param_file)
G%geoLonBu(I,J) = grid_lonB(I)
G%geoLatBu(I,J) = grid_latB(J)
-! The following line is needed to reproduce the solution from
-! set_grid_metrics_mercator when used to generate a simple spherical grid.
+ ! The following line is needed to reproduce the solution from
+ ! set_grid_metrics_mercator when used to generate a simple spherical grid.
G%dxBu(I,J) = G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di
! G%dxBu(I,J) = G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 )
G%dyBu(I,J) = G%Rad_Earth * dLat*PI_180
@@ -696,8 +633,8 @@ subroutine set_grid_metrics_spherical(G, param_file)
G%geoLonCv(i,J) = grid_LonT(i)
G%geoLatCv(i,J) = grid_latB(J)
-! The following line is needed to reproduce the solution from
-! set_grid_metrics_mercator when used to generate a simple spherical grid.
+ ! The following line is needed to reproduce the solution from
+ ! set_grid_metrics_mercator when used to generate a simple spherical grid.
G%dxCv(i,J) = G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di
! G%dxCv(i,J) = G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 )
G%dyCv(i,J) = G%Rad_Earth * dLat*PI_180
@@ -707,8 +644,8 @@ subroutine set_grid_metrics_spherical(G, param_file)
G%geoLonCu(I,j) = grid_lonB(I)
G%geoLatCu(I,j) = grid_LatT(j)
-! The following line is needed to reproduce the solution from
-! set_grid_metrics_mercator when used to generate a simple spherical grid.
+ ! The following line is needed to reproduce the solution from
+ ! set_grid_metrics_mercator when used to generate a simple spherical grid.
G%dxCu(I,j) = G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di
! G%dxCu(I,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude )
G%dyCu(I,j) = G%Rad_Earth * dLat*PI_180
@@ -718,8 +655,8 @@ subroutine set_grid_metrics_spherical(G, param_file)
G%geoLonT(i,j) = grid_LonT(i)
G%geoLatT(i,j) = grid_LatT(j)
-! The following line is needed to reproduce the solution from
-! set_grid_metrics_mercator when used to generate a simple spherical grid.
+ ! The following line is needed to reproduce the solution from
+ ! set_grid_metrics_mercator when used to generate a simple spherical grid.
G%dxT(i,j) = G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di
! G%dxT(i,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude )
G%dyT(i,j) = G%Rad_Earth * dLat*PI_180
@@ -733,36 +670,23 @@ subroutine set_grid_metrics_spherical(G, param_file)
call callTree_leave("set_grid_metrics_spherical()")
end subroutine set_grid_metrics_spherical
-! ------------------------------------------------------------------------------
-
+!> Calculate the values of the metric terms that might be used
+!! and save them in arrays.
+!!
+!! Within this subroutine, the x- and y- grid spacings and their
+!! inverses and the cell areas centered on h, q, u, and v points are
+!! calculated, as are the geographic locations of each of these 4
+!! sets of points.
subroutine set_grid_metrics_mercator(G, param_file)
type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type
type(param_file_type), intent(in) :: param_file !< Parameter file structure
-
-! Arguments:
-! (inout) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
-! Calculate the values of the metric terms that might be used
-! and save them in arrays.
-! Within this subroutine, the x- and y- grid spacings and their
-! inverses and the cell areas centered on h, q, u, and v points are
-! calculated, as are the geographic locations of each of these 4
-! sets of points.
+ ! Local variables
integer :: i, j, isd, ied, jsd, jed
integer :: I_off, J_off
type(GPS) :: GP
character(len=128) :: warnmesg
character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_mercator"
real :: PI, PI_2! PI = 3.1415926... as 4*atan(1), PI_2 = (PI) /2.0
-
-
-! All of the metric terms should be defined over the domain from
-! isd to ied. Outside of the physical domain, both the metrics
-! and their inverses may be set to zero.
-
-! The metric terms within the computational domain are set here.
real :: y_q, y_h, jd, x_q, x_h, id
real, dimension(G%isd:G%ied,G%jsd:G%jed) :: &
xh, yh ! Latitude and longitude of h points in radians.
@@ -779,6 +703,9 @@ subroutine set_grid_metrics_mercator(G, param_file)
logical :: debug = .FALSE., simple_area = .true.
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB
+ ! All of the metric terms should be defined over the domain from
+ ! isd to ied. Outside of the physical domain, both the metrics
+ ! and their inverses may be set to zero.
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
@@ -790,8 +717,8 @@ subroutine set_grid_metrics_mercator(G, param_file)
call callTree_enter("set_grid_metrics_mercator(), MOM_grid_initialize.F90")
-! Calculate the values of the metric terms that might be used
-! and save them in arrays.
+ ! Calculate the values of the metric terms that might be used
+ ! and save them in arrays.
PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI
call get_param(param_file, mdl, "SOUTHLAT", GP%south_lat, &
@@ -833,19 +760,19 @@ subroutine set_grid_metrics_mercator(G, param_file)
"over which the resolution is enhanced.", units="degrees", &
default=0.0)
-! With an isotropic grid, the north-south extent of the domain,
-! the east-west extent, and the number of grid points in each
-! direction are _not_ independent. Here the north-south extent
-! will be determined to fit the east-west extent and the number of
-! grid points. The grid is perfectly isotropic.
+ ! With an isotropic grid, the north-south extent of the domain,
+ ! the east-west extent, and the number of grid points in each
+ ! direction are _not_ independent. Here the north-south extent
+ ! will be determined to fit the east-west extent and the number of
+ ! grid points. The grid is perfectly isotropic.
if (GP%equator_reference) then
-! With the following expression, the equator will always be placed
-! on either h or q points, in a position consistent with the ratio
-! GP%south_lat to GP%len_lat.
+ ! With the following expression, the equator will always be placed
+ ! on either h or q points, in a position consistent with the ratio
+ ! GP%south_lat to GP%len_lat.
jRef = (G%jsg-1) + 0.5*FLOOR(GP%njglobal*((-1.0*GP%south_lat*2.0)/GP%len_lat)+0.5)
fnRef = Int_dj_dy(0.0, GP)
else
-! The following line sets the reference latitude GP%south_lat at j=js-1 (or -2?)
+ ! The following line sets the reference latitude GP%south_lat at j=js-1 (or -2?)
jRef = (G%jsg-1)
fnRef = Int_dj_dy((GP%south_lat*PI/180.0), GP)
endif
@@ -884,9 +811,9 @@ subroutine set_grid_metrics_mercator(G, param_file)
endif
enddo
-! Determine the longitudes of the various points.
+ ! Determine the longitudes of the various points.
-! These two lines place the western edge of the domain at GP%west_lon.
+ ! These two lines place the western edge of the domain at GP%west_lon.
iRef = (G%isg-1) + GP%niglobal
fnRef = Int_di_dx(((GP%west_lon+GP%len_lon)*PI/180.0), GP)
@@ -983,13 +910,12 @@ function ds_di(x, y, GP)
real, intent(in) :: y !< The latitude in question
type(GPS), intent(in) :: GP !< A structure of grid parameters
real :: ds_di
-! This function returns the grid spacing in the logical x direction.
-! Arguments: x - The latitude in question.
-! (in) y - The longitude in question.
+ ! Local variables
+
ds_di = GP%Rad_Earth * cos(y) * dx_di(x,GP)
-! In general, this might be...
-! ds_di = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_di(x,y,GP)*dx_di(x,y,GP) + &
-! dy_di(x,y,GP)*dy_di(x,y,GP))
+ ! In general, this might be...
+ ! ds_di = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_di(x,y,GP)*dx_di(x,y,GP) + &
+ ! dy_di(x,y,GP)*dy_di(x,y,GP))
end function ds_di
!> This function returns the grid spacing in the logical y direction.
@@ -997,17 +923,15 @@ function ds_dj(x, y, GP)
real, intent(in) :: x !< The longitude in question
real, intent(in) :: y !< The latitude in question
type(GPS), intent(in) :: GP !< A structure of grid parameters
+ ! Local variables
real :: ds_dj
-! This function returns the grid spacing in the logical y direction.
-! Arguments: x - The latitude in question.
-! (in) y - The longitude in question.
+
ds_dj = GP%Rad_Earth * dy_dj(y,GP)
-! In general, this might be...
-! ds_dj = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_dj(x,y,GP)*dx_dj(x,y,GP) + &
-! dy_dj(x,y,GP)*dy_dj(x,y,GP))
+ ! In general, this might be...
+ ! ds_dj = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_dj(x,y,GP)*dx_dj(x,y,GP) + &
+ ! dy_dj(x,y,GP)*dy_dj(x,y,GP))
end function ds_dj
-
!> This function returns the contribution from the line integral along one of the four sides of a
!! cell face to the area of a cell, assuming that the sides follow a linear path in latitude and
!! longitude (i.e., on a Mercator grid).
@@ -1016,14 +940,8 @@ function dL(x1, x2, y1, y2)
real, intent(in) :: x2 !< Segment ending longitude, in degrees E.
real, intent(in) :: y1 !< Segment ending latitude, in degrees N.
real, intent(in) :: y2 !< Segment ending latitude, in degrees N.
+ ! Local variables
real :: dL
-! This subroutine calculates the contribution from the line integral along one
-! of the four sides of a cell face to the area of a cell, assuming that the
-! sides follow a linear path in latitude and longitude (i.e., on a Mercator grid).
-! Argumnts: x1 - Segment starting longitude.
-! (in) x2 - Segment ending longitude.
-! (in) y1 - Segment ending latitude.
-! (in) y2 - Segment ending latitude.
real :: r, dy
dy = y2 - y1
@@ -1050,11 +968,7 @@ function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax)
real, intent(in) :: ymin !< The minimum permitted value of y
real, intent(in) :: ymax !< The maximum permitted value of y
integer, intent(out) :: ittmax !< The number of iterations used to polish the root
-
-! This subroutine finds and returns the value of y at which the
-! monotonically increasing function fn takes the value fnval, also returning
-! in ittmax the number of iterations of Newton's method that were
-! used to polish the root.
+ ! Local variables
real :: y, y_next
real :: ybot, ytop, fnbot, fntop
integer :: itt
@@ -1160,8 +1074,6 @@ function dx_di(x, GP)
real, intent(in) :: x !< The longitude in question
type(GPS), intent(in) :: GP !< A structure of grid parameters
real :: dx_di
-! This subroutine calculates and returns the value of dx/di, where
-! x is the longitude in Radians, and i is the integral north-south grid index.
dx_di = (GP%len_lon * 4.0*atan(1.0)) / (180.0 * GP%niglobal)
@@ -1173,8 +1085,6 @@ function Int_di_dx(x, GP)
real, intent(in) :: x !< The longitude in question
type(GPS), intent(in) :: GP !< A structure of grid parameters
real :: Int_di_dx
-! This subroutine calculates and returns the integral of the inverse
-! of dx/di to the point x, in radians.
Int_di_dx = x * ((180.0 * GP%niglobal) / (GP%len_lon * 4.0*atan(1.0)))
@@ -1186,9 +1096,7 @@ function dy_dj(y, GP)
real, intent(in) :: y !< The latitude in question
type(GPS), intent(in) :: GP !< A structure of grid parameters
real :: dy_dj
-! This subroutine calculates and returns the value of dy/dj, where
-! y is the latitude in Radians, and j is the integral north-south
-! grid index.
+ ! Local variables
real :: PI ! 3.1415926... calculated as 4*atan(1)
real :: C0 ! The constant that converts the nominal y-spacing in
! gridpoints to the nominal spacing in Radians.
@@ -1217,8 +1125,7 @@ function Int_dj_dy(y, GP)
real, intent(in) :: y !< The latitude in question
type(GPS), intent(in) :: GP !< A structure of grid parameters
real :: Int_dj_dy
-! This subroutine calculates and returns the integral of the inverse
-! of dy/dj to the point y, in radians.
+ ! Local variables
real :: I_C0 = 0.0 ! The inverse of the constant that converts the
! nominal spacing in gridpoints to the nominal
! spacing in Radians.
@@ -1256,13 +1163,12 @@ function Int_dj_dy(y, GP)
Int_dj_dy = r
end function Int_dj_dy
-! ------------------------------------------------------------------------------
-
-!> extrapolate_metric extrapolates missing metric data into all the halo regions.
+!> Extrapolates missing metric data into all the halo regions.
subroutine extrapolate_metric(var, jh, missing)
real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos
integer, intent(in) :: jh !< The size of the halos to be filled
real, optional, intent(in) :: missing !< The missing data fill value, 0 by default.
+ ! Local variables
real :: badval
integer :: i,j
@@ -1300,20 +1206,20 @@ function Adcroft_reciprocal(val) result(I_val)
if (val /= 0.0) I_val = 1.0/val
end function Adcroft_reciprocal
-!> initialize_masks initializes the grid masks and any metrics that come
-!! with masks already applied.
+!> Initializes the grid masks and any metrics that come with masks already applied.
+!!
+!! Initialize_masks sets mask2dT, mask2dCu, mask2dCv, and mask2dBu to mask out
+!! flow over any points which are shallower than Dmin and permit an
+!! appropriate treatment of the boundary conditions. mask2dCu and mask2dCv
+!! are 0.0 at any points adjacent to a land point. mask2dBu is 0.0 at
+!! any land or boundary point. For points in the interior, mask2dCu,
+!! mask2dCv, and mask2dBu are all 1.0.
subroutine initialize_masks(G, PF)
type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type
type(param_file_type), intent(in) :: PF !< Parameter file structure
-
-! Initialize_masks sets mask2dT, mask2dCu, mask2dCv, and mask2dBu to mask out
-! flow over any points which are shallower than Dmin and permit an
-! appropriate treatment of the boundary conditions. mask2dCu and mask2dCv
-! are 0.0 at any points adjacent to a land point. mask2dBu is 0.0 at
-! any land or boundary point. For points in the interior, mask2dCu,
-! mask2dCv, and mask2dBu are all 1.0.
-
- real :: Dmin, min_depth, mask_depth
+ ! Local variables
+ real :: Dmin ! The depth for masking in the same units as G%bathyT (Z).
+ real :: min_depth, mask_depth ! Depths in the same units as G%bathyT (Z).
character(len=40) :: mdl = "MOM_grid_init initialize_masks"
integer :: i, j
@@ -1323,11 +1229,11 @@ subroutine initialize_masks(G, PF)
"MINIMUM_DEPTH is assumed to be land and all fluxes are masked out.\n"//&
"If MASKING_DEPTH is specified, then all depths shallower than\n"//&
"MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", &
- units="m", default=0.0)
+ units="m", default=0.0, scale=1.0/G%Zd_to_m)
call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, &
"The depth below which to mask points as land points, for which all\n"//&
"fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", &
- units="m", default=-9999.0)
+ units="m", default=-9999.0, scale=1.0/G%Zd_to_m)
Dmin = min_depth
if (mask_depth>=0.) Dmin = mask_depth
@@ -1386,4 +1292,23 @@ subroutine initialize_masks(G, PF)
call callTree_leave("initialize_masks()")
end subroutine initialize_masks
+!> \namespace mom_grid_initialize
+!!
+!! The metric terms have the form Dzp, IDzp, or DXDYp, where z can
+!! be X or Y, and p can be q, u, v, or h. z describes the direction
+!! of the metric, while p describes the location. IDzp is the
+!! inverse of Dzp, while DXDYp is the product of DXp and DYp except
+!! that areaT is calculated analytically from the latitudes and
+!! longitudes of the surrounding q points.
+!!
+!! On a sphere, a variety of grids can be implemented by defining
+!! analytic expressions for dx_di, dy_dj (where x and y are latitude
+!! and longitude, and i and j are grid indices) and the expressions
+!! for the integrals of their inverses in the four subroutines
+!! dy_dj, Int_dj_dy, dx_di, and Int_di_dx.
+!!
+!! initialize_masks sets up land masks based on the depth field.
+!! The one argument is the minimum ocean depth. Depths that are
+!! less than this are interpreted as land points.
+
end module MOM_grid_initialize
diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90
index e818c33acd..31dfc551b5 100644
--- a/src/initialization/MOM_shared_initialization.F90
+++ b/src/initialization/MOM_shared_initialization.F90
@@ -525,25 +525,71 @@ subroutine initialize_grid_rotation_angle(G, PF)
!! to parse for model parameter values.
real :: angle, lon_scale
- integer :: i, j
+ real :: len_lon ! The periodic range of longitudes, usually 360 degrees.
+ real :: pi_720deg ! One quarter the conversion factor from degrees to radians.
+ real :: lonB(2,2) ! The longitude of a point, shifted to have about the same value.
+ character(len=40) :: mdl = "initialize_grid_rotation_angle" ! This subroutine's name.
+ logical :: use_bugs
+ integer :: i, j, m, n
+
+ call get_param(PF, mdl, "GRID_ROTATION_ANGLE_BUGS", use_bugs, &
+ "If true, use an older algorithm to calculate the sine and \n"//&
+ "cosines needed rotate between grid-oriented directions and \n"//&
+ "true north and east. Differences arise at the tripolar fold.", &
+ default=.True.)
+
+ if (use_bugs) then
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + &
+ G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180)
+ angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - &
+ G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, &
+ G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - &
+ G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) )
+ G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean
+ G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north)
+ enddo ; enddo
- do j=G%jsc,G%jec ; do i=G%isc,G%iec
- lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + &
- G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180)
- angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - &
- G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, &
- G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - &
- G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) )
- G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean
- G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north)
- enddo ; enddo
+ ! This is not right at a tripolar or cubed-sphere fold.
+ call pass_var(G%cos_rot, G%Domain)
+ call pass_var(G%sin_rot, G%Domain)
+ else
+ pi_720deg = atan(1.0) / 180.0
+ len_lon = 360.0 ; if (G%len_lon > 0.0) len_lon = G%len_lon
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ do n=1,2 ; do m=1,2
+ lonB(m,n) = modulo_around_point(G%geoLonBu(I+m-2,J+n-2), G%geoLonT(i,j), len_lon)
+ enddo ; enddo
+ lon_scale = cos(pi_720deg*((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J)) + &
+ (G%geoLatBu(I,J-1) + G%geoLatBu(I-1,J)) ) )
+ angle = atan2(lon_scale*((lonB(1,2) - lonB(2,1)) + (lonB(2,2) - lonB(1,1))), &
+ (G%geoLatBu(I-1,J) - G%geoLatBu(I,J-1)) + &
+ (G%geoLatBu(I,J) - G%geoLatBu(I-1,J-1)) )
+ G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean
+ G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north)
+ enddo ; enddo
- ! ### THIS DOESN'T SEEM RIGHT AT A CUBED-SPHERE FOLD -RWH
- call pass_var(G%cos_rot, G%Domain)
- call pass_var(G%sin_rot, G%Domain)
+ call pass_vector(G%cos_rot, G%sin_rot, G%Domain, stagger=AGRID)
+ endif
end subroutine initialize_grid_rotation_angle
+! -----------------------------------------------------------------------------
+!> Return the modulo value of x in an interval [xc-(Lx/2) xc+(Lx/2)]
+!! If Lx<=0, then it returns x without applying modulo arithmetic.
+function modulo_around_point(x, xc, Lx) result(x_mod)
+ real, intent(in) :: x !< Value to which to apply modulo arithmetic
+ real, intent(in) :: xc !< Center of modulo range
+ real, intent(in) :: Lx !< Modulo range width
+ real :: x_mod !< x shifted by an integer multiple of Lx to be close to xc.
+
+ if (Lx > 0.0) then
+ x_mod = modulo(x - (xc - 0.5*Lx), Lx) + (xc - 0.5*Lx)
+ else
+ x_mod = x
+ endif
+end function modulo_around_point
+
! -----------------------------------------------------------------------------
!> This subroutine sets the open face lengths at selected points to restrict
!! passages to their observed widths based on a named set of sizes.
@@ -762,6 +808,8 @@ subroutine reset_face_lengths_list(G, param_file)
real, pointer, dimension(:) :: &
u_width => NULL(), v_width => NULL()
real :: lat, lon ! The latitude and longitude of a point.
+ real :: len_lon ! The periodic range of longitudes, usually 360 degrees.
+ real :: len_lat ! The range of latitudes, usually 180 degrees.
real :: lon_p, lon_m ! The longitude of a point shifted by 360 degrees.
logical :: check_360 ! If true, check for longitudes that are shifted by
! +/- 360 degrees from the specified range of values.
@@ -808,6 +856,8 @@ subroutine reset_face_lengths_list(G, param_file)
call read_face_length_list(iounit, filename, num_lines, lines)
endif
+ len_lon = 360.0 ; if (G%len_lon > 0.0) len_lon = G%len_lon
+ len_lat = 180.0 ; if (G%len_lat > 0.0) len_lat = G%len_lat
! Broadcast the number of lines and allocate the required space.
call broadcast(num_lines, root_PE())
u_pt = 0 ; v_pt = 0
@@ -849,11 +899,11 @@ subroutine reset_face_lengths_list(G, param_file)
read(line(isu+8:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt)
if (is_root_PE()) then
if (check_360) then
- if ((abs(u_lon(1,u_pt)) > 360.0) .or. (abs(u_lon(2,u_pt)) > 360.0)) &
+ if ((abs(u_lon(1,u_pt)) > len_lon) .or. (abs(u_lon(2,u_pt)) > len_lon)) &
call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//&
"u-longitude found when reading line "//trim(line)//" from file "//&
trim(filename))
- if ((abs(u_lat(1,u_pt)) > 180.0) .or. (abs(u_lat(2,u_pt)) > 180.0)) &
+ if ((abs(u_lat(1,u_pt)) > len_lat) .or. (abs(u_lat(2,u_pt)) > len_lat)) &
call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//&
"u-latitude found when reading line "//trim(line)//" from file "//&
trim(filename))
@@ -876,11 +926,11 @@ subroutine reset_face_lengths_list(G, param_file)
read(line(isv+8:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt)
if (is_root_PE()) then
if (check_360) then
- if ((abs(v_lon(1,v_pt)) > 360.0) .or. (abs(v_lon(2,v_pt)) > 360.0)) &
+ if ((abs(v_lon(1,v_pt)) > len_lon) .or. (abs(v_lon(2,v_pt)) > len_lon)) &
call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//&
"v-longitude found when reading line "//trim(line)//" from file "//&
trim(filename))
- if ((abs(v_lat(1,v_pt)) > 180.0) .or. (abs(v_lat(2,v_pt)) > 180.0)) &
+ if ((abs(v_lat(1,v_pt)) > len_lat) .or. (abs(v_lat(2,v_pt)) > len_lat)) &
call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//&
"v-latitude found when reading line "//trim(line)//" from file "//&
trim(filename))
@@ -906,7 +956,7 @@ subroutine reset_face_lengths_list(G, param_file)
do j=jsd,jed ; do I=IsdB,IedB
lat = G%geoLatCu(I,j) ; lon = G%geoLonCu(I,j)
- if (check_360) then ; lon_p = lon+360.0 ; lon_m = lon-360.0
+ if (check_360) then ; lon_p = lon+len_lon ; lon_m = lon-len_lon
else ; lon_p = lon ; lon_m = lon ; endif
do npt=1,u_pt
@@ -936,7 +986,7 @@ subroutine reset_face_lengths_list(G, param_file)
do J=JsdB,JedB ; do i=isd,ied
lat = G%geoLatCv(i,J) ; lon = G%geoLonCv(i,J)
- if (check_360) then ; lon_p = lon+360.0 ; lon_m = lon-360.0
+ if (check_360) then ; lon_p = lon+len_lon ; lon_m = lon-len_lon
else ; lon_p = lon ; lon_m = lon ; endif
do npt=1,v_pt
@@ -1099,12 +1149,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file)
character(len=*), intent(in) :: directory !< The directory into which to place the geometry file.
character(len=*), optional, intent(in) :: geom_file !< If present, the name of the geometry file
!! (otherwise the file is "ocean_geometry")
-! This subroutine writes out a file containing all of the ocean geometry
-! and grid data uses by the MOM ocean model.
-! Arguments: G - The ocean's grid structure. Effectively intent in.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) directory - The directory into which to place the file.
+
+ ! Local variables.
character(len=240) :: filepath
character(len=40) :: mdl = "write_ocean_geometry_file"
integer, parameter :: nFlds=23
@@ -1194,7 +1240,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file)
call write_field(unit, fields(3), G%Domain%mpp_domain, G%geoLatT)
call write_field(unit, fields(4), G%Domain%mpp_domain, G%geoLonT)
- call write_field(unit, fields(5), G%Domain%mpp_domain, G%bathyT)
+ do j=js,je ; do i=is,ie ; out_h(i,j) = G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo
+ call write_field(unit, fields(5), G%Domain%mpp_domain, out_h)
call write_field(unit, fields(6), G%Domain%mpp_domain, G%CoriolisBu)
! I think that all of these copies are holdovers from a much earlier
diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90
index 491c806a6b..b19e6fc518 100644
--- a/src/initialization/MOM_state_initialization.F90
+++ b/src/initialization/MOM_state_initialization.F90
@@ -1,4 +1,4 @@
-!> Initialize state variables, u, v, h, T and S.
+!> Initialization functions for state variables, u, v, h, T and S.
module MOM_state_initialization
! This file is part of MOM6. See LICENSE.md for the license.
@@ -34,7 +34,7 @@ module MOM_state_initialization
use MOM_ALE_sponge, only : set_up_ALE_sponge_field, initialize_ALE_sponge
use MOM_ALE_sponge, only : ALE_sponge_CS
use MOM_string_functions, only : uppercase, lowercase
-use MOM_time_manager, only : time_type, set_time
+use MOM_time_manager, only : time_type
use MOM_tracer_registry, only : tracer_registry_type
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : setVerticalGridAxes, verticalGrid_type
@@ -106,11 +106,10 @@ module MOM_state_initialization
public MOM_initialize_state
-character(len=40) :: mdl = "MOM_state_initialization" ! This module's name.
+character(len=40) :: mdl = "MOM_state_initialization" !< This module's name.
contains
-! -----------------------------------------------------------------------------
!> Initialize temporally evolving fields, either as initial
!! conditions or by reading them from a restart (or saves) file.
subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
@@ -136,19 +135,21 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
!! directory paths.
type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control
!! structure.
- type(ALE_CS), pointer :: ALE_CSp
- type(tracer_registry_type), pointer :: tracer_Reg
- type(sponge_CS), pointer :: sponge_CSp
- type(ALE_sponge_CS), pointer :: ALE_sponge_CSp
- type(ocean_OBC_type), pointer :: OBC
+ type(ALE_CS), pointer :: ALE_CSp !< The ALE control structure for remapping
+ type(tracer_registry_type), pointer :: tracer_Reg !< A pointer to the tracer registry
+ type(sponge_CS), pointer :: sponge_CSp !< The layerwise sponge control structure.
+ type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< The ALE sponge control structure.
+ type(ocean_OBC_type), pointer :: OBC !< The open boundary condition control structure.
type(time_type), optional, intent(in) :: Time_in !< Time at the start of the run segment.
!! Time_in overrides any value set for Time.
-
-! Local variables
+ ! Local variables
character(len=200) :: filename ! The name of an input file.
character(len=200) :: filename2 ! The name of an input files.
character(len=200) :: inputdir ! The directory where NetCDF input files are.
character(len=200) :: config
+ real :: H_rescale ! A rescaling factor for thicknesses from the representation in
+ ! a restart file to the internal representation in this run.
+ real :: dt ! The baroclinic dynamics timestep for this run, in s.
logical :: from_Z_file, useALE
logical :: new_sim
integer :: write_geom
@@ -161,7 +162,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
! by a large surface pressure, such as with an ice sheet.
logical :: regrid_accelerate
integer :: regrid_iterations
- logical :: Analytic_FV_PGF, obsol_test
+! logical :: Analytic_FV_PGF, obsol_test
logical :: convert
logical :: just_read ! If true, only read the parameters because this
! is a run from a restart file; this option
@@ -176,8 +177,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
- real :: dt
-
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
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -202,10 +201,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
use_OBC = associated(OBC)
if (use_EOS) eos => tv%eqn_of_state
-!====================================================================
-! Initialize temporally evolving fields, either as initial
-! conditions or by reading them from a restart (or saves) file.
-!====================================================================
+ !====================================================================
+ ! Initialize temporally evolving fields, either as initial
+ ! conditions or by reading them from a restart (or saves) file.
+ !====================================================================
if (new_sim) then
call MOM_mesg("Run initialized internally.", 3)
@@ -231,14 +230,14 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
"longitude grid.", default=.false., do_not_log=just_read)
if (from_Z_file) then
-! Initialize thickness and T/S from z-coordinate data in a file.
+ ! Initialize thickness and T/S from z-coordinate data in a file.
if (.NOT.use_temperature) call MOM_error(FATAL,"MOM_initialize_state : "//&
"use_temperature must be true if INIT_LAYERS_FROM_Z_FILE is true")
call MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params=just_read)
else
-! Initialize thickness, h.
+ ! Initialize thickness, h.
call get_param(PF, mdl, "THICKNESS_CONFIG", config, &
"A string that determines how the initial layer \n"//&
"thicknesses are specified for a new run: \n"//&
@@ -319,7 +318,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
"Unrecognized layer thickness configuration "//trim(config))
end select
-! Initialize temperature and salinity (T and S).
+ ! Initialize temperature and salinity (T and S).
if ( use_temperature ) then
call get_param(PF, mdl, "TS_CONFIG", config, &
"A string that determines how the initial tempertures \n"//&
@@ -343,7 +342,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
" \t SCM_CVMix_tests - used in the SCM CVMix tests.\n"//&
" \t USER - call a user modified routine.", &
fail_if_missing=new_sim, do_not_log=just_read)
-! " \t baroclinic_zone - an analytic baroclinic zone. \n"//&
+! " \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, PF, &
eos, tv%P_Ref, just_read_params=just_read)
@@ -390,7 +389,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
! The thicknesses in halo points might be needed to initialize the velocities.
if (new_sim) call pass_var(h, G%Domain)
-! Initialize velocity components, u and v
+ ! Initialize velocity components, u and v
call get_param(PF, mdl, "VELOCITY_CONFIG", config, &
"A string that determines how the initial velocities \n"//&
"are specified for a new run: \n"//&
@@ -428,8 +427,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1)
endif
-! Optionally convert the thicknesses from m to kg m-2. This is particularly
-! useful in a non-Boussinesq model.
+ ! Optionally convert the thicknesses from m to kg m-2. This is particularly
+ ! useful in a non-Boussinesq model.
call get_param(PF, mdl, "CONVERT_THICKNESS_UNITS", convert, &
"If true, convert the thickness initial conditions from \n"//&
"units of m to kg m-2 or vice versa, depending on whether \n"//&
@@ -440,7 +439,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
! Convert thicknesses from geomtric distances to mass-per-unit-area.
call convert_thickness(h, G, GV, tv)
-! Remove the mass that would be displaced by an ice shelf or inverse barometer.
+ ! Remove the mass that would be displaced by an ice shelf or inverse barometer.
call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, &
"If true, depress the initial surface to avoid huge \n"//&
"tsunamis when a large surface pressure is applied.", &
@@ -452,6 +451,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
do_not_log=just_read)
if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//&
"DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True")
+ if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) &
+ call hchksum(h, "Pre-depress: h ", G%HI, haloshift=1, scale=GV%H_to_m)
if (depress_sfc) call depress_surface(h, G, GV, PF, tv, just_read_params=just_read)
if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params=just_read)
@@ -471,6 +472,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
call get_param(PF, mdl, "DT", dt, "Timestep", fail_if_missing=.true.)
+ if (new_sim .and. debug) &
+ call hchksum(h, "Pre-ALE_regrid: h ", G%HI, haloshift=1, scale=GV%H_to_m)
call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, tracer_Reg, &
dt=dt, initial=.true.)
endif
@@ -479,11 +482,15 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
! internally at the start of a new run.
if (.not.new_sim) then ! This block restores the state from a restart file.
- ! This line calls a subroutine that reads the initial conditions !
- ! from a previously generated file. !
+ ! This line calls a subroutine that reads the initial conditions
+ ! from a previously generated file.
call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, &
G, restart_CS)
if (present(Time_in)) Time = Time_in
+ if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then
+ H_rescale = GV%m_to_H / GV%m_to_H_restart
+ do k=1,nz ; do j=js,je ; do i=is,ie ; h(i,j,k) = H_rescale * h(i,j,k) ; enddo ; enddo ; enddo
+ endif
endif
if ( use_temperature ) then
@@ -502,7 +509,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
write(mesg,'("MOM_IS: S[",I2,"]")') k
call hchksum(tv%S(:,:,k), mesg, G%HI, haloshift=1)
enddo ; endif
-
endif
call get_param(PF, mdl, "SPONGE", use_sponge, &
@@ -525,19 +531,17 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
case ("DOME2D"); call DOME2d_initialize_sponges(G, GV, tv, PF, useALE, &
sponge_CSp, ALE_sponge_CSp)
case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, tv, PF, useALE, &
- sponge_CSp, ALE_sponge_CSp)
- case ("USER"); call user_initialize_sponges(G, use_temperature, tv, &
- PF, sponge_CSp, h)
- case ("BFB"); call BFB_initialize_sponges_southonly(G, use_temperature, tv, &
- PF, sponge_CSp, h)
- case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, &
- PF, useALE, sponge_CSp, ALE_sponge_CSp)
- case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, &
- PF, sponge_CSp, h)
+ sponge_CSp, ALE_sponge_CSp)
+ case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h)
+ case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, PF, &
+ sponge_CSp, h)
+ case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, PF, useALE, &
+ sponge_CSp, ALE_sponge_CSp)
+ case ("phillips"); call Phillips_initialize_sponges(G, GV, tv, PF, sponge_CSp, h)
case ("dense"); call dense_water_initialize_sponges(G, GV, tv, PF, useALE, &
- sponge_CSp, ALE_sponge_CSp)
- case ("file"); call initialize_sponges_file(G, GV, use_temperature, tv, &
- PF, sponge_CSp, ALE_sponge_CSp, Time)
+ sponge_CSp, ALE_sponge_CSp)
+ case ("file"); call initialize_sponges_file(G, GV, use_temperature, tv, PF, &
+ sponge_CSp, ALE_sponge_CSp, Time)
case default ; call MOM_error(FATAL, "MOM_initialize_state: "//&
"Unrecognized sponge configuration "//trim(config))
end select
@@ -599,10 +603,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, &
call callTree_leave('MOM_initialize_state()')
end subroutine MOM_initialize_state
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
-!> This subroutine reads the layer thicknesses or interface heights from a file.
+!> Reads the layer thicknesses or interface heights from a file.
subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickness, 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
@@ -616,8 +618,8 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-! This subroutine reads the layer thicknesses from file.
- real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1)
+ ! Local variables
+ real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! Interface heights, in depth units.
integer :: inconsistent = 0
logical :: correct_thickness
logical :: just_read ! If true, just read parameters but set nothing.
@@ -647,10 +649,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne
if (file_has_thickness) then
!### Consider adding a parameter to use to rescale h.
if (just_read) return ! All run-time parameters have been read, so return.
- call MOM_read_data(filename, "h", h(:,:,:), G%Domain)
- do k=1,nz ; do j=js,je ; do i=is,ie
- h(i,j,k) = GV%m_to_H * h(i,j,k)
- enddo ; enddo ; enddo
+ call MOM_read_data(filename, "h", h(:,:,:), G%Domain, scale=GV%m_to_H)
else
call get_param(param_file, mdl, "ADJUST_THICKNESS", correct_thickness, &
"If true, all mass below the bottom removed if the \n"//&
@@ -658,22 +657,22 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne
"would indicate.", default=.false., do_not_log=just_read)
if (just_read) return ! All run-time parameters have been read, so return.
- call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain)
+ call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=GV%m_to_Z)
if (correct_thickness) then
call adjustEtaToFitBathymetry(G, GV, eta, h)
else
do k=nz,1,-1 ; do j=js,je ; do i=is,ie
- if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) then
- eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom
+ if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then
+ eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z
+ h(i,j,k) = GV%Angstrom_H
else
- h(i,j,k) = GV%m_to_H * (eta(i,j,K) - eta(i,j,K+1))
+ h(i,j,k) = GV%Z_to_H * (eta(i,j,K) - eta(i,j,K+1))
endif
enddo ; enddo ; enddo
do j=js,je ; do i=is,ie
- if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0) &
+ if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0*GV%m_to_Z) &
inconsistent = inconsistent + 1
enddo ; enddo
call sum_across_PEs(inconsistent)
@@ -688,31 +687,28 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne
endif
call callTree_leave(trim(mdl)//'()')
end subroutine initialize_thickness_from_file
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
!> Adjust interface heights to fit the bathymetry and diagnose layer thickness.
+!!
!! If the bottom most interface is below the topography then the bottom-most
-!! layers are contracted to GV%Angstrom_z.
+!! layers are contracted to GV%Angstrom_m.
!! If the bottom most interface is above the topography then the entire column
!! is dilated (expanded) to fill the void.
!! @remark{There is a (hard-wired) "tolerance" parameter such that the
!! criteria for adjustment must equal or exceed 10cm.}
-!! @param[in] G Grid type
-!! @param[in,out] eta Interface heights
-!! @param[out] h Layer thicknesses
subroutine adjustEtaToFitBathymetry(G, GV, eta, h)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in m
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in Z
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H
! Local variables
integer :: i, j, k, is, ie, js, je, nz, contractions, dilations
- real, parameter :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m)
+ real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m)
real :: hTmp, eTmp, dilate
character(len=100) :: mesg
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
+ hTolerance = 0.1*GV%m_to_Z
contractions = 0
do j=js,je ; do i=is,ie
@@ -728,14 +724,14 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h)
call MOM_error(WARNING, 'adjustEtaToFitBathymetry: '//mesg)
endif
- ! To preserve previous answers, delay converting thicknesses to units of H
- ! until the end of this routine.
+ ! To preserve previous answers in non-Boussinesq cases, delay converting
+ ! thicknesses to units of H until the end of this routine.
do k=nz,1,-1 ; do j=js,je ; do i=is,ie
! Collapse layers to thinnest possible if the thickness less than
! the thinnest possible (or negative).
- if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) then
- eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom_z
+ if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then
+ eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z
+ h(i,j,k) = GV%Angstrom_Z
else
h(i,j,k) = (eta(i,j,K) - eta(i,j,K+1))
endif
@@ -749,9 +745,9 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h)
if (-eta(i,j,nz+1) < G%bathyT(i,j) - hTolerance) then
dilations = dilations + 1
if (eta(i,j,1) <= eta(i,j,nz+1)) then
- do k=1,nz ; h(i,j,k) = (eta(i,j,1)+G%bathyT(i,j)) / real(nz) ; enddo
+ do k=1,nz ; h(i,j,k) = (eta(i,j,1) + G%bathyT(i,j)) / real(nz) ; enddo
else
- dilate = (eta(i,j,1)+G%bathyT(i,j)) / (eta(i,j,1)-eta(i,j,nz+1))
+ dilate = (eta(i,j,1) + G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1))
do k=1,nz ; h(i,j,k) = h(i,j,k) * dilate ; enddo
endif
do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) ; enddo
@@ -760,7 +756,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h)
! Now convert thicknesses to units of H.
do k=1,nz ; do j=js,je ; do i=is,ie
- h(i,j,k) = h(i,j,k)*GV%m_to_H
+ h(i,j,k) = h(i,j,k)*GV%Z_to_H
enddo ; enddo ; enddo
call sum_across_PEs(dilations)
@@ -771,9 +767,8 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h)
endif
end subroutine adjustEtaToFitBathymetry
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+!> Initializes thickness to be uniform
subroutine initialize_thickness_uniform(h, G, GV, param_file, 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.
@@ -783,13 +778,12 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params)
!! to parse for model parameter values.
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-
-! This subroutine initializes the layer thicknesses to be uniform.
+ ! Local variables
character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name.
- real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually !
- ! negative because it is positive upward. !
- real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface !
- ! positive upward, in m. !
+ real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units, usually
+ ! negative because it is positive upward.
+ real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface
+ ! positive upward, in depth units.
logical :: just_read ! If true, just read parameters but set nothing.
integer :: i, j, k, is, ie, js, je, nz
@@ -809,28 +803,27 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params)
enddo
do j=js,je ; do i=is,ie
-! This sets the initial thickness (in m) of the layers. The !
-! thicknesses are set to insure that: 1. each layer is at least an !
-! Angstrom thick, and 2. the interfaces are where they should be !
-! based on the resting depths and interface height perturbations, !
-! as long at this doesn't interfere with 1. !
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ ! This sets the initial thickness (in m) of the layers. The
+ ! thicknesses are set to insure that: 1. each layer is at least an
+ ! Angstrom thick, and 2. the interfaces are where they should be
+ ! based on the resting depths and interface height perturbations,
+ ! as long at this doesn't interfere with 1.
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
eta1D(K) = e0(K)
- if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then
- eta1D(K) = eta1D(K+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom
+ if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then
+ eta1D(K) = eta1D(K+1) + GV%Angstrom_Z
+ h(i,j,k) = GV%Angstrom_H
else
- h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1))
+ h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1))
endif
enddo
enddo ; enddo
call callTree_leave(trim(mdl)//'()')
end subroutine initialize_thickness_uniform
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+!> Initialize thickness from a 1D list
subroutine initialize_thickness_list(h, G, GV, param_file, 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.
@@ -840,19 +833,12 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params)
!! to parse for model parameter values.
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-
-! Arguments: h - The thickness that is being initialized.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
-! This subroutine initializes the layer thicknesses to be uniform.
+ ! Local variables
character(len=40) :: mdl = "initialize_thickness_list" ! This subroutine's name.
- real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually !
- ! negative because it is positive upward. !
- real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface !
- ! positive upward, in m. !
+ real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z),
+ ! usually negative because it is positive upward.
+ real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface
+ ! positive upward, in depth units (Z).
logical :: just_read ! If true, just read parameters but set nothing.
character(len=200) :: filename, eta_file, inputdir ! Strings for file/path
character(len=72) :: eta_var
@@ -879,7 +865,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params)
call log_param(param_file, mdl, "INPUTDIR/INTERFACE_IC_FILE", filename)
e0(:) = 0.0
- call MOM_read_data(filename, eta_var, e0(:))
+ call MOM_read_data(filename, eta_var, e0(:), scale=GV%m_to_Z)
if ((abs(e0(1)) - 0.0) > 0.001) then
! This list probably starts with the interior interface, so shift it up.
@@ -887,54 +873,47 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params)
e0(1) = 0.0
endif
- if (e0(2) > e0(1)) then
- ! Switch to the convention for interface heights increasing upward.
- do k=1,nz
- e0(K) = -e0(K)
- enddo
+ if (e0(2) > e0(1)) then ! Switch to the convention for interface heights increasing upward.
+ do k=1,nz ; e0(K) = -e0(K) ; enddo
endif
do j=js,je ; do i=is,ie
-! This sets the initial thickness (in m) of the layers. The !
-! thicknesses are set to insure that: 1. each layer is at least an !
-! Angstrom thick, and 2. the interfaces are where they should be !
-! based on the resting depths and interface height perturbations, !
-! as long at this doesn't interfere with 1. !
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ ! This sets the initial thickness (in m) of the layers. The
+ ! thicknesses are set to insure that: 1. each layer is at least an
+ ! Angstrom thick, and 2. the interfaces are where they should be
+ ! based on the resting depths and interface height perturbations,
+ ! as long at this doesn't interfere with 1.
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
eta1D(K) = e0(K)
- if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then
- eta1D(K) = eta1D(K+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom
+ if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then
+ eta1D(K) = eta1D(K+1) + GV%Angstrom_Z
+ h(i,j,k) = GV%Angstrom_H
else
- h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1))
+ h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1))
endif
enddo
enddo ; enddo
call callTree_leave(trim(mdl)//'()')
end subroutine initialize_thickness_list
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+!> Search density space for location of layers (not implemented!)
subroutine initialize_thickness_search
-! search density space for location of layers
call MOM_error(FATAL," MOM_state_initialization.F90, initialize_thickness_search: NOT IMPLEMENTED")
end subroutine initialize_thickness_search
-! -----------------------------------------------------------------------------
+!> Converts thickness from geometric to pressure units
subroutine convert_thickness(h, G, GV, tv)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: h !< Input eometric layer thicknesses (in H units),
+ intent(inout) :: h !< Input geometric layer thicknesses (in H units),
!! being converted to layer pressure
!! thicknesses (also in H units).
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables
-! Arguments: h - The thickness that is being initialized.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
p_top, p_bot
real :: dz_geo(SZI_(G),SZJ_(G)) ! The change in geopotential height
@@ -951,8 +930,8 @@ subroutine convert_thickness(h, G, GV, tv)
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
max_itt = 10
Boussinesq = GV%Boussinesq
- I_gEarth = 1.0 / GV%g_Earth
- Hm_rho_to_Pa = (GV%g_Earth * GV%H_to_m) ! = GV%H_to_Pa / GV%Rho0
+ I_gEarth = 1.0 / (GV%g_Earth*GV%m_to_Z)
+ Hm_rho_to_Pa = GV%g_Earth * GV%H_to_Z ! = GV%H_to_Pa / GV%Rho0
if (Boussinesq) then
call MOM_error(FATAL,"Not yet converting thickness with Boussinesq approx.")
@@ -1002,6 +981,7 @@ subroutine convert_thickness(h, G, GV, tv)
end subroutine convert_thickness
+!> Depress the sea-surface based on an initial condition file
subroutine depress_surface(h, G, GV, param_file, tv, 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
@@ -1011,12 +991,7 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params)
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-! Arguments: h - The thickness that is being initialized.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
eta_sfc ! The free surface height that the model should use, in m.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: &
@@ -1053,14 +1028,10 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params)
if (just_read) return ! All run-time parameters have been read, so return.
- call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain)
-
- if (scale_factor /= 1.0) then ; do j=js,je ; do i=is,ie
- eta_sfc(i,j) = eta_sfc(i,j) * scale_factor
- enddo ; enddo ; endif
+ call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor)
! Convert thicknesses to interface heights.
- call find_eta(h, tv, GV%g_Earth, G, GV, eta)
+ call find_eta(h, tv, G, GV, eta, eta_to_m=1.0)
do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
! if (eta_sfc(i,j) < eta(i,j,nz+1)) then
@@ -1081,9 +1052,9 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params)
do k=1,nz
if (eta(i,j,K) <= eta_sfc(i,j)) exit
if (eta(i,j,K+1) >= eta_sfc(i,j)) then
- h(i,j,k) = GV%Angstrom
+ h(i,j,k) = GV%Angstrom_H
else
- h(i,j,k) = max(GV%Angstrom, h(i,j,k) * &
+ h(i,j,k) = max(GV%Angstrom_H, h(i,j,k) * &
(eta_sfc(i,j) - eta(i,j,K+1)) / (eta(i,j,K) - eta(i,j,K+1)) )
endif
enddo
@@ -1104,17 +1075,17 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params)
intent(inout) :: h !< Layer thickness (H units, m or Pa)
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! 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),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.
character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path
- real :: scale_factor, min_thickness
+ real :: scale_factor ! A file-dependent scaling vactor for the input pressurs.
+ real :: min_thickness ! The minimum layer thickness, recast into Z units.
integer :: i, j, k
logical :: just_read ! If true, just read parameters but set nothing.
- logical :: use_remapping
+ logical :: use_remapping ! If true, remap the initial conditions.
type(remapping_CS), pointer :: remap_CS => NULL()
just_read = .false. ; if (present(just_read_params)) just_read = just_read_params
@@ -1134,15 +1105,14 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params)
"file SURFACE_PRESSURE_FILE into a surface pressure.", &
units="file dependent", default=1., do_not_log=just_read)
call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', &
- units='m', default=1.e-3, do_not_log=just_read)
+ units='m', default=1.e-3, do_not_log=just_read, scale=GV%m_to_Z)
call get_param(PF, mdl, "TRIMMING_USES_REMAPPING", use_remapping, &
'When trimming the column, also remap T and S.', &
default=.false., do_not_log=just_read)
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)
- if (scale_factor /= 1.) p_surf(:,:) = scale_factor * p_surf(:,:)
+ call MOM_read_data(filename, p_surf_var, p_surf, G%Domain, scale=scale_factor)
if (use_remapping) then
allocate(remap_CS)
@@ -1161,32 +1131,38 @@ subroutine trim_for_ice(PF, G, GV, 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%Rho0, 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)
+ call cut_off_column_top(GV%ke, tv, GV, 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*GV%m_to_Z)
enddo ; enddo
end subroutine trim_for_ice
-!> Adjust the layer thicknesses by cutting away the top at the depth where the hydrostatic
-!! pressure matches p_surf
-subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, &
- T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS)
- integer, intent(in) :: nk !< Number of layers
- type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure
- real, intent(in) :: Rho0 !< Reference density (kg/m3)
- real, intent(in) :: G_earth !< Gravitational acceleration (m/s2)
- real, intent(in) :: depth !< Depth of ocean column (m)
- real, intent(in) :: min_thickness !< Smallest thickness allowed (m)
- real, dimension(nk), intent(inout) :: T !< Layer mean temperature
+
+!> Adjust the layer thicknesses by removing the top of the water column above the
+!! depth where the hydrostatic pressure matches p_surf
+subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, &
+ T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS, z_tol)
+ 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.
+ real, intent(in) :: G_earth !< Gravitational acceleration (m2 Z-1 s-2)
+ real, intent(in) :: depth !< Depth of ocean column (Z)
+ real, intent(in) :: min_thickness !< Smallest thickness allowed (Z)
+ real, dimension(nk), intent(inout) :: T !< Layer mean temperature
real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer
real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer
- real, dimension(nk), intent(inout) :: S !< Layer mean salinity
+ real, dimension(nk), intent(inout) :: S !< Layer mean salinity
real, dimension(nk), intent(in) :: S_t !< Salinity at top of layer
real, dimension(nk), intent(in) :: S_b !< Salinity at bottom of layer
real, intent(in) :: p_surf !< Imposed pressure on ocean at surface (Pa)
- real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa)
- type(remapping_CS), pointer :: remap_CS ! Remapping structure for remapping T and S, if associated
+ real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa)
+ type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S,
+ !! if associated
+ real, optional, intent(in) :: z_tol !< The tolerance with which to find the depth
+ !! matching the specified pressure, in Z.
+
! Local variables
real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions
real, dimension(nk) :: h0, S0, T0, h1, S1, T1
@@ -1196,7 +1172,7 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, &
! Calculate original interface positions
e(nk+1) = -depth
do k=nk,1,-1
- e(K) = e(K+1) + h(k)
+ e(K) = e(K+1) + GV%H_to_Z*h(k)
h0(k) = h(nk+1-k) ! Keep a copy to use in remapping
enddo
@@ -1204,7 +1180,8 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, &
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, Rho0, G_earth, tv%eqn_of_state, P_b, z_out)
+ 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
exit
@@ -1221,14 +1198,14 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, &
if (e_tope_top) then
+ if (e(K) > e_top) then
! Original e(K) is too high
e(K) = e_top
e_top = e_top - min_thickness ! Next interface must be at least this deep
endif
! This layer needs trimming
- h(k) = max( min_thickness, e(K) - e(K+1) )
- if (e(K) Initialize horizontal velocity components from file
subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
intent(out) :: u !< The zonal velocity that is being initialized, in m s-1
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
@@ -1261,12 +1238,7 @@ subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params)
!! parse for modelparameter values.
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-! Arguments: u - The zonal velocity that is being initialized.
-! (out) v - The meridional velocity that is being initialized.
-! (in) G - The ocean's grid structure.
-! (in) param_file - parameter file type
-
-! This subroutine reads the initial velocity components from file
+ ! Local variables
character(len=40) :: mdl = "initialize_velocity_from_file" ! This subroutine's name.
character(len=200) :: filename,velocity_file,inputdir ! Strings for file/path
logical :: just_read ! If true, just read parameters but set nothing.
@@ -1294,11 +1266,10 @@ subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params)
call callTree_leave(trim(mdl)//'()')
end subroutine initialize_velocity_from_file
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+!> Initialize horizontal velocity components to zero.
subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
intent(out) :: u !< The zonal velocity that is being initialized, in m s-1
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
@@ -1307,12 +1278,7 @@ subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params)
!! parse for modelparameter values.
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-! Arguments: u - The zonal velocity that is being initialized.
-! (out) v - The meridional velocity that is being initialized.
-! (in) G - The ocean's grid structure.
-! (in) param_file - parameter file type
-
-! This subroutine sets the initial velocity components to zero
+ ! Local variables
character(len=200) :: mdl = "initialize_velocity_zero" ! This subroutine's name.
logical :: just_read ! If true, just read parameters but set nothing.
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
@@ -1334,11 +1300,10 @@ subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params)
call callTree_leave(trim(mdl)//'()')
end subroutine initialize_velocity_zero
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+!> Sets the initial velocity components to uniform
subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
intent(out) :: u !< The zonal velocity that is being initialized, in m s-1
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
@@ -1347,12 +1312,7 @@ subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params)
!! parse for modelparameter values.
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-! Arguments: u - The zonal velocity that is being initialized.
-! (out) v - The meridional velocity that is being initialized.
-! (in) G - The ocean's grid structure.
-! (in) param_file - parameter file type
-
-! This subroutine sets the initial velocity components to uniform
+ ! Local variables
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
real :: initial_u_const, initial_v_const
logical :: just_read ! If true, just read parameters but set nothing.
@@ -1379,26 +1339,20 @@ subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params)
enddo ; enddo ; enddo
end subroutine initialize_velocity_uniform
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+!> Sets the initial velocity components to be circular with
+!! no flow at edges of domain and center.
subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
intent(out) :: u !< The zonal velocity that is being initialized, in m s-1
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
intent(out) :: v !< The meridional velocity that is being initialized, in m s-1
type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to
- !! parse for modelparameter values.
+ !! parse for model parameter values.
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-! Arguments: u - The zonal velocity that is being initialized.
-! (out) v - The meridional velocity that is being initialized.
-! (in) G - The ocean's grid structure.
-! (in) param_file - parameter file type
-
-! This subroutine sets the initial velocity components to be circular with
-! no flow at edges of domain and center.
+ ! Local variables
character(len=200) :: mdl = "initialize_velocity_circular"
real :: circular_max_u
real :: dpi, psi1, psi2
@@ -1431,9 +1385,13 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params)
contains
- real function my_psi(ig,jg) ! in-line function
- integer :: ig, jg
+ !> Returns the value of a circular stream function at (ig,jg)
+ real function my_psi(ig,jg)
+ integer :: ig !< Global i-index
+ integer :: jg !< Global j-index
+ ! Local variables
real :: x, y, r
+
x = 2.0*(G%geoLonBu(ig,jg)-G%west_lon)/G%len_lon-1.0 ! -1 Initializes temperature and salinity from file
subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized.
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
- !! only read parameters without changing h.
-! This function puts the initial layer temperatures and salinities !
-! into T(:,:,:) and S(:,:,:). !
-
-! Arguments: T - The potential temperature that is being initialized.
-! (out) S - The salinity that is being initialized.
-! (in) from_file - .true. if the variables that are set here are to
-! be read from a file; .false. to be set internally.
-! (in) filename - The name of the file to read.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
+ !! only read parameters without changing h.
+ ! Local variables
logical :: just_read ! If true, just read parameters but set nothing.
character(len=200) :: filename, salt_filename ! Full paths to input files
character(len=200) :: ts_file, salt_file, inputdir ! Strings for file/path
@@ -1497,7 +1444,7 @@ subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params)
if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, &
" initialize_temp_salt_from_file: Unable to open "//trim(filename))
-! Read the temperatures and salinities from netcdf files. !
+ ! Read the temperatures and salinities from netcdf files.
call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain)
salt_filename = trim(inputdir)//trim(salt_file)
@@ -1508,9 +1455,8 @@ subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params)
call callTree_leave(trim(mdl)//'()')
end subroutine initialize_temp_salt_from_file
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+!> Initializes temperature and salinity from a 1D profile
subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_params)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized.
@@ -1518,17 +1464,7 @@ subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_para
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-! This function puts the initial layer temperatures and salinities !
-! into T(:,:,:) and S(:,:,:). !
-
-! Arguments: T - The potential temperature that is being initialized.
-! (out) S - The salinity that is being initialized.
-! (in) from_file - .true. if the variables that are set here are to
-! be read from a file; .false. to be set internally.
-! (in) filename - The name of the file to read.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
+ ! Local variables
real, dimension(SZK_(G)) :: T0, S0
integer :: i, j, k
logical :: just_read ! If true, just read parameters but set nothing.
@@ -1552,7 +1488,7 @@ subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_para
if (.not.file_exists(filename)) call MOM_error(FATAL, &
" initialize_temp_salt_from_profile: Unable to open "//trim(filename))
-! Read the temperatures and salinities from a netcdf file. !
+ ! Read the temperatures and salinities from a netcdf file.
call MOM_read_data(filename, "PTEMP", T0(:))
call MOM_read_data(filename, "SALT", S0(:))
@@ -1562,10 +1498,8 @@ subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_para
call callTree_leave(trim(mdl)//'()')
end subroutine initialize_temp_salt_from_profile
-! -----------------------------------------------------------------------------
-
-! -----------------------------------------------------------------------------
+!> Initializes temperature and salinity by fitting to density
subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, 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.
@@ -1578,23 +1512,13 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref
!! in Pa.
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-! This function puts the initial layer temperatures and salinities !
-! into T(:,:,:) and S(:,:,:). !
-
-! Arguments: T - The potential temperature that is being initialized.
-! (out) S - The salinity that is being initialized.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) eqn_of_state - integer that selects the equatio of state
-! (in) P_Ref - The coordinate-density reference pressure in Pa.
+ ! Local variables
real :: T0(SZK_(G)), S0(SZK_(G))
real :: T_Ref ! Reference Temperature
real :: S_Ref ! Reference Salinity
real :: pres(SZK_(G)) ! An array of the reference pressure in Pa.
- real :: drho_dT(SZK_(G)) ! Derivative of density with temperature in kg m-3 K-1. !
- real :: drho_dS(SZK_(G)) ! Derivative of density with salinity in kg m-3 PSU-1. !
+ real :: drho_dT(SZK_(G)) ! Derivative of density with temperature in kg m-3 K-1.
+ real :: drho_dS(SZK_(G)) ! Derivative of density with salinity in kg m-3 PSU-1.
real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3.
logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity.
logical :: just_read ! If true, just read parameters but set nothing.
@@ -1628,11 +1552,11 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref
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.
+ ! A first guess of the layers' temperatures.
do k=nz,1,-1
S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS(1))
enddo
-! Refine the guesses for each layer.
+ ! Refine the guesses for each layer.
do itt=1,6
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)
@@ -1641,7 +1565,7 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref
enddo
enddo
else
-! A first guess of the layers' temperatures.
+ ! A first guess of the layers' temperatures.
do k=nz,1,-1
T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT(1)
enddo
@@ -1660,9 +1584,12 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref
call callTree_leave(trim(mdl)//'()')
end subroutine initialize_temp_salt_fit
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
+!> Initializes T and S with linear profiles according to reference surface
+!! layer salinity and temperature and a specified range.
+!!
+!! \remark Note that the linear distribution is set up with respect to the layer
+!! number, not the physical position).
subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized.
@@ -1674,10 +1601,6 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params)
!! parameters without
!! changing h.
- ! This subroutine initializes linear profiles for T and S according to
- ! reference surface layer salinity and temperature and a specified range.
- ! Note that the linear distribution is set up with respect to the layer
- ! number, not the physical position).
integer :: k
real :: delta_S, delta_T
real :: S_top, T_top ! Reference salinity and temerature within surface layer
@@ -1704,7 +1627,7 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params)
if (just_read) return ! All run-time parameters have been read, so return.
-! ! Prescribe salinity
+ ! Prescribe salinity
! delta_S = S_range / ( G%ke - 1.0 )
! S(:,:,1) = S_top
! do k = 2,G%ke
@@ -1715,7 +1638,7 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params)
T(:,:,k) = T_top - T_range*((real(k)-0.5)/real(G%ke))
enddo
-! ! Prescribe temperature
+ ! Prescribe temperature
! delta_T = T_range / ( G%ke - 1.0 )
! T(:,:,1) = T_top
! do k = 2,G%ke
@@ -1726,13 +1649,11 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params)
call callTree_leave(trim(mdl)//'()')
end subroutine initialize_temp_salt_linear
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
!> This subroutine sets the inverse restoration time (Idamp), and
!! the values towards which the interface heights and an arbitrary
!! number of tracers should be restored within each sponge. The
-!!interface height is always subject to damping, and must always be
+!! interface height is always subject to damping, and must always be
!! the first registered field.
subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, ALE_CSp, Time)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
@@ -1747,8 +1668,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp,
!! structure for this module (in ALE mode).
type(time_type), intent(in) :: Time !< Time at the start of the run segment. Time_in
!! overrides any value set for Time.
-
-! Local variables
+ ! Local variables
real, allocatable, dimension(:,:,:) :: eta ! The target interface heights, in m.
real, allocatable, dimension(:,:,:) :: h ! The target interface thicknesses, in m.
@@ -1821,32 +1741,31 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp,
call MOM_read_data(filename, "Idamp", Idamp(:,:), G%Domain)
-! Now register all of the fields which are damped in the sponge. !
-! By default, momentum is advected vertically within the sponge, but !
-! momentum is typically not damped within the sponge. !
+ ! Now register all of the fields which are damped in the sponge.
+ ! By default, momentum is advected vertically within the sponge, but
+ ! momentum is typically not damped within the sponge.
filename = trim(inputdir)//trim(state_file)
call log_param(param_file, mdl, "INPUTDIR/SPONGE_STATE_FILE", filename)
if (.not.file_exists(filename, G%Domain)) &
call MOM_error(FATAL, " initialize_sponges: Unable to open "//trim(filename))
-
-! The first call to set_up_sponge_field is for the interface heights if in layered mode.!
+ ! The first call to set_up_sponge_field is for the interface heights if in layered mode.!
if (.not. use_ALE) then
allocate(eta(isd:ied,jsd:jed,nz+1))
- call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain)
+ call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z)
do j=js,je ; do i=is,ie
eta(i,j,nz+1) = -G%bathyT(i,j)
enddo ; enddo
do k=nz,1,-1 ; do j=js,je ; do i=is,ie
- if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) &
- eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z
+ if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) &
+ eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z
enddo ; enddo ; enddo
-! Set the inverse damping rates so that the model will know where to !
-! apply the sponges, along with the interface heights. !
- call initialize_sponge(Idamp, eta, G, param_file, CSp)
+ ! Set the inverse damping rates so that the model will know where to
+ ! apply the sponges, along with the interface heights.
+ call initialize_sponge(Idamp, eta, G, param_file, CSp, GV)
deallocate(eta)
elseif (.not. new_sponges) then ! ALE mode
@@ -1854,24 +1773,24 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp,
if (siz(1) /= G%ieg-G%isg+1 .or. siz(2) /= G%jeg-G%jsg+1) &
call MOM_error(FATAL,"initialize_sponge_file: Array size mismatch for sponge data.")
-! ALE_CSp%time_dependent_target = .false.
-! if (siz(4) > 1) ALE_CSp%time_dependent_target = .true.
+! ALE_CSp%time_dependent_target = .false.
+! if (siz(4) > 1) ALE_CSp%time_dependent_target = .true.
nz_data = siz(3)-1
allocate(eta(isd:ied,jsd:jed,nz_data+1))
allocate(h(isd:ied,jsd:jed,nz_data))
- call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain)
+ call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z)
do j=js,je ; do i=is,ie
eta(i,j,nz+1) = -G%bathyT(i,j)
enddo ; enddo
do k=nz,1,-1 ; do j=js,je ; do i=is,ie
- if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) &
- eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z
+ if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) &
+ eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z
enddo ; enddo ; enddo
do k=1,nz; do j=js,je ; do i=is,ie
- h(i,j,k) = eta(i,j,k)-eta(i,j,k+1)
+ h(i,j,k) = GV%Z_to_H*(eta(i,j,k)-eta(i,j,k+1))
enddo ; enddo ; enddo
call initialize_ALE_sponge(Idamp, G, param_file, ALE_CSp, h, nz_data)
deallocate(eta)
@@ -1881,16 +1800,14 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp,
call initialize_ALE_sponge(Idamp, G, param_file, ALE_CSp)
endif
-
-
-! Now register all of the tracer fields which are damped in the !
-! sponge. By default, momentum is advected vertically within the !
-! sponge, but momentum is typically not damped within the sponge. !
+ ! Now register all of the tracer fields which are damped in the
+ ! sponge. By default, momentum is advected vertically within the
+ ! sponge, but momentum is typically not damped within the sponge.
if ( GV%nkml>0 .and. .not. new_sponges) then
-! This call to set_up_sponge_ML_density registers the target values of the
-! mixed layer density, which is used in determining which layers can be
-! inflated without causing static instabilities.
+ ! This call to set_up_sponge_ML_density registers the target values of the
+ ! 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
call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain)
@@ -1904,7 +1821,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp,
call set_up_sponge_ML_density(tmp_2d, G, CSp)
endif
-! The remaining calls to set_up_sponge_field can be in any order. !
+ ! The remaining calls to set_up_sponge_field can be in any order.
if ( use_temperature .and. .not. new_sponges) then
call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain)
call set_up_sponge_field(tmp, tv%T, G, nz, CSp)
@@ -1915,16 +1832,13 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp,
call set_up_ALE_sponge_field(filename, salin_var, Time, G, tv%S, ALE_CSp)
endif
-
-
end subroutine initialize_sponges_file
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
!> This subroutine sets the 4 bottom depths at velocity points to be the
!! maximum of the adjacent depths.
subroutine set_velocity_depth_max(G)
- type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
+ ! Local variables
integer :: i, j
do I=G%isd,G%ied-1 ; do j=G%jsd,G%jed
@@ -1936,13 +1850,12 @@ subroutine set_velocity_depth_max(G)
G%Dopen_v(I,J) = G%Dblock_v(I,J)
enddo ; enddo
end subroutine set_velocity_depth_max
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
!> Subroutine to pre-compute global integrals of grid quantities for
!! later use in reporting diagnostics
subroutine compute_global_grid_integrals(G)
- type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
+ ! Local variables
real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming
integer :: i,j
@@ -1955,11 +1868,11 @@ subroutine compute_global_grid_integrals(G)
G%IareaT_global = 1. / G%areaT_global
end subroutine compute_global_grid_integrals
-! -----------------------------------------------------------------------------
!> This subroutine sets the 4 bottom depths at velocity points to be the
!! minimum of the adjacent depths.
subroutine set_velocity_depth_min(G)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
+ ! Local variables
integer :: i, j
do I=G%isd,G%ied-1 ; do j=G%jsd,G%jed
@@ -1971,15 +1884,11 @@ subroutine set_velocity_depth_min(G)
G%Dopen_v(I,J) = G%Dblock_v(I,J)
enddo ; enddo
end subroutine set_velocity_depth_min
-! -----------------------------------------------------------------------------
-! -----------------------------------------------------------------------------
!> This subroutine determines the isopycnal or other coordinate interfaces and
!! layer potential temperatures and salinities directly from a z-space file on
!! a latitude-longitude grid.
subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
-! This subroutine was written by M. Harrison, with input from R. Hallberg & A. Adcroft.
-!
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
intent(out) :: h !< Layer thicknesses being initialized, in H
@@ -1991,6 +1900,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
+ ! Local variables
character(len=200) :: filename !< The name of an input file containing temperature
!! and salinity in z-space; also used for ice shelf area.
character(len=200) :: tfilename !< The name of an input file containing only temperature
@@ -2004,9 +1914,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
type(EOS_type), pointer :: eos => NULL()
type(thermo_var_ptrs) :: tv_loc ! A temporary thermo_var container
type(verticalGrid_type) :: GV_loc ! A temporary vertical grid structure
-
-! This include declares and sets the variable "version".
-#include "version_variable.h"
+ ! This include declares and sets the variable "version".
+# include "version_variable.h"
character(len=40) :: mdl = "MOM_initialize_layers_from_Z" ! This module's name.
integer :: is, ie, js, je, nz ! compute domain indices
@@ -2019,11 +1928,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
integer :: nkml, nkbl ! number of mixed and buffer layers
integer :: kd, inconsistent
- integer :: nkd ! number of levels to use for regridding input arrays
+ integer :: nkd ! number of levels to use for regridding input arrays
+ real :: eps_Z ! A negligibly thin layer thickness, in Z.
real :: PI_180 ! for conversion from degrees to radians
- real, dimension(:,:), pointer :: shelf_area
- real :: min_depth
+ real, dimension(:,:), pointer :: shelf_area => NULL()
+ real :: min_depth ! The minimum depth in Z.
real :: dilate
real :: missing_value_temp, missing_value_salt
logical :: correct_thickness
@@ -2038,24 +1948,23 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
logical :: reentrant_x, tripolar_n,dbg
logical :: debug = .false. ! manually set this to true for verbose output
- !data arrays
+ ! data arrays
real, dimension(:), allocatable :: z_edges_in, z_in, Rb
real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z
real, dimension(:,:,:), allocatable :: rho_z
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in m.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in Z.
real, dimension(SZI_(G),SZJ_(G)) :: nlevs
- real, dimension(SZI_(G)) :: press
-
+ real, dimension(SZI_(G)) :: press ! Pressures in Pa.
! Local variables for ALE remapping
- real, dimension(:), allocatable :: hTarget
+ real, dimension(:), allocatable :: hTarget ! Target thicknesses in Z.
real, dimension(:,:), allocatable :: area_shelf_h
real, dimension(:,:), allocatable, target :: frac_shelf_h
real, dimension(:,:,:), allocatable, target :: tmpT1dIn, tmpS1dIn
real, dimension(:,:,:), allocatable :: tmp_mask_in
real, dimension(:,:,:), allocatable :: h1 ! Thicknesses in H.
real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding
- real :: zTopOfCell, zBottomOfCell
+ real :: zTopOfCell, zBottomOfCell ! Heights in Z units
type(regridding_CS) :: regridCS ! Regridding parameters and work arrays
type(remapping_CS) :: remapCS ! Remapping parameters and work arrays
@@ -2091,7 +2000,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.)
tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.)
- call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0)
+ call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0, scale=GV%m_to_Z)
call get_param(PF, mdl, "NKML",nkml,default=0)
call get_param(PF, mdl, "NKBL",nkbl,default=0)
@@ -2165,43 +2074,48 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
return ! All run-time parameters have been read, so return.
endif
-! Read input grid coordinates for temperature and salinity field
-! in z-coordinate dataset. The file is REQUIRED to contain the
-! following:
-!
-! dimension variables:
-! lon (degrees_E), lat (degrees_N), depth(meters)
-! variables:
-! ptemp(lon,lat,depth) : degC, potential temperature
-! salt (lon,lat,depth) : PSU, salinity
-!
-! The first record will be read if there are multiple time levels.
-! The observation grid MUST tile the model grid. If the model grid extends
-! to the North/South Pole past the limits of the input data, they are extrapolated using the average
-! value at the northernmost/southernmost latitude.
-
- call horiz_interp_and_extrap_tracer(tfilename, potemp_var,1.0,1, &
+ !### Change this to GV%Angstrom_Z
+ eps_z = 1.0e-10*GV%m_to_Z
+
+ ! Read input grid coordinates for temperature and salinity field
+ ! in z-coordinate dataset. The file is REQUIRED to contain the
+ ! following:
+ !
+ ! dimension variables:
+ ! lon (degrees_E), lat (degrees_N), depth(meters)
+ ! variables:
+ ! ptemp(lon,lat,depth) : degC, potential temperature
+ ! salt (lon,lat,depth) : PSU, salinity
+ !
+ ! The first record will be read if there are multiple time levels.
+ ! The observation grid MUST tile the model grid. If the model grid extends
+ ! to the North/South Pole past the limits of the input data, they are extrapolated using the average
+ ! value at the northernmost/southernmost latitude.
+
+ call horiz_interp_and_extrap_tracer(tfilename, potemp_var, 1.0, 1, &
G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, tripolar_n, homogenize)
- call horiz_interp_and_extrap_tracer(sfilename, salin_var,1.0,1, &
+ call horiz_interp_and_extrap_tracer(sfilename, salin_var, 1.0, 1, &
G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, tripolar_n, homogenize)
kd = size(z_in,1)
+ ! Convert the units and sign convention of z_in and Z_edges_in.
+ do k=1,kd ; z_in(k) = GV%m_to_Z*z_in(k) ; enddo
+ do k=1,size(Z_edges_in,1) ; Z_edges_in(k) = -GV%m_to_Z*Z_edges_in(k) ; enddo
+
allocate(rho_z(isd:ied,jsd:jed,kd))
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)
+ ! 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)
- 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)
- enddo
- enddo ! kd
+ do k=1,kd ; do j=js,je
+ call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), is, ie, eos)
+ enddo ; enddo
call pass_var(temp_z,G%Domain)
call pass_var(salt_z,G%Domain)
@@ -2215,28 +2129,28 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
call MOM_read_data(shelf_file, trim(area_varname), area_shelf_h, G%Domain)
- ! initialize frac_shelf_h with zeros (open water everywhere)
+ ! Initialize frac_shelf_h with zeros (open water everywhere)
frac_shelf_h(:,:) = 0.0
- ! compute fractional ice shelf coverage of h
+ ! Compute fractional ice shelf coverage of h
do j=jsd,jed ; do i=isd,ied
if (G%areaT(i,j) > 0.0) &
frac_shelf_h(i,j) = area_shelf_h(i,j) / G%areaT(i,j)
enddo ; enddo
- ! pass to the pointer
+ ! Pass to the pointer for use as an argument to regridding_main
shelf_area => frac_shelf_h
endif
-! Done with horizontal interpolation.
-! Now remap to model coordinates
+ ! Done with horizontal interpolation.
+ ! Now remap to model coordinates
if (useALEremapping) then
call cpu_clock_begin(id_clock_ALE)
nkd = max(GV%ke, kd)
! The regridding tools (grid generation) are coded to work on model arrays of the same
! vertical shape. We need to re-write the regridding if the model has fewer layers
! than the data. -AJA
- !if (kd>nz) call MOM_error(FATAL,"MOM_initialize_state, MOM_temp_salt_initialize_from_Z(): "//&
- ! "Data has more levels than the model - this has not been coded yet!")
+! if (kd>nz) call MOM_error(FATAL,"MOM_initialize_state, MOM_temp_salt_initialize_from_Z(): "//&
+! "Data has more levels than the model - this has not been coded yet!")
! Build the source grid and copy data onto model-shaped arrays with vanished layers
allocate( tmp_mask_in(isd:ied,jsd:jed,nkd) ) ; tmp_mask_in(:,:,:) = 0.
allocate( h1(isd:ied,jsd:jed,nkd) ) ; h1(:,:,:) = 0.
@@ -2248,7 +2162,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
tmp_mask_in(i,j,1:kd) = mask_z(i,j,:)
do k = 1, nkd
if (tmp_mask_in(i,j,k)>0. .and. k<=kd) then
- zBottomOfCell = max( -z_edges_in(k+1), -G%bathyT(i,j) )
+ zBottomOfCell = max( z_edges_in(k+1), -G%bathyT(i,j) )
tmpT1dIn(i,j,k) = temp_z(i,j,k)
tmpS1dIn(i,j,k) = salt_z(i,j,k)
elseif (k>1) then
@@ -2259,10 +2173,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
tmpT1dIn(i,j,k) = -99.9
tmpS1dIn(i,j,k) = -99.9
endif
- h1(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell)
+ h1(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell)
zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k
enddo
- h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%bathyT(i,j) )
+ h1(i,j,kd) = h1(i,j,kd) + GV%Z_to_H * max(0., zTopOfCell + G%bathyT(i,j) )
! The max here is in case the data data is shallower than model
endif ! mask2dT
enddo ; enddo
@@ -2273,12 +2187,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
! Build the target grid (and set the model thickness to it)
! This call can be more general but is hard-coded for z* coordinates... ????
- call ALE_initRegridding( GV, G%max_depth, PF, mdl, regridCS ) ! sets regridCS
+ call ALE_initRegridding( GV, GV%Z_to_m*G%max_depth, PF, mdl, regridCS ) ! sets regridCS
if (.not. remap_general) then
! This is the old way of initializing to z* coordinates only
allocate( hTarget(nz) )
- hTarget = getCoordinateResolution( regridCS )
+ hTarget = GV%m_to_Z * getCoordinateResolution( regridCS )
do j = js, je ; do i = is, ie
h(i,j,:) = 0.
if (G%mask2dT(i,j)>0.) then
@@ -2286,7 +2200,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
zTopOfCell = 0. ; zBottomOfCell = 0.
do k = 1, nz
zBottomOfCell = max( zTopOfCell - hTarget(k), -G%bathyT(i,j) )
- h(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell)
+ h(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell)
zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k
enddo
else
@@ -2326,66 +2240,66 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
else ! remap to isopycnal layer space
-! next find interface positions using local arrays
-! nlevs contains the number of valid data points in each column
+ ! Next find interface positions using local arrays
+ ! nlevs contains the number of valid data points in each column
nlevs = sum(mask_z,dim=3)
-! Rb contains the layer interface densities
+ ! Rb contains the layer interface densities
allocate(Rb(nz+1))
do k=2,nz ; Rb(k)=0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo
Rb(1) = 0.0 ; Rb(nz+1) = 2.0*GV%Rlay(nz) - GV%Rlay(nz-1)
zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%bathyT(is:ie,js:je), &
- nlevs(is:ie,js:je), nkml, nkbl, min_depth)
+ nlevs(is:ie,js:je), nkml, nkbl, min_depth, eps_z=eps_z)
if (correct_thickness) then
call adjustEtaToFitBathymetry(G, GV, zi, h)
else
do k=nz,1,-1 ; do j=js,je ; do i=is,ie
- if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_z)) then
- zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom
+ if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_Z)) then
+ zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_Z
+ h(i,j,k) = GV%Angstrom_H
else
- h(i,j,k) = GV%m_to_H * (zi(i,j,K) - zi(i,j,K+1))
+ h(i,j,k) = GV%Z_to_H * (zi(i,j,K) - zi(i,j,K+1))
endif
enddo ; enddo ; enddo
inconsistent=0
do j=js,je ; do i=is,ie
- if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0) &
+ if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0*GV%m_to_Z) &
inconsistent = inconsistent + 1
enddo ; enddo
call sum_across_PEs(inconsistent)
if ((inconsistent > 0) .and. (is_root_pe())) then
- write(mesg,'("Thickness initial conditions are inconsistent ",'// &
- '"with topography in ",I5," places.")') inconsistent
+ write(mesg, '("Thickness initial conditions are inconsistent ",'// &
+ '"with topography in ",I5," places.")') inconsistent
call MOM_error(WARNING, mesg)
endif
endif
- tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:),-1.0*z_edges_in,zi(is:ie,js:je,:), &
- nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, &
- nlevs(is:ie,js:je),dbg,idbg,jdbg)
- tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:),-1.0*z_edges_in,zi(is:ie,js:je,:), &
- nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, &
- nlevs(is:ie,js:je))
+ tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:), z_edges_in, zi(is:ie,js:je,:), &
+ nkml, nkbl, missing_value, G%mask2dT(is:ie,js:je), nz, &
+ nlevs(is:ie,js:je),dbg,idbg,jdbg, eps_z=eps_z)
+ tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:), z_edges_in, zi(is:ie,js:je,:), &
+ nkml, nkbl, missing_value, G%mask2dT(is:ie,js:je), nz, &
+ nlevs(is:ie,js:je), eps_z=eps_z)
do k=1,nz
nPoints = 0 ; tempAvg = 0. ; saltAvg = 0.
do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) >= 1.0) then
nPoints = nPoints + 1
tempAvg = tempAvg + tv%T(i,j,k)
- saltAvg =saltAvg + tv%S(i,j,k)
+ saltAvg = saltAvg + tv%S(i,j,k)
endif ; enddo ; enddo
- ! Horizontally homogenize data to produce perfectly "flat" initial conditions
+ ! Horizontally homogenize data to produce perfectly "flat" initial conditions
if (homogenize) then
call sum_across_PEs(nPoints)
call sum_across_PEs(tempAvg)
call sum_across_PEs(saltAvg)
if (nPoints>0) then
- tempAvg = tempAvg/real(nPoints)
- saltAvg = saltAvg/real(nPoints)
+ tempAvg = tempAvg / real(nPoints)
+ saltAvg = saltAvg / real(nPoints)
endif
tv%T(:,:,k) = tempAvg
tv%S(:,:,k) = saltAvg
@@ -2394,16 +2308,16 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
endif ! useALEremapping
-! Fill land values
+ ! Fill land values
do k=1,nz ; do j=js,je ; do i=is,ie
if (tv%T(i,j,k) == missing_value) then
- tv%T(i,j,k)=temp_land_fill
- tv%S(i,j,k)=salt_land_fill
+ tv%T(i,j,k) = temp_land_fill
+ tv%S(i,j,k) = salt_land_fill
endif
enddo ; enddo ; enddo
-! Finally adjust to target density
- ks=max(0,nkml)+max(0,nkbl)+1
+ ! Finally adjust to target density
+ ks = max(0,nkml)+max(0,nkbl)+1
if (adjust_temperature .and. .not. useALEremapping) then
call determine_temperature(tv%T(is:ie,js:je,:), tv%S(is:ie,js:je,:), &
@@ -2411,7 +2325,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params)
endif
- deallocate(z_in,z_edges_in,temp_z,salt_z,mask_z)
+ deallocate(z_in, z_edges_in, temp_z, salt_z, mask_z)
+ deallocate(rho_z, area_shelf_h, frac_shelf_h)
call pass_var(h, G%Domain)
call pass_var(tv%T, G%Domain)
@@ -2451,15 +2366,15 @@ subroutine MOM_state_init_tests(G, GV, tv)
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)), -GV%Rho0*GV%g_Earth*z(k), &
+ call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*(GV%g_Earth*GV%m_to_Z)*z(k), &
rho(k), tv%eqn_of_state)
- P_tot = P_tot + GV%g_Earth * rho(k) * h(k)
+ P_tot = P_tot + (GV%g_Earth*GV%m_to_Z) * rho(k) * 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, GV%Rho0, GV%g_Earth, tv%eqn_of_state, P_b, z_out)
+ P_t, 0.5*P_tot, GV%Rho0, (GV%g_Earth*GV%m_to_Z), 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
P_t = P_b
enddo
@@ -2469,7 +2384,7 @@ subroutine MOM_state_init_tests(G, GV, tv)
write(0,*) ' ==================================================================== '
write(0,*) ''
write(0,*) h
- call cut_off_column_top(nk, tv, GV%Rho0, GV%g_Earth, -e(nk+1), GV%Angstrom, &
+ call cut_off_column_top(nk, tv, GV, (GV%g_Earth*GV%m_to_Z), -e(nk+1), GV%Angstrom_H, &
T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS)
write(0,*) h
diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90
index 71156c27b8..fb5487780f 100644
--- a/src/initialization/MOM_tracer_initialization_from_Z.F90
+++ b/src/initialization/MOM_tracer_initialization_from_Z.F90
@@ -1,3 +1,4 @@
+!> Initializes hydrography from z-coordinate climatology files
module MOM_tracer_initialization_from_Z
! This file is part of MOM6. See LICENSE.md for the license.
@@ -15,7 +16,6 @@ module MOM_tracer_initialization_from_Z
use MOM_get_input, only : directories
use MOM_grid, only : ocean_grid_type, isPointInCell
use MOM_string_functions, only : uppercase
-use MOM_time_manager, only : time_type, set_time
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : setVerticalGridAxes
use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type
@@ -26,37 +26,37 @@ module MOM_tracer_initialization_from_Z
use MOM_remapping, only : remapping_core_h
use MOM_verticalGrid, only : verticalGrid_type
use MOM_horizontal_regridding, only : myStats, horiz_interp_and_extrap_tracer
+
implicit none ; private
#include
public :: MOM_initialize_tracer_from_Z
-character(len=40) :: mdl = "MOM_tracer_initialization_from_Z" ! This module's name.
-
-real, parameter :: epsln=1.e-10
+character(len=40) :: mdl = "MOM_tracer_initialization_from_Z" !< This module's name.
contains
-!> MOM_initialize_tracer_from_Z initializes a tracer from a z-space data file.
+!> Initializes a tracer from a z-space data file.
subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, &
src_var_unit_conversion, src_var_record, homogenize, &
useALEremapping, remappingScheme, src_var_gridspec )
-
type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure.
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- intent(in) :: h !< Layer thickness, in m.
+ intent(in) :: h !< Layer thickness, in H (often m or kg m-2).
real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized
type(param_file_type), intent(in) :: PF !< parameter file
- character(len=*), intent(in) :: src_file, src_var_nam !< source filename and variable name on disk
+ character(len=*), intent(in) :: src_file !< source filename
+ character(len=*), intent(in) :: src_var_nam !< variable name in file
real, optional, intent(in) :: src_var_unit_conversion !< optional multiplicative unit conversion
integer, optional, intent(in) :: src_var_record !< record to read for multiple time-level files
logical, optional, intent(in) :: homogenize !< optionally homogenize to mean value
logical, optional, intent(in) :: useALEremapping !< to remap or not (optional)
character(len=*), optional, intent(in) :: remappingScheme !< remapping scheme to use.
- character(len=*), optional, intent(in) :: src_var_gridspec ! Not implemented yet.
-
+ character(len=*), optional, intent(in) :: src_var_gridspec !< Source variable name in a gridspec file.
+ !! This is not implemented yet.
+ ! Local variables
real :: land_fill = 0.0
character(len=200) :: inputdir ! The directory where NetCDF input files are.
character(len=200) :: mesg
@@ -65,31 +65,24 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam,
character(len=10) :: remapScheme
logical :: homog,useALE
-! This include declares and sets the variable "version".
-#include "version_variable.h"
-
+ ! This include declares and sets the variable "version".
+# include "version_variable.h"
character(len=40) :: mdl = "MOM_initialize_tracers_from_Z" ! This module's name.
integer :: is, ie, js, je, nz ! compute domain indices
- integer :: isg, ieg, jsg, jeg ! global extent
integer :: isd, ied, jsd, jed ! data domain indices
-
integer :: i, j, k, kd
-
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi
real, allocatable, dimension(:,:,:), target :: tr_z, mask_z
real, allocatable, dimension(:), target :: z_edges_in, z_in
! Local variables for ALE remapping
- real, dimension(:), allocatable :: h1, h2, hTarget, deltaE, tmpT1d
- real, dimension(:), allocatable :: tmpT1dIn
- real :: zTopOfCell, zBottomOfCell
+ real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses in H units.
+ real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses in Z.
+ real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in Z.
type(remapping_CS) :: remapCS ! Remapping parameters and work arrays
- real, dimension(:,:,:), allocatable :: hSrc
-
- real :: tempAvg, missing_value
- integer :: nPoints, ans
+ real :: missing_value
+ integer :: nPoints
integer :: id_clock_routine, id_clock_ALE
logical :: reentrant_x, tripolar_n
@@ -100,7 +93,6 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam,
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- isg = G%isg ; ieg = G%ieg ; jsg = G%jsg ; jeg = G%jeg
call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90")
@@ -119,7 +111,6 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam,
reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.)
tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.)
-
if (PRESENT(homogenize)) homog=homogenize
if (PRESENT(useALEremapping)) useALE=useALEremapping
if (PRESENT(remappingScheme)) remapScheme=remappingScheme
@@ -128,11 +119,11 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam,
convert=1.0
if (PRESENT(src_var_unit_conversion)) convert = src_var_unit_conversion
-
call horiz_interp_and_extrap_tracer(src_file, src_var_nam, convert, recnum, &
G, tr_z, mask_z, z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, homog)
kd = size(z_edges_in,1)-1
+ do k=1,kd+1 ; z_edges_in(k) = GV%m_to_Z*z_edges_in(k) ; enddo
call pass_var(tr_z,G%Domain)
call pass_var(mask_z,G%Domain)
@@ -143,51 +134,38 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam,
! First we reserve a work space for reconstructions of the source data
allocate( h1(kd) )
allocate( hSrc(isd:ied,jsd:jed,kd) )
- allocate( tmpT1dIn(kd) )
call initialize_remapping( remapCS, remapScheme, boundary_extrapolation=.false. ) ! Data for reconstructions
! Next we initialize the regridding package so that it knows about the target grid
- allocate( hTarget(nz) )
- allocate( h2(nz) )
- allocate( tmpT1d(nz) )
- allocate( deltaE(nz+1) )
do j = js, je ; do i = is, ie
if (G%mask2dT(i,j)>0.) then
! Build the source grid
zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0
+ z_bathy = G%bathyT(i,j)
do k = 1, kd
if (mask_z(i,j,k) > 0.) then
- zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(i,j) )
- tmpT1dIn(k) = tr_z(i,j,k)
+ zBottomOfCell = -min( z_edges_in(k+1), z_bathy )
elseif (k>1) then
- zBottomOfCell = -G%bathyT(i,j)
- tmpT1dIn(k) = tmpT1dIn(k-1)
- else ! This next block should only ever be reached over land
- tmpT1dIn(k) = -99.9
+ zBottomOfCell = -z_bathy
endif
h1(k) = zTopOfCell - zBottomOfCell
if (h1(k)>0.) nPoints = nPoints + 1
zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k
enddo
- h1(kd) = h1(kd) + ( zTopOfCell + G%bathyT(i,j) ) ! In case data is deeper than model
+ h1(kd) = h1(kd) + ( zTopOfCell + z_bathy ) ! In case data is deeper than model
else
tr(i,j,:) = 0.
endif ! mask2dT
- hSrc(i,j,:) = h1(:)
+ hSrc(i,j,:) = GV%Z_to_H * h1(:)
enddo ; enddo
call ALE_remap_scalar(remapCS, G, GV, kd, hSrc, tr_z, h, tr, all_cells=.false. )
deallocate( hSrc )
deallocate( h1 )
- deallocate( h2 )
- deallocate( hTarget )
- deallocate( tmpT1d )
- deallocate( tmpT1dIn )
- deallocate( deltaE )
do k=1,nz
- call myStats(tr(:,:,k),missing_value,is,ie,js,je,k,'Tracer from ALE()')
+ call myStats(tr(:,:,k), missing_value, is, ie, js, je, k, 'Tracer from ALE()')
enddo
call cpu_clock_end(id_clock_ALE)
endif ! useALEremapping
@@ -204,5 +182,4 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam,
end subroutine MOM_initialize_tracer_from_Z
-
end module MOM_tracer_initialization_from_Z
diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90
index 8d022d97cc..23bda0fce0 100644
--- a/src/initialization/midas_vertmap.F90
+++ b/src/initialization/midas_vertmap.F90
@@ -1,80 +1,42 @@
-module midas_vertmap
+!> Routines for initialization callable from MOM6 or Python (MIDAS)
+module MIDAS_vertmap
! This file is part of MOM6. See LICENSE.md for the license.
-!***********************************************************************
-!#
-!# This module contains various subroutines related to
-!# mapping a gridded field from z-space
-!# into a Lagrangian vertical coordinate, such as potential
-!# density and vice-versa. It was originally developed at NOAA/GFDL by
-!# Matthew.Harrison@noaa.gov as part of his participation
-!# in the development of the Generalized Ocean Layered Dynamics
-!# (MOM) ocean model.
-!#
-!# These routines are callable from C/Python/F90 interfaces.
-!# Python Usage example:
-!# >python
-!# from midas import *
-!# grid=gold_grid('ocean_geometry.nc')
-!# grid_obs=generic_grid('temp_salt_z.nc',var='PTEMP')
-!# S=state(path='temp_salt_z.nc',grid=grid_obs,
-!# fields=['PTEMP','SALT'],date_bounds=[datetime(1900,1,1,0,0,0),
-!# datetime(1900,1,30,0,0,0)],default_calendar='noleap')
-!# fvgrid=nc.Dataset('/net3/mjh/models/CM2G/Vertical_coordinate.nc')
-!# R=fvgrid.variables['R'][:]
-!# nkml=2;nkbl=2;min_depth=10.0;p_ref=2.e7;hml=5.0;fit_target=True
-!# T=S.horiz_interp('PTEMP',target=grid,src_modulo=True,method='bilinear')
-!# T=S.horiz_interp('SALT',target=grid,src_modulo=True,method='bilinear',PrevState=T)
-!# T.remap_Z_to_layers('PTEMP','SALT',R,p_ref,grid.wet,nkml,nkbl,hml,fit_target)
-!#
-!# MIDAS === Modular Isosurface Data Analysis Software
-!# ==================================================================
-
+! If calling from MOM6, use MOM6 interfaces for EOS functions
#ifndef PY_SOLO
- use MOM_EOS, only : EOS_type, calculate_density,calculate_density_derivs
+use MOM_EOS, only : EOS_type, calculate_density,calculate_density_derivs
- implicit none ; private
+implicit none ; private
- public tracer_z_init, determine_temperature, fill_boundaries
- public find_interfaces, meshgrid
+public tracer_z_init, determine_temperature, fill_boundaries
+public find_interfaces, meshgrid
#endif
- interface fill_boundaries
- module procedure fill_boundaries_real
- module procedure fill_boundaries_int
- end interface
-
- real, parameter :: epsln=1.e-10
+!> Fill grid edges
+interface fill_boundaries
+ module procedure fill_boundaries_real
+ module procedure fill_boundaries_int
+end interface
+! real, parameter :: epsln=1.e-10 !< A hard-wired constant!
+ !! \todo Get rid of this constant
contains
-
-
-
#ifdef PY_SOLO
-!#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!# These EOS routines are needed only for the stand-alone version of the code
-
+!> Calculate seawater equation of state, given T[degC],S[PSU],p[Pa]
+!! Returns density [kg m-3]
+!!
+!! These EOS routines are needed only for the stand-alone version of the code
+!! The subroutines in this file implement the equation of state for
+!! sea water using the formulae given by Wright, 1997, J. Atmos.
+!! Ocean. Tech., 14, 735-740.
function wright_eos_2d(T,S,p) result(rho)
-!
-!**********************************************************************
-! The subroutines in this file implement the equation of state for *
-! sea water using the formulae given by Wright, 1997, J. Atmos. *
-! Ocean. Tech., 14, 735-740. *
-! ***********************************************************************
-!
-
-! Calculate seawater equation of state, given T[degC],S[PSU],p[Pa]
-! Returns density [kg m-3]
-
- real(kind=8), dimension(:,:), intent(in) :: T,S
- real, intent(in) :: p
-
- real(kind=8), dimension(size(T,1),size(T,2)) :: rho
-
-
+ real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu)
+ real, intent(in) :: p !< pressure (Pa)
+ real(kind=8), dimension(size(T,1),size(T,2)) :: rho !< potential density (kg m-3)
+ ! Local variables
real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5
real(kind=8) :: al0,lam,p0,I_denom
integer :: i,k
@@ -97,918 +59,769 @@ function wright_eos_2d(T,S,p) result(rho)
enddo
enddo
-
return
end function wright_eos_2d
+!> Calculate seawater thermal expansion coefficient given T[degC],S[PSU],p[Pa]
+!! Returns density [kg m-3 C-1]
+!!
+!! The subroutines in this file implement the equation of state for
+!! sea water using the formulae given by Wright, 1997, J. Atmos.
+!! Ocean. Tech., 14, 735-740.
function alpha_wright_eos_2d(T,S,p) result(drho_dT)
+ real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu)
+ real, intent(in) :: p !< pressure (Pa)
+ real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with
+ !! respect to temperature (kg m-3 C-1)
+ ! Local variables
+ real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5
+ real(kind=8) :: al0,lam,p0,I_denom,I_denom2
+ integer :: i,k
-! **********************************************************************
-! The subroutines in this file implement the equation of state for *
-! sea water using the formulae given by Wright, 1997, J. Atmos. *
-! Ocean. Tech., 14, 735-740. *
-! ***********************************************************************
-
-! Calculate seawater thermal expansion coefficient given T[degC],S[PSU],p[Pa]
-! Returns density [kg m-3 C-1]
-
-real(kind=8), dimension(:,:), intent(in) :: T,S
-real, intent(in) :: p
-real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT
-
-real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5
-real(kind=8) :: al0,lam,p0,I_denom,I_denom2
-integer :: i,k
-
-a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7
-b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4
-b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3
-c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422
-c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464
-
-do k=1,size(T,2)
- do i=1,size(T,1)
- al0 = a0 + a1*T(i,k) +a2*S(i,k)
- p0 = b0 + b4*S(i,k) + T(i,k) * (b1 + T(i,k)*(b2 + &
- b3*T(i,k)) + b5*S(i,k))
- lam = c0 +c4*S(i,k) + T(i,k) * (c1 + T(i,k)*(c2 + &
- c3*T(i,k)) + c5*S(i,k))
- I_denom = 1.0 / (lam + al0*(p+p0))
- I_denom2 = I_denom*I_denom
- drho_dT(i,k) = I_denom2*(lam*(b1+T(i,k)*(2*b2 + &
- 3*b3*T(i,k)) + b5*S(i,k)) - (p+p0)*((p+p0)*a1 + &
- (c1+T(i,k)*(2*c2 + 3*c3*T(i,k)) + c5*S(i,k))))
- enddo
-enddo
+ a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7
+ b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4
+ b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3
+ c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422
+ c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464
+ do k=1,size(T,2)
+ do i=1,size(T,1)
+ al0 = a0 + a1*T(i,k) +a2*S(i,k)
+ p0 = b0 + b4*S(i,k) + T(i,k) * (b1 + T(i,k)*(b2 + &
+ b3*T(i,k)) + b5*S(i,k))
+ lam = c0 +c4*S(i,k) + T(i,k) * (c1 + T(i,k)*(c2 + &
+ c3*T(i,k)) + c5*S(i,k))
+ I_denom = 1.0 / (lam + al0*(p+p0))
+ I_denom2 = I_denom*I_denom
+ drho_dT(i,k) = I_denom2*(lam*(b1+T(i,k)*(2*b2 + &
+ 3*b3*T(i,k)) + b5*S(i,k)) - (p+p0)*((p+p0)*a1 + &
+ (c1+T(i,k)*(2*c2 + 3*c3*T(i,k)) + c5*S(i,k))))
+ enddo
+ enddo
-return
+ return
end function alpha_wright_eos_2d
+!> Calculate seawater haline expansion coefficient given T[degC],S[PSU],p[Pa]
+!! Returns density [kg m-3 PSU-1]
+!!
+!! The subroutines in this file implement the equation of state for
+!! sea water using the formulae given by Wright, 1997, J. Atmos.
+!! Ocean. Tech., 14, 735-740.
function beta_wright_eos_2d(T,S,p) result(drho_dS)
+ real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and salinity (psu)
+ real, intent(in) :: p !< pressure (Pa)
+ real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with
+ !! respect to salinity (kg m-3 PSU-1)
+ ! Local variables
+ real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5
+ real(kind=8) :: al0,lam,p0,I_denom,I_denom2
+ integer :: i,k
-! **********************************************************************
-! The subroutines in this file implement the equation of state for *
-! sea water using the formulae given by Wright, 1997, J. Atmos. *
-! Ocean. Tech., 14, 735-740. *
-! ***********************************************************************
-
-! Calculate seawater haline expansion coefficient given T[degC],S[PSU],p[Pa]
-! Returns density [kg m-3 PSU-1]
-
-real(kind=8), dimension(:,:), intent(in) :: T,S
-real, intent(in) :: p
-
-real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS
-
-
-
-real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5
-real(kind=8) :: al0,lam,p0,I_denom,I_denom2
-integer :: i,k
-
-a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7
-b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4
-b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3
-c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422
-c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464
+ a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7
+ b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4
+ b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3
+ c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422
+ c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464
-do k=1,size(T,2)
- do i=1,size(T,1)
- al0 = a0 + a1*T(i,k) +a2*S(i,k)
- p0 = b0 + b4*S(i,k) + T(i,k) * (b1 + T(i,k)*(b2 + &
- b3*T(i,k)) + b5*S(i,k))
- lam = c0 +c4*S(i,k) + T(i,k) * (c1 + T(i,k)*(c2 + &
- c3*T(i,k)) + c5*S(i,k))
- I_denom = 1.0 / (lam + al0*(p+p0))
- I_denom2 = I_denom*I_denom
- drho_dS(i,k) = I_denom2*(lam*(b4+b5*T(i,k)) - &
- (p+p0)*((p+p0)*a2 + (c4+c5*T(i,k))))
+ do k=1,size(T,2)
+ do i=1,size(T,1)
+ al0 = a0 + a1*T(i,k) +a2*S(i,k)
+ p0 = b0 + b4*S(i,k) + T(i,k) * (b1 + T(i,k)*(b2 + &
+ b3*T(i,k)) + b5*S(i,k))
+ lam = c0 +c4*S(i,k) + T(i,k) * (c1 + T(i,k)*(c2 + &
+ c3*T(i,k)) + c5*S(i,k))
+ I_denom = 1.0 / (lam + al0*(p+p0))
+ I_denom2 = I_denom*I_denom
+ drho_dS(i,k) = I_denom2*(lam*(b4+b5*T(i,k)) - &
+ (p+p0)*((p+p0)*a2 + (c4+c5*T(i,k))))
+ enddo
enddo
-enddo
-
-return
+ return
end function beta_wright_eos_2d
-
-!# END STAND-ALONE ROUTINES
-!#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#endif
-function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug,i_debug,j_debug) result(tr)
-!
-! Adopted from R. Hallberg
-! Arguments:
-! (in) tr_in - The z-space array of tracer concentrations that is read in.
-! (in) z_edges - The depths of the cell edges in the input z* data (m)
-! (in) e - The depths of the layer interfaces (m)
-! (in) nkml - number of mixed layer pieces
-! (in) nkbl - number of buffer layer pieces
-! (in) land_fill - fill in data over land
-! (in) wet - wet mask (1=ocean)
-! (in) nlay - number of layers
-! (in) nlevs - number of levels
-
-! (out) tr - tracers on layers
-
-! tr_1d ! A copy of the input tracer concentrations in a column.
-! wt ! The fractional weight for each layer in the range between
- ! k_top and k_bot, nondim.
-! z1 ! z1 and z2 are the depths of the top and bottom limits of the part
-! z2 ! of a z-cell that contributes to a layer, relative to the cell
-! center and normalized by the cell thickness, nondim.
-! Note that -1/2 <= z1 <= z2 <= 1/2.
-!
-real, dimension(:,:,:), intent(in) :: tr_in
-real, dimension(size(tr_in,3)+1), intent(in) :: z_edges
-integer, intent(in) :: nlay
-real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), intent(in) :: e
-integer, intent(in) :: nkml,nkbl
-real, intent(in) :: land_fill
-real, dimension(size(tr_in,1),size(tr_in,2)), intent(in) :: wet
-real, dimension(size(tr_in,1),size(tr_in,2)), optional, intent(in) ::nlevs
-logical, optional, intent(in) :: debug
-integer, optional, intent(in) :: i_debug, j_debug
-
-real, dimension(size(tr_in,1),size(tr_in,2),nlay) :: tr
-real, dimension(size(tr_in,3)) :: tr_1d
-real, dimension(nlay+1) :: e_1d
-real, dimension(nlay) :: tr_
-integer, dimension(size(tr_in,1),size(tr_in,2)) :: nlevs_data
-
-integer :: n,i,j,k,l,nx,ny,nz,nt,kz
-integer :: k_top,k_bot,k_bot_prev,kk,kstart
-real :: sl_tr
-real, dimension(size(tr_in,3)) :: wt,z1,z2
-logical :: debug_msg, debug_
-
-nx = size(tr_in,1); ny=size(tr_in,2); nz = size(tr_in,3)
-
-nlevs_data = size(tr_in,3)
-if (PRESENT(nlevs)) then
- nlevs_data = anint(nlevs)
-endif
-
-debug_=.false.
-if (PRESENT(debug)) then
- debug_=debug
-endif
-
-debug_msg = .false.
-if (debug_) then
- debug_msg=.true.
-endif
-
-
-do j=1,ny
- i_loop: do i=1,nx
- if (nlevs_data(i,j) == 0 .or. wet(i,j) == 0.) then
- tr(i,j,:) = land_fill
- cycle i_loop
- endif
-
- do k=1,nz
- tr_1d(k) = tr_in(i,j,k)
- enddo
+!> Layer model routine for remapping tracers
+function tracer_z_init(tr_in, z_edges, e, nkml, nkbl, land_fill, wet, nlay, nlevs, &
+ debug, i_debug, j_debug, eps_z) result(tr)
+ real, dimension(:,:,:), intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in.
+ real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data (Z or m)
+ integer, intent(in) :: nlay !< The number of vertical layers in the target grid
+ real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), &
+ intent(in) :: e !< The depths of the target layer interfaces (Z or m)
+ integer, intent(in) :: nkml !< The number of mixed layers
+ integer, intent(in) :: nkbl !< The number of buffer layers
+ real, intent(in) :: land_fill !< fill in data over land (1)
+ real, dimension(size(tr_in,1),size(tr_in,2)), &
+ intent(in) :: wet !< The wet mask for the source data (valid points)
+ real, dimension(size(tr_in,1),size(tr_in,2)), &
+ optional, intent(in) :: nlevs !< The number of input levels with valid data
+ logical, optional, intent(in) :: debug !< optional debug flag
+ integer, optional, intent(in) :: i_debug !< i-index of point for debugging
+ integer, optional, intent(in) :: j_debug !< j-index of point for debugging
+ real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z.
+ real, dimension(size(tr_in,1),size(tr_in,2),nlay) :: tr !< tracers in layer space
+
+ ! Local variables
+ real, dimension(size(tr_in,3)) :: tr_1d !< a copy of the input tracer concentrations in a column.
+ real, dimension(nlay+1) :: e_1d ! A 1-d column of intreface heights, in the same units as e.
+ real, dimension(nlay) :: tr_ ! A 1-d column of tracer concentrations
+ integer, dimension(size(tr_in,1),size(tr_in,2)) :: nlevs_data !< number of valid levels in the input dataset
+ integer :: n,i,j,k,l,nx,ny,nz,nt,kz
+ integer :: k_top,k_bot,k_bot_prev,kk,kstart
+ real :: sl_tr ! The tracer concentration slope times the layer thickess, in tracer units.
+ real :: epsln_Z ! A negligibly thin layer thickness, in Z.
+ real, dimension(size(tr_in,3)) :: wt !< The fractional weight for each layer in the range between z1 and z2
+ real, dimension(size(tr_in,3)) :: z1, z2 ! z1 and z2 are the fractional depths of the top and bottom
+ ! limits of the part of a z-cell that contributes to a layer, relative
+ ! to the cell center and normalized by the cell thickness, nondim.
+ ! Note that -1/2 <= z1 <= z2 <= 1/2.
+
+ logical :: debug_msg, debug_, debug_pt
+
+ nx = size(tr_in,1); ny=size(tr_in,2); nz = size(tr_in,3)
+
+ nlevs_data = size(tr_in,3)
+ if (PRESENT(nlevs)) nlevs_data = anint(nlevs)
+ epsln_Z = 1.0e-10 ; if (PRESENT(eps_z)) epsln_Z = eps_z
+
+ debug_=.false. ; if (PRESENT(debug)) debug_ = debug
+ debug_msg = debug_
+ debug_pt = debug_ ; if (PRESENT(i_debug) .and. PRESENT(j_debug)) debug_pt = debug_
+
+ do j=1,ny
+ i_loop: do i=1,nx
+ if (nlevs_data(i,j) == 0 .or. wet(i,j) == 0.) then
+ tr(i,j,:) = land_fill
+ cycle i_loop
+ endif
- do k=1,nlay+1
- e_1d(k) = e(i,j,k)
- enddo
- k_bot = 1 ; k_bot_prev = -1
- do k=1,nlay
- if (e_1d(k+1) > z_edges(1)) then
- tr(i,j,k) = tr_1d(1)
- elseif (e_1d(k) < z_edges(nlevs_data(i,j)+1)) then
- if (debug_msg) then
- print *,'*** WARNING : Found interface below valid range of z data '
- print *,'(i,j,z_bottom,interface)= ',&
- i,j,z_edges(nlevs_data(i,j)+1),e_1d(k)
- print *,'z_edges= ',z_edges
- print *,'e=',e_1d
- print *,'*** I will extrapolate below using the bottom-most valid values'
- debug_msg = .false.
- endif
- tr(i,j,k) = tr_1d(nlevs_data(i,j))
+ do k=1,nz
+ tr_1d(k) = tr_in(i,j,k)
+ enddo
- else
- kstart=k_bot
- call find_overlap(z_edges, e_1d(k), e_1d(k+1), nlevs_data(i,j), &
- kstart, k_top, k_bot, wt, z1, z2)
-
- if (debug_) then
- if (PRESENT(i_debug)) then
- if (i == i_debug.and.j == j_debug) then
- print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1)
- endif
- endif
- endif
- kz = k_top
- sl_tr=0.0; ! cur_tr=0.0
- if (kz /= k_bot_prev) then
-! Calculate the intra-cell profile.
- if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then
- sl_tr = find_limited_slope(tr_1d, z_edges, kz)
+ do k=1,nlay+1
+ e_1d(k) = e(i,j,k)
+ enddo
+ k_bot = 1 ; k_bot_prev = -1
+ do k=1,nlay
+ if (e_1d(k+1) > z_edges(1)) then
+ tr(i,j,k) = tr_1d(1)
+ elseif (e_1d(k) < z_edges(nlevs_data(i,j)+1)) then
+ if (debug_msg) then
+ print *,'*** WARNING : Found interface below valid range of z data '
+ print *,'(i,j,z_bottom,interface)= ',&
+ i,j,z_edges(nlevs_data(i,j)+1),e_1d(k)
+ print *,'z_edges= ',z_edges
+ print *,'e=',e_1d
+ print *,'*** I will extrapolate below using the bottom-most valid values'
+ debug_msg = .false.
endif
- endif
- if (kz > nlevs_data(i,j)) kz = nlevs_data(i,j)
-! This is the piecewise linear form.
- tr(i,j,k) = wt(kz) * &
- (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz)))
-! For the piecewise parabolic form add the following...
-! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2))
-! if (debug_) then
-! print *,'k,k_top,k_bot= ',k,k_top,k_bot
-! endif
- if (debug_) then
- if (PRESENT(i_debug)) then
- if (i == i_debug.and.j == j_debug) then
- print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr
- endif
- endif
- endif
-
- do kz=k_top+1,k_bot-1
- tr(i,j,k) = tr(i,j,k) + wt(kz)*tr_1d(kz)
- enddo
+ tr(i,j,k) = tr_1d(nlevs_data(i,j))
+
+ else
+ kstart=k_bot
+ call find_overlap(z_edges, e_1d(k), e_1d(k+1), nlevs_data(i,j), &
+ kstart, k_top, k_bot, wt, z1, z2)
+
+ if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then
+ print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1)
+ endif ; endif
+ kz = k_top
+ sl_tr=0.0; ! cur_tr=0.0
+ if (kz /= k_bot_prev) then
+ ! Calculate the intra-cell profile.
+ if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then
+ sl_tr = find_limited_slope(tr_1d, z_edges, kz)
+ endif
+ endif
+ if (kz > nlevs_data(i,j)) kz = nlevs_data(i,j)
+ ! This is the piecewise linear form.
+ tr(i,j,k) = wt(kz) * (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz)))
+ ! For the piecewise parabolic form add the following...
+ ! + C1_3*wt(kz) * cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2))
+ if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then
+ print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr
+ endif ; endif
+
+ do kz=k_top+1,k_bot-1
+ tr(i,j,k) = tr(i,j,k) + wt(kz)*tr_1d(kz)
+ enddo
+
+ if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then
+ print *,'0003 k,tr = ',k,tr(i,j,k)
+ endif ; endif
+
+ if (k_bot > k_top) then
+ kz = k_bot
+ ! Calculate the intra-cell profile.
+ sl_tr = 0.0 ! ; cur_tr = 0.0
+ if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then
+ sl_tr = find_limited_slope(tr_1d, z_edges, kz)
+ endif
+ ! This is the piecewise linear form.
+ tr(i,j,k) = tr(i,j,k) + wt(kz) * &
+ (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz)))
+ ! For the piecewise parabolic form add the following...
+ ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2))
- if (debug_) then
- if (PRESENT(i_debug)) then
- if (i == i_debug.and.j == j_debug) then
- print *,'0003 k,tr = ',k,tr(i,j,k)
- endif
- endif
- endif
+ if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then
+ print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k)
+ print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2)
+ endif ; endif
- if (k_bot > k_top) then
- kz = k_bot
-! Calculate the intra-cell profile.
- sl_tr = 0.0 ! ; cur_tr = 0.0
- if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then
- sl_tr = find_limited_slope(tr_1d, z_edges, kz)
-! if (debug_) then
-! print *,'002 sl_tr,k,kz,nlevs= ',sl_tr,k,kz,nlevs_data(i,j),nlevs(i,j)
-! endif
- endif
-! This is the piecewise linear form.
- tr(i,j,k) = tr(i,j,k) + wt(kz) * &
- (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz)))
-! For the piecewise parabolic form add the following...
-! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2))
-
- if (debug_) then
- if (PRESENT(i_debug)) then
- if (i == i_debug.and.j == j_debug) then
- print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k)
- print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2)
- endif
- endif
endif
+ k_bot_prev = k_bot
endif
- k_bot_prev = k_bot
+ enddo ! k-loop
- endif
- enddo ! k-loop
+ do k=2,nlay ! simply fill vanished layers with adjacent value
+ if (e_1d(k)-e_1d(k+1) <= epsln_Z) tr(i,j,k)=tr(i,j,k-1)
+ enddo
- do k=2,nlay ! simply fill vanished layers with adjacent value
- if (e_1d(k)-e_1d(k+1) <= epsln) tr(i,j,k)=tr(i,j,k-1)
- enddo
+ enddo i_loop
+ enddo
+
+end function tracer_z_init
- enddo i_loop
-enddo
+!> Return the index where to insert item x in list a, assuming a is sorted.
+!! The return values [i] is such that all e in a[:i-1] have e <= x, and all e in
+!! a[i:] have e > x. So if x already appears in the list, will
+!! insert just after the rightmost x already there.
+!! Optional args lo (default 1) and hi (default len(a)) bound the
+!! slice of a to be searched.
+function bisect_fast(a, x, lo, hi) result(bi_r)
+ real, dimension(:,:), intent(in) :: a !< Sorted list
+ real, dimension(:), intent(in) :: x !< Item to be inserted
+ integer, dimension(size(a,1)), optional, intent(in) :: lo !< Lower bracket of optional range to search
+ integer, dimension(size(a,1)), optional, intent(in) :: hi !< Upper bracket of optional range to search
+ integer, dimension(size(a,1),size(x,1)) :: bi_r
-return
+ integer :: mid,num_x,num_a,i
+ integer, dimension(size(a,1)) :: lo_,hi_,lo0,hi0
+ integer :: nprofs,j
-end function tracer_z_init
+ lo_=1;hi_=size(a,2);num_x=size(x,1);bi_r=-1;nprofs=size(a,1)
+ if (PRESENT(lo)) then
+ where (lo>0) lo_=lo
+ endif
+ if (PRESENT(hi)) then
+ where (hi>0) hi_=hi
+ endif
-function bisect_fast(a, x, lo, hi) result(bi_r)
-!
-! Return the index where to insert item x in list a, assuming a is sorted.
-! The return values [i] is such that all e in a[:i-1] have e <= x, and all e in
-! a[i:] have e > x. So if x already appears in the list, will
-! insert just after the rightmost x already there.
-! Optional args lo (default 1) and hi (default len(a)) bound the
-! slice of a to be searched.
-!
-! (in) a - sorted list
-! (in) x - item to be inserted
-! (in) lo, hi - optional range to search
-
-real, dimension(:,:), intent(in) :: a
-real, dimension(:), intent(in) :: x
-integer, dimension(size(a,1)), optional, intent(in) :: lo,hi
-integer, dimension(size(a,1),size(x,1)) :: bi_r
-
-integer :: mid,num_x,num_a,i
-integer, dimension(size(a,1)) :: lo_,hi_,lo0,hi0
-integer :: nprofs,j
-
-lo_=1;hi_=size(a,2);num_x=size(x,1);bi_r=-1;nprofs=size(a,1)
-
-if (PRESENT(lo)) then
- where (lo>0) lo_=lo
-endif
-if (PRESENT(hi)) then
- where (hi>0) hi_=hi
-endif
-
-lo0=lo_;hi0=hi_
-
-do j=1,nprofs
- do i=1,num_x
- lo_=lo0;hi_=hi0
- do while (lo_(j) < hi_(j))
- mid = (lo_(j)+hi_(j))/2
- if (x(i) < a(j,mid)) then
- hi_(j) = mid
- else
- lo_(j) = mid+1
- endif
+ lo0=lo_;hi0=hi_
+
+ do j=1,nprofs
+ do i=1,num_x
+ lo_=lo0;hi_=hi0
+ do while (lo_(j) < hi_(j))
+ mid = (lo_(j)+hi_(j))/2
+ if (x(i) < a(j,mid)) then
+ hi_(j) = mid
+ else
+ lo_(j) = mid+1
+ endif
+ enddo
+ bi_r(j,i)=lo_(j)
enddo
- bi_r(j,i)=lo_(j)
enddo
-enddo
-return
+ return
end function bisect_fast
-
#ifdef PY_SOLO
-subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start)
-
-! # This subroutine determines the potential temperature and
-! # salinity that is consistent with the target density
-! # using provided initial guess
-! # (inout) temp - potential temperature (degC)
-! # (inout) salt - salinity (PSU)
-! # (in) R - Desired potential density, in kg m-3.
-! # (in) p_ref - Reference pressure, in Pa.
-! # (in) niter - maximum number of iterations
-! # (in) h - layer thickness . Do not iterate for massless layers
-! # (in) k_start - starting index (i.e. below the buffer layer)
-! # (in) land_fill - land fill value
-
-real(kind=8), dimension(:,:,:), intent(inout) :: temp,salt
-real(kind=8), dimension(size(temp,3)), intent(in) :: R
-real, intent(in) :: p_ref
-integer, intent(in) :: niter
-integer, intent(in) :: k_start
-real, intent(in) :: land_fill
-real(kind=8), dimension(:,:,:), intent(in) :: h
-
-real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin
-real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS
-real(kind=8), dimension(size(temp,1)) :: press
-
-integer :: nx,ny,nz,nt,i,j,k,n,itt
-logical :: adjust_salt , old_fit
-real :: dT_dS
-real, parameter :: T_max = 35.0, T_min = -2.0
-real, parameter :: S_min = 0.5, S_max=65.0
-real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5
-
+! Only for stand-alone python
+
+!> This subroutine determines the potential temperature and salinity that
+!! is consistent with the target density using provided initial guess
+subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start)
+ real(kind=8), dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC)
+ real(kind=8), dimension(:,:,:), intent(inout) :: salt !< salinity (PSU)
+ real(kind=8), dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3.
+ real, intent(in) :: p_ref !< reference pressure, in Pa.
+ integer, intent(in) :: niter !< maximum number of iterations
+ integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer)
+ real, intent(in) :: land_fill !< land fill value
+ real(kind=8), dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers
+
+ ! Local variables
+ real, parameter :: T_max = 35.0, T_min = -2.0
#else
-
-subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos)
-
-! # This subroutine determines the potential temperature and
-! # salinity that is consistent with the target density
-! # using provided initial guess
-! # (inout) temp - potential temperature (degC)
-! # (inout) salt - salinity (PSU)
-! # (in) R - Desired potential density, in kg m-3.
-! # (in) p_ref - Reference pressure, in Pa.
-! # (in) niter - maximum number of iterations
-! # (in) h - layer thickness . Do not iterate for massless layers
-! # (in) k_start - starting index (i.e. below the buffer layer)
-! # (in) land_fill - land fill value
-! # (in) eos - seawater equation of state
-
-real, dimension(:,:,:), intent(inout) :: temp,salt
-real, dimension(size(temp,3)), intent(in) :: R
-real, intent(in) :: p_ref
-integer, intent(in) :: niter
-integer, intent(in) :: k_start
-real, intent(in) :: land_fill
-real, dimension(:,:,:), intent(in) :: h
-type(eos_type), pointer :: eos
-
-real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin
-real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS
-real(kind=8), dimension(size(temp,1)) :: press
-
-integer :: nx,ny,nz,nt,i,j,k,n,itt
-real :: dT_dS
-logical :: adjust_salt , old_fit
-real, parameter :: T_max = 31.0, T_min = -2.0
-real, parameter :: S_min = 0.5, S_max=65.0
-real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5
-
-
+!> This subroutine determines the potential temperature and salinity that
+!! is consistent with the target density using provided initial guess
+subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start, eos)
+ real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC)
+ real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU)
+ real, dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3.
+ real, intent(in) :: p_ref !< reference pressure, in Pa.
+ integer, intent(in) :: niter !< maximum number of iterations
+ integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer)
+ real, intent(in) :: land_fill !< land fill value
+ real, dimension(:,:,:), intent(in) :: h !< layer thickness, used only to avoid working on massless layers
+ type(eos_type), pointer :: eos !< seawater equation of state control structure
+
+ real, parameter :: T_max = 31.0, T_min = -2.0
#endif
-
-
-old_fit = .true. ! reproduces siena behavior
- ! will switch to the newer
- ! method which simultaneously adjusts
- ! temp and salt based on the ratio
- ! of the thermal and haline coefficients.
-
-nx=size(temp,1);ny=size(temp,2); nz=size(temp,3)
-
-press(:) = p_ref
-
-do j=1,ny
- dS(:,:) = 0. ! Needs to be zero everywhere since there is a maxval(abs(dS)) later...
- T=temp(:,j,:)
- S=salt(:,j,:)
- hin=h(:,j,:)
- dT=0.0
- adjust_salt = .true.
- iter_loop: do itt = 1,niter
+ ! Local variables (All of which need documentation!)
+ real(kind=8), dimension(size(temp,1),size(temp,3)) :: T, S, dT, dS, rho, hin
+ real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT, drho_dS
+ real(kind=8), dimension(size(temp,1)) :: press
+ integer :: nx, ny, nz, nt, i, j, k, n, itt
+ real :: dT_dS
+ logical :: adjust_salt, old_fit
+ real, parameter :: S_min = 0.5, S_max=65.0
+ real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5
+
+ old_fit = .true. ! reproduces siena behavior
+ ! will switch to the newer method which simultaneously adjusts
+ ! temp and salt based on the ratio of the thermal and haline coefficients.
+
+ nx=size(temp,1) ; ny=size(temp,2) ; nz=size(temp,3)
+
+ press(:) = p_ref
+
+ do j=1,ny
+ dS(:,:) = 0. ! Needs to be zero everywhere since there is a maxval(abs(dS)) later...
+ T=temp(:,j,:)
+ S=salt(:,j,:)
+ hin=h(:,j,:)
+ dT=0.0
+ adjust_salt = .true.
+ iter_loop: do itt = 1,niter
#ifdef PY_SOLO
- rho=wright_eos_2d(T,S,p_ref)
- drho_dT=alpha_wright_eos_2d(T,S,p_ref)
+ rho=wright_eos_2d(T,S,p_ref)
+ drho_dT=alpha_wright_eos_2d(T,S,p_ref)
#else
- do k=1, nz
- 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)
- enddo
+ do k=1, nz
+ 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)
+ enddo
#endif
- do k=k_start,nz
- do i=1,nx
+ do k=k_start,nz ; do i=1,nx
-! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln) then
+! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln) then
if (abs(rho(i,k)-R(k))>tol) then
- if (old_fit) then
- dT(i,k)=(R(k)-rho(i,k))/drho_dT(i,k)
- if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj
- if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj
- T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min)
- else
- dT_dS = 10.0 - min(-drho_dT(i,k)/drho_dS(i,k),10.)
- dS(i,k) = (R(k)-rho(i,k))/(drho_dS(i,k) - drho_dT(i,k)*dT_dS )
- dT(i,k)= -dT_dS*dS(i,k)
- ! if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj
- ! if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj
- T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min)
- S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min)
- endif
+ if (old_fit) then
+ dT(i,k) = max(min((R(k)-rho(i,k)) / drho_dT(i,k), max_t_adj), -max_t_adj)
+ T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min)
+ else
+ dT_dS = 10.0 - min(-drho_dT(i,k)/drho_dS(i,k),10.)
+ !### RWH: Based on the dimensions alone, the expression above should be:
+ ! dT_dS = 10.0 - min(-drho_dS(i,k)/drho_dT(i,k),10.)
+ dS(i,k) = (R(k)-rho(i,k)) / (drho_dS(i,k) - drho_dT(i,k)*dT_dS )
+ dT(i,k) = -dT_dS*dS(i,k)
+ ! dT(i,k) = max(min(dT(i,k), max_t_adj), -max_t_adj)
+ T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min)
+ S(i,k) = max(min(S(i,k)+dS(i,k), S_max), S_min)
+ endif
endif
- enddo
- enddo
- if (maxval(abs(dT)) < tol) then
- adjust_salt = .false.
- exit iter_loop
- endif
- enddo iter_loop
+ enddo ; enddo
+ if (maxval(abs(dT)) < tol) then
+ adjust_salt = .false.
+ exit iter_loop
+ endif
+ enddo iter_loop
- if (adjust_salt .and. old_fit) then
- iter_loop2: do itt = 1,niter
+ if (adjust_salt .and. old_fit) then ; do itt = 1,niter
#ifdef PY_SOLO
- rho=wright_eos_2d(T,S,p_ref)
- drho_dS=beta_wright_eos_2d(T,S,p_ref)
+ rho = wright_eos_2d(T,S,p_ref)
+ drho_dS = beta_wright_eos_2d(T,S,p_ref)
#else
do k=1, nz
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)
enddo
#endif
- do k=k_start,nz
- do i=1,nx
-! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln ) then
- if (abs(rho(i,k)-R(k))>tol ) then
- dS(i,k)=(R(k)-rho(i,k))/drho_dS(i,k)
- if (dS(i,k)>max_s_adj) dS(i,k)=max_s_adj
- if (dS(i,k)<-1.0*max_s_adj) dS(i,k)=-1.0*max_s_adj
- S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min)
- endif
- enddo
- enddo
- if (maxval(abs(dS)) < tol) then
- exit iter_loop2
- endif
- enddo iter_loop2
- endif
-
- temp(:,j,:)=T(:,:)
- salt(:,j,:)=S(:,:)
-enddo
-
+ do k=k_start,nz ; do i=1,nx
+! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln ) then
+ if (abs(rho(i,k)-R(k)) > tol) then
+ dS(i,k) = max(min((R(k)-rho(i,k)) / drho_dS(i,k), max_s_adj), -max_s_adj)
+ S(i,k) = max(min(S(i,k)+dS(i,k), S_max), S_min)
+ endif
+ enddo ; enddo
+ if (maxval(abs(dS)) < tol) exit
+ enddo ; endif
-return
+ temp(:,j,:)=T(:,:)
+ salt(:,j,:)=S(:,:)
+ enddo
end subroutine determine_temperature
-
+!> This subroutine determines the layers bounded by interfaces e that overlap
+!! with the depth range between Z_top and Z_bot, and also the fractional weights
+!! of each layer. It also calculates the normalized relative depths of the range
+!! of each layer that overlaps that depth range.
+!! Note that by convention, e decreases with increasing k and Z_top > Z_bot.
subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2)
+ real, dimension(:), intent(in) :: e !< The interface positions, in m or Z.
+ real, intent(in) :: Z_top !< The top of the range being mapped to, in m or Z.
+ real, intent(in) :: Z_bot !< The bottom of the range being mapped to, in m or Z.
+ integer, intent(in) :: k_max !< The number of valid layers.
+ integer, intent(in) :: k_start !< The layer at which to start searching.
+ integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range.
+ integer, intent(out) :: k_bot !< The index of the bottom layer that overlap with the depth range.
+ real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot, nondim.
+ real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level, nondim.
+ real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level, nondim.
+
+ ! Local variables
+ real :: Ih, e_c, tot_wt, I_totwt
+ integer :: k
+
+ wt(:)=0.0 ; z1(:)=0.0 ; z2(:)=0.0
+ k_top = k_start ; k_bot = k_start ; wt(1) = 1.0 ; z1(1) = -0.5 ; z2(1) = 0.5
+
+ do k=k_start,k_max ; if (e(K+1) < Z_top) exit ; enddo
+ k_top = k
+
+ if (k>k_max) return
+
+ ! Determine the fractional weights of each layer.
+ ! Note that by convention, e and Z_int decrease with increasing k.
+ if (e(K+1) <= Z_bot) then
+ wt(k) = 1.0 ; k_bot = k
+ Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1))
+ e_c = 0.5*(e(K)+e(K+1))
+ z1(k) = (e_c - MIN(e(K), Z_top)) * Ih
+ z2(k) = (e_c - Z_bot) * Ih
+ else
+ wt(k) = MIN(e(K),Z_top) - e(K+1) ; tot_wt = wt(k) ! These are always > 0.
+ ! Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1))
+ if (e(K) /= e(K+1)) then
+ z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K), Z_top)) / (e(K)-e(K+1))
+ else ; z1(k) = -0.5 ; endif
+ z2(k) = 0.5
+ k_bot = k_max
+ do k=k_top+1,k_max
+ if (e(K+1) <= Z_bot) then
+ k_bot = k
+ wt(k) = e(K) - Z_bot ; z1(k) = -0.5
+ if (e(K) /= e(K+1)) then
+ z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1))
+ else ; z2(k) = 0.5 ; endif
+ else
+ wt(k) = e(K) - e(K+1) ; z1(k) = -0.5 ; z2(k) = 0.5
+ endif
+ tot_wt = tot_wt + wt(k) ! wt(k) is always > 0.
+ if (k>=k_bot) exit
+ enddo
-! This subroutine determines the layers bounded by interfaces e that overlap
-! with the depth range between Z_top and Z_bot, and also the fractional weights
-! of each layer. It also calculates the normalized relative depths of the range
-! of each layer that overlaps that depth range.
-! Note that by convention, e decreases with increasing k and Z_top > Z_bot.
-!
-! Arguments: e - A column's interface heights, in m.
-! (in) Z_top - The top of the range being mapped to, in m.
-! (in) Z_bot - The bottom of the range being mapped to, in m.
-! (in) k_max - The number of valid layers.
-! (in) k_start - The layer at which to start searching.
-! (out) k_top, k_bot - The indices of the top and bottom layers that
-! overlap with the depth range.
-! (out) wt - The relative weights of each layer from k_top to k_bot.
-! (out) z1, z2 - z1 and z2 are the depths of the top and bottom limits of
-! the part of a layer that contributes to a depth level,
-! relative to the cell center and normalized by the cell
-! thickness, nondim. Note that -1/2 <= z1 < z2 <= 1/2.
-
-real, dimension(:), intent(in) :: e
-real, intent(in) :: Z_top, Z_bot
-integer, intent(in) :: k_max, k_start
-integer, intent(out) :: k_top, k_bot
-real, dimension(:), intent(out) :: wt, z1, z2
-
-real :: Ih, e_c, tot_wt, I_totwt
-integer :: k
-
-wt(:)=0.0; z1(:)=0.0; z2(:)=0.0
-k_top = k_start; k_bot= k_start; wt(1) = 1.0; z1(1)=-0.5; z2(1) = 0.5
-
-do k=k_start,k_max ;if (e(k+1)k_max) return
-
-! Determine the fractional weights of each layer.
-! Note that by convention, e and Z_int decrease with increasing k.
-if (e(k+1)<=Z_bot) then
- wt(k) = 1.0 ; k_bot = k
- Ih = 1.0 / (e(k)-e(k+1))
- e_c = 0.5*(e(k)+e(k+1))
- z1(k) = (e_c - MIN(e(k),Z_top)) * Ih
- z2(k) = (e_c - Z_bot) * Ih
-else
- wt(k) = MIN(e(k),Z_top) - e(k+1) ; tot_wt = wt(k) ! These are always > 0.
- z1(k) = (0.5*(e(k)+e(k+1)) - MIN(e(k),Z_top)) / (e(k)-e(k+1))
- z2(k) = 0.5
- k_bot = k_max
- do k=k_top+1,k_max
- if (e(k+1)<=Z_bot) then
- k_bot = k
- wt(k) = e(k) - Z_bot ; z1(k) = -0.5
- z2(k) = (0.5*(e(k)+e(k+1)) - Z_bot) / (e(k)-e(k+1))
- else
- wt(k) = e(k) - e(k+1) ; z1(k) = -0.5 ; z2(k) = 0.5
- endif
- tot_wt = tot_wt + wt(k) ! wt(k) is always > 0.
- if (k>=k_bot) exit
- enddo
-
- I_totwt = 1.0 / tot_wt
- do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo
-endif
-
-return
+ I_totwt = 0.0 ; if (tot_wt > 0.0) I_totwt = 1.0 / tot_wt
+ do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo
+ endif
end subroutine find_overlap
-
+!> This subroutine determines a limited slope for val to be advected with
+!! a piecewise limited scheme.
function find_limited_slope(val, e, k) result(slope)
-
-! This subroutine determines a limited slope for val to be advected with
-! a piecewise limited scheme.
-
-! Arguments: val - An column the values that are being interpolated.
-! (in) e - A column's interface heights, in m.
-! (in) slope - The normalized slope in the intracell distribution of val.
-! (in) k - The layer whose slope is being determined.
-
-
-real, dimension(:), intent(in) :: val
-real, dimension(:), intent(in) :: e
-integer, intent(in) :: k
-real :: slope
-real :: amx,bmx,amn,bmn,cmn,dmn
-
-real :: d1, d2
-
-if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then
- slope = 0.0 ! ; curvature = 0.0
-else
- d1 = 0.5*(e(k-1)-e(k+1)) ; d2 = 0.5*(e(k)-e(k+2))
- slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * &
- (e(k) - e(k+1)) / (d1*d2*(d1+d2))
-! slope = 0.5*(val(k+1) - val(k-1))
-! This is S.J. Lin's form of the PLM limiter.
- amx=max(val(k-1),val(k))
- bmx = max(amx,val(k+1))
- amn = min(abs(slope),2.0*(bmx-val(k)))
- bmn = min(val(k-1),val(k))
- cmn = 2.0*(val(k)-min(bmn,val(k+1)))
- dmn = min(amn,cmn)
- slope = sign(1.0,slope) * dmn
-
-! min(abs(slope), &
-! 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), &
-! 2.0*(val(k) - min(val(k-1),val(k),val(k+1))))
-! curvature = 0.0
-endif
-
-return
+ real, dimension(:), intent(in) :: val !< An column the values that are being interpolated.
+ real, dimension(:), intent(in) :: e !< A column's interface heights, in Z or m.
+ integer, intent(in) :: k !< The layer whose slope is being determined.
+ real :: slope !< The normalized slope in the intracell distribution of val.
+ ! Local variables
+ real :: amn, cmn
+ real :: d1, d2
+
+ if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then
+ slope = 0.0 ! ; curvature = 0.0
+ else
+ d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2))
+ if (d1*d2 > 0.0) then
+ slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * &
+ (e(K) - e(K+1)) / (d1*d2*(d1+d2))
+ ! slope = 0.5*(val(k+1) - val(k-1))
+ ! This is S.J. Lin's form of the PLM limiter.
+ amn = min(abs(slope), 2.0*(max(val(k-1), val(k), val(k+1)) - val(k)))
+ cmn = 2.0*(val(k) - min(val(k-1), val(k), val(k+1)))
+ slope = sign(1.0, slope) * min(amn, cmn)
+
+ ! min(abs(slope), 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), &
+ ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1))))
+ ! curvature = 0.0
+ else
+ slope = 0.0 ! ; curvature = 0.0
+ endif
+ endif
end function find_limited_slope
-function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi)
-! (in) rho : potential density in z-space (kg m-3)
-! (in) zin : levels (m)
-! (in) Rb : target interface densities (kg m-3)
-! (in) depth: ocean depth (m)
-! (in) nlevs: number of valid points in each column
-! (in) nkml : number of mixed layer pieces
-! (in) nkbl : number of buffer layer pieces
-! (in) hml : mixed layer depth
-
-real, dimension(:,:,:), &
- intent(in) :: rho
-real, dimension(size(rho,3)), &
- intent(in) :: zin
-real, dimension(:), intent(in) :: Rb
-real, dimension(size(rho,1),size(rho,2)), &
- intent(in) :: depth
-real, dimension(size(rho,1),size(rho,2)), &
- optional, intent(in) ::nlevs
-logical, optional, intent(in) :: debug
-integer, optional, intent(in) :: nkml
-integer, optional, intent(in) :: nkbl
-real, optional, intent(in) :: hml
-real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi
-
-real, dimension(size(rho,1),size(rho,3)) :: rho_
-real, dimension(size(rho,1)) :: depth_
-logical :: unstable
-integer :: dir
-integer, dimension(size(rho,1),size(Rb,1)) :: ki_
-real, dimension(size(rho,1),size(Rb,1)) :: zi_
-integer, dimension(size(rho,1),size(rho,2)) :: nlevs_data
-integer, dimension(size(rho,1)) :: lo,hi
-real :: slope,rsm,drhodz,hml_
-integer :: n,i,j,k,l,nx,ny,nz,nt
-integer :: nlay,kk,nkml_,nkbl_
-logical :: debug_ = .false.
-
-real, parameter :: zoff=0.999
-
-nlay=size(Rb)-1
-
-zi(:,:,:) = 0.0
-
-if (PRESENT(debug)) debug_=debug
-
-nx = size(rho,1); ny=size(rho,2); nz = size(rho,3)
-nlevs_data(:,:) = size(rho,3)
-
-nkml_=0;nkbl_=0;hml_=0.0
-if (PRESENT(nkml)) nkml_=max(0,nkml)
-if (PRESENT(nkbl)) nkbl_=max(0,nkbl)
-if (PRESENT(hml)) hml_=hml
-
-if (PRESENT(nlevs)) then
- nlevs_data(:,:) = nlevs(:,:)
-endif
-
-do j=1,ny
- rho_(:,:) = rho(:,j,:)
- i_loop: do i=1,nx
- if (debug_) then
- print *,'looking for interfaces, i,j,nlevs= ',i,j,nlevs_data(i,j)
- print *,'initial density profile= ', rho_(i,:)
- endif
- unstable=.true.
- dir=1
- do while (unstable)
- unstable=.false.
- if (dir == 1) then
- do k=2,nlevs_data(i,j)-1
- if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then
- if (k == 2) then
- rho_(i,k-1)=rho_(i,k)-epsln
- else
- drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1))
- if (drhodz < 0.0) then
- unstable=.true.
+!> Find interface positions corresponding to density profile
+function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps_z) result(zi)
+ real, dimension(:,:,:), &
+ intent(in) :: rho !< potential density in z-space (kg m-3)
+ real, dimension(size(rho,3)), &
+ intent(in) :: zin !< Input data levels, in Z (often m).
+ real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3)
+ real, dimension(size(rho,1),size(rho,2)), &
+ intent(in) :: depth !< ocean depth in Z
+ real, dimension(size(rho,1),size(rho,2)), &
+ optional, intent(in) :: nlevs !< number of valid points in each column
+ logical, optional, intent(in) :: debug !< optional debug flag
+ integer, optional, intent(in) :: nkml !< number of mixed layer pieces
+ integer, optional, intent(in) :: nkbl !< number of buffer layer pieces
+ real, optional, intent(in) :: hml !< mixed layer depth, in Z
+ real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z.
+ real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi !< The returned interface, in the same units az zin.
+
+ ! Local variables
+ real, dimension(size(rho,1),size(rho,3)) :: rho_
+ real, dimension(size(rho,1)) :: depth_
+ logical :: unstable
+ integer :: dir
+ integer, dimension(size(rho,1),size(Rb,1)) :: ki_
+ real, dimension(size(rho,1),size(Rb,1)) :: zi_
+ integer, dimension(size(rho,1),size(rho,2)) :: nlevs_data
+ integer, dimension(size(rho,1)) :: lo, hi
+ real :: slope,rsm,drhodz,hml_
+ integer :: n,i,j,k,l,nx,ny,nz,nt
+ integer :: nlay,kk,nkml_,nkbl_
+ logical :: debug_ = .false.
+ real :: epsln_Z ! A negligibly thin layer thickness, in Z.
+ real :: epsln_rho ! A negligibly small density change, in kg m-3.
+ real, parameter :: zoff=0.999
+
+ nlay=size(Rb)-1
+
+ zi(:,:,:) = 0.0
+
+ if (PRESENT(debug)) debug_=debug
+
+ nx = size(rho,1); ny=size(rho,2); nz = size(rho,3)
+ nlevs_data(:,:) = size(rho,3)
+
+ nkml_ = 0 ; if (PRESENT(nkml)) nkml_ = max(0, nkml)
+ nkbl_ = 0 ; if (PRESENT(nkbl)) nkbl_ = max(0, nkbl)
+ hml_ = 0.0 ; if (PRESENT(hml)) hml_ = hml
+ epsln_Z = 1.0e-10 ; if (PRESENT(eps_z)) epsln_Z = eps_z
+ epsln_rho = 1.0e-10
+
+ if (PRESENT(nlevs)) then
+ nlevs_data(:,:) = nlevs(:,:)
+ endif
+
+ do j=1,ny
+ rho_(:,:) = rho(:,j,:)
+ i_loop: do i=1,nx
+ if (debug_) then
+ print *,'looking for interfaces, i,j,nlevs= ',i,j,nlevs_data(i,j)
+ print *,'initial density profile= ', rho_(i,:)
+ endif
+ unstable=.true.
+ dir=1
+ do while (unstable)
+ unstable=.false.
+ if (dir == 1) then
+ do k=2,nlevs_data(i,j)-1
+ if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then
+ if (k == 2) then
+ rho_(i,k-1) = rho_(i,k)-epsln_rho
+ else
+ drhodz = (rho_(i,k+1)-rho_(i,k-1)) / (zin(k+1)-zin(k-1))
+ if (drhodz < 0.0) unstable=.true.
+ rho_(i,k) = rho_(i,k-1) + drhodz*zoff*(zin(k)-zin(k-1))
endif
- rho_(i,k) = rho_(i,k-1)+drhodz*zoff*(zin(k)-zin(k-1))
endif
- endif
- enddo
- dir=-1*dir
- else
- do k=nlevs_data(i,j)-1,2,-1
- if (rho_(i,k+1) - rho_(i,k) < 0.0) then
- if (k == nlevs_data(i,j)-1) then
- rho_(i,k+1)=rho_(i,k-1)+epsln
- else
- drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1))
- if (drhodz < 0.0) then
- unstable=.true.
+ enddo
+ dir = -1*dir
+ else
+ do k=nlevs_data(i,j)-1,2,-1
+ if (rho_(i,k+1) - rho_(i,k) < 0.0) then
+ if (k == nlevs_data(i,j)-1) then
+ rho_(i,k+1) = rho_(i,k-1)+epsln_rho
+ else
+ drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1))
+ if (drhodz < 0.0) unstable=.true.
+ rho_(i,k) = rho_(i,k+1)-drhodz*(zin(k+1)-zin(k))
endif
- rho_(i,k) = rho_(i,k+1)-drhodz*(zin(k+1)-zin(k))
endif
- endif
- enddo
- dir=-1*dir
- endif
- enddo
- if (debug_) then
- print *,'final density profile= ', rho_(i,:)
- endif
- enddo i_loop
-
- ki_(:,:) = 0
- zi_(:,:) = 0.0
- depth_(:)=-1.0*depth(:,j)
- lo(:)=1
- hi(:)=nlevs_data(:,j)
- ki_ = bisect_fast(rho_,Rb,lo,hi)
- ki_(:,:) = max(1,ki_(:,:)-1)
- do i=1,nx
- do l=2,nlay
- slope = (zin(ki_(i,l)+1) - zin(ki_(i,l)))/max(rho_(i,ki_(i,l)+1) - rho_(i,ki_(i,l)),epsln)
- zi_(i,l) = -1.0*(zin(ki_(i,l)) + slope*(Rb(l)-rho_(i,ki_(i,l))))
- zi_(i,l) = max(zi_(i,l),depth_(i))
- zi_(i,l) = min(zi_(i,l),-1.0*hml_)
- enddo
- zi_(i,nlay+1)=depth_(i)
- do l=2,nkml_+1
- zi_(i,l)=max(((1.0-real(l))/real(nkml_))*hml_,depth_(i))
- enddo
- do l=nlay,nkml_+2,-1
- if (zi_(i,l) < zi_(i,l+1)+epsln) then
- zi_(i,l)=zi_(i,l+1)+epsln
- endif
- if (zi_(i,l)>-1.0*hml_) then
- zi_(i,l)=max(-1.0*hml_,depth_(i))
+ enddo
+ dir = -1*dir
+ endif
+ enddo
+ if (debug_) then
+ print *,'final density profile= ', rho_(i,:)
endif
+ enddo i_loop
+
+ ki_(:,:) = 0
+ zi_(:,:) = 0.0
+ depth_(:) = -1.0*depth(:,j)
+ lo(:) = 1
+ hi(:) = nlevs_data(:,j)
+ ki_ = bisect_fast(rho_, Rb, lo, hi)
+ ki_(:,:) = max(1, ki_(:,:)-1)
+ do i=1,nx
+ do l=2,nlay
+ slope = (zin(ki_(i,l)+1) - zin(ki_(i,l))) / max(rho_(i,ki_(i,l)+1) - rho_(i,ki_(i,l)),epsln_rho)
+ zi_(i,l) = -1.0*(zin(ki_(i,l)) + slope*(Rb(l)-rho_(i,ki_(i,l))))
+ zi_(i,l) = max(zi_(i,l), depth_(i))
+ zi_(i,l) = min(zi_(i,l), -1.0*hml_)
+ enddo
+ zi_(i,nlay+1) = depth_(i)
+ do l=2,nkml_+1
+ zi_(i,l) = max(hml_*((1.0-real(l))/real(nkml_)), depth_(i))
+ enddo
+ do l=nlay,nkml_+2,-1
+ if (zi_(i,l) < zi_(i,l+1) + epsln_Z) zi_(i,l) = zi_(i,l+1) + epsln_Z
+ if (zi_(i,l) > -1.0*hml_) zi_(i,l) = max(-1.0*hml_, depth_(i))
+ enddo
enddo
+ zi(:,j,:) = zi_(:,:)
enddo
- zi(:,j,:)=zi_(:,:)
-enddo
-
-return
-
end function find_interfaces
+!> Create a 2d-mesh of grid coordinates from 1-d arrays
subroutine meshgrid(x,y,x_T,y_T)
+ real, dimension(:), intent(in) :: x !< input x coordinates
+ real, dimension(:), intent(in) :: y !< input y coordinates
+ real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T !< output 2-d version
+ real, dimension(size(x,1),size(y,1)), intent(inout) :: y_T !< output 2-d version
-! create a 2d-mesh of grid coordinates
-! from 1-d arrays.
-
-real, dimension(:), intent(in) :: x,y
-real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T,y_T
-
-integer :: ni,nj,i,j
+ integer :: ni,nj,i,j
-ni=size(x,1);nj=size(y,1)
+ ni=size(x,1);nj=size(y,1)
-do j=1,nj
- x_T(:,j)=x(:)
-enddo
+ do j=1,nj
+ x_T(:,j)=x(:)
+ enddo
-do i=1,ni
- y_T(i,:)=y(:)
-enddo
+ do i=1,ni
+ y_T(i,:)=y(:)
+ enddo
-return
+ return
end subroutine meshgrid
+!> Solve del2 (zi) = 0 using successive iterations
+!! with a 5 point stencil. Only points fill==1 are
+!! modified. Except where bad==1, information propagates
+!! isotropically in index space. The resulting solution
+!! in each region is an approximation to del2(zi)=0 subject to
+!! boundary conditions along the valid points curve bounding this region.
subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n)
-!
-! Solve del2 (zi) = 0 using successive iterations
-! with a 5 point stencil. Only points fill==1 are
-! modified. Except where bad==1, information propagates
-! isotropically in index space. The resulting solution
-! in each region is an approximation to del2(zi)=0 subject to
-! boundary conditions along the valid points curve bounding this region.
+ real, dimension(:,:), intent(inout) :: zi !< interface positions (m)
+ integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill !< points to be smoothed
+ integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad !< ignore these points
+ real, intent(in) :: sor !< successive over-relaxation coefficient (typically 0.6)
+ integer, intent(in) :: niter !< maximum number of iterations
+ logical, intent(in) :: cyclic_x !< input grid cyclic condition in the zonal direction
+ logical, intent(in) :: tripolar_n !< tripolar Arctic fold flag
+ integer :: i,j,k,n
+ integer :: ni,nj
-real, dimension(:,:), intent(inout) :: zi
-integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill
-integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad
-real, intent(in) :: sor
-integer, intent(in) :: niter
-logical, intent(in) :: cyclic_x, tripolar_n
+ real, dimension(size(zi,1),size(zi,2)) :: res, m
+ integer, dimension(size(zi,1),size(zi,2),4) :: B
+ real, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: mp
+ integer, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: nm
-integer :: i,j,k,n
-integer :: ni,nj
+ real :: Isum, bsum
-real, dimension(size(zi,1),size(zi,2)) :: res, m
-integer, dimension(size(zi,1),size(zi,2),4) :: B
-real, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: mp
-integer, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: nm
+ ni=size(zi,1); nj=size(zi,2)
-real :: Isum, bsum
-ni=size(zi,1); nj=size(zi,2)
+ mp=fill_boundaries(zi,cyclic_x,tripolar_n)
+ B(:,:,:)=0.0
+ nm=fill_boundaries(bad,cyclic_x,tripolar_n)
-mp=fill_boundaries(zi,cyclic_x,tripolar_n)
-
-B(:,:,:)=0.0
-nm=fill_boundaries(bad,cyclic_x,tripolar_n)
-
-do j=1,nj
- do i=1,ni
- if (fill(i,j) == 1) then
- B(i,j,1)=1-nm(i+1,j);B(i,j,2)=1-nm(i-1,j)
- B(i,j,3)=1-nm(i,j+1);B(i,j,4)=1-nm(i,j-1)
- endif
- enddo
-enddo
-
-do n=1,niter
do j=1,nj
do i=1,ni
if (fill(i,j) == 1) then
- bsum = real(B(i,j,1)+B(i,j,2)+B(i,j,3)+B(i,j,4))
- Isum = 1.0/bsum
- res(i,j)=Isum*(B(i,j,1)*mp(i+1,j)+B(i,j,2)*mp(i-1,j)+&
- B(i,j,3)*mp(i,j+1)+B(i,j,4)*mp(i,j-1)) - mp(i,j)
+ B(i,j,1)=1-nm(i+1,j);B(i,j,2)=1-nm(i-1,j)
+ B(i,j,3)=1-nm(i,j+1);B(i,j,4)=1-nm(i,j-1)
endif
enddo
enddo
- res(:,:)=res(:,:)*sor
- do j=1,nj
- do i=1,ni
- mp(i,j)=mp(i,j)+res(i,j)
+ do n=1,niter
+ do j=1,nj
+ do i=1,ni
+ if (fill(i,j) == 1) then
+ bsum = real(B(i,j,1)+B(i,j,2)+B(i,j,3)+B(i,j,4))
+ Isum = 1.0/bsum
+ res(i,j)=Isum*(B(i,j,1)*mp(i+1,j)+B(i,j,2)*mp(i-1,j)+&
+ B(i,j,3)*mp(i,j+1)+B(i,j,4)*mp(i,j-1)) - mp(i,j)
+ endif
+ enddo
enddo
- enddo
+ res(:,:)=res(:,:)*sor
- zi(:,:)=mp(1:ni,1:nj)
- mp = fill_boundaries(zi,cyclic_x,tripolar_n)
-enddo
+ do j=1,nj
+ do i=1,ni
+ mp(i,j)=mp(i,j)+res(i,j)
+ enddo
+ enddo
+
+ zi(:,:)=mp(1:ni,1:nj)
+ mp = fill_boundaries(zi,cyclic_x,tripolar_n)
+ enddo
-return
+ return
end subroutine smooth_heights
+!> Fill grid edges
function fill_boundaries_int(m,cyclic_x,tripolar_n) result(mp)
-!
-! fill grid edges
-!
-integer, dimension(:,:), intent(in) :: m
-logical, intent(in) :: cyclic_x, tripolar_n
-real, dimension(size(m,1),size(m,2)) :: m_real
-real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real
-integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp
+ integer, dimension(:,:), intent(in) :: m !< input array
+ logical, intent(in) :: cyclic_x !< zonal cyclic condition
+ logical, intent(in) :: tripolar_n !< northern fold condition
+ integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp !< output filled array
+ ! Local variables
+ real, dimension(size(m,1),size(m,2)) :: m_real
+ real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real
-m_real = real(m)
+ m_real = real(m)
-mp_real = fill_boundaries_real(m_real,cyclic_x,tripolar_n)
+ mp_real = fill_boundaries_real(m_real,cyclic_x,tripolar_n)
-mp = int(mp_real)
+ mp = int(mp_real)
-return
+ return
end function fill_boundaries_int
+!> fill grid edges
function fill_boundaries_real(m,cyclic_x,tripolar_n) result(mp)
-!
-! fill grid edges
-!
-real, dimension(:,:), intent(in) :: m
-logical, intent(in) :: cyclic_x, tripolar_n
-real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp
+ real, dimension(:,:), intent(in) :: m !< input array
+ logical, intent(in) :: cyclic_x !< zonal cyclic condition
+ logical, intent(in) :: tripolar_n !< northern fold condition
+ real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp !< output filled array
-integer :: ni,nj,i,j
+ integer :: ni,nj,i,j
-ni=size(m,1); nj=size(m,2)
+ ni=size(m,1); nj=size(m,2)
-mp(1:ni,1:nj)=m(:,:)
+ mp(1:ni,1:nj)=m(:,:)
-if (cyclic_x) then
- mp(0,1:nj)=m(ni,1:nj)
- mp(ni+1,1:nj)=m(1,1:nj)
-else
- mp(0,1:nj)=m(1,1:nj)
- mp(ni+1,1:nj)=m(ni,1:nj)
-endif
+ if (cyclic_x) then
+ mp(0,1:nj)=m(ni,1:nj)
+ mp(ni+1,1:nj)=m(1,1:nj)
+ else
+ mp(0,1:nj)=m(1,1:nj)
+ mp(ni+1,1:nj)=m(ni,1:nj)
+ endif
-mp(1:ni,0)=m(1:ni,1)
-if (tripolar_n) then
- do i=1,ni
- mp(i,nj+1)=m(ni-i+1,nj)
- enddo
-else
- mp(1:ni,nj+1)=m(1:ni,nj)
-endif
+ mp(1:ni,0)=m(1:ni,1)
+ if (tripolar_n) then
+ do i=1,ni
+ mp(i,nj+1)=m(ni-i+1,nj)
+ enddo
+ else
+ mp(1:ni,nj+1)=m(1:ni,nj)
+ endif
-return
+ return
end function fill_boundaries_real
-end module midas_vertmap
+end module MIDAS_vertmap
diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90
index b71a2bacf4..f9dae9b246 100644
--- a/src/ocean_data_assim/MOM_oda_driver.F90
+++ b/src/ocean_data_assim/MOM_oda_driver.F90
@@ -1,551 +1,564 @@
+!> Interfaces for MOM6 ensembles and data assimilation.
module MOM_oda_driver_mod
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! This is the top-level module for MOM6 ocean data assimilation.
-! It can be used to gather an ensemble of ocean states
-! before calling ensemble filter routines which calculate
-! increments based on cross-ensemble co-variance. It can also
-! be used to compare gridded model state variables to in-situ
-! observations without applying DA incrementa.
-!
-! init_oda: Initialize the ODA module
-! set_analysis_time : update time for performing next analysis
-! set_prior: Store prior model state
-! oda: call to filter
-! get_posterior : returns posterior increments (or full state) for the current ensemble member
-!
-! Authors: Matthew.Harrison@noaa.gov
-! Feiyu.Liu@noaa.gov and
-! Tony.Rosati@noaa.gov
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- use fms_mod, only : open_namelist_file, close_file, check_nml_error
- use fms_mod, only : error_mesg, FATAL
- use mpp_mod, only : stdout, stdlog, mpp_error, npes=>mpp_npes,pe=>mpp_pe
- use mpp_mod, only : set_current_pelist => mpp_set_current_pelist
- use mpp_mod, only : set_root_pe => mpp_set_root_pe
- use mpp_mod, only : mpp_sync_self, mpp_sum, get_pelist=>mpp_get_current_pelist, mpp_root_pe
- use mpp_mod, only : set_stack_size=>mpp_set_stack_size, broadcast=>mpp_broadcast
- use mpp_io_mod, only : io_set_stack_size=>mpp_io_set_stack_size
- use mpp_io_mod, only : MPP_SINGLE,MPP_MULTI
- use mpp_domains_mod, only : domain2d, mpp_global_field
- use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_data_domain
- use mpp_domains_mod, only : mpp_redistribute, mpp_broadcast_domain
- use mpp_domains_mod, only : set_domains_stack_size=>mpp_domains_set_stack_size
- use diag_manager_mod, only : register_diag_field, diag_axis_init, send_data
- use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size
- use ensemble_manager_mod, only : get_ensemble_pelist, get_ensemble_filter_pelist
- use time_manager_mod, only : time_type, decrement_time, increment_time
- use time_manager_mod, only : get_date, get_time, operator(>=),operator(/=),operator(==),operator(<)
- use constants_mod, only : radius, epsln
- ! ODA Modules
- use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct
- use ocean_da_core_mod, only : ocean_da_core_init, get_profiles
- !use eakf_oda_mod, only : ensemble_filter
- use write_ocean_obs_mod, only : open_profile_file
- use write_ocean_obs_mod, only : write_profile,close_profile_file
- use kdtree, only : kd_root !# JEDI
- ! MOM Modules
- use MOM_io, only : slasher, MOM_read_data
- use MOM_diag_mediator, only : diag_ctrl, set_axes_info
- use MOM_error_handler, only : FATAL, WARNING, MOM_error, is_root_pe
- use MOM_get_input, only : get_MOM_input, directories
- use MOM_variables, only : thermo_var_ptrs
- use MOM_grid, only : ocean_grid_type, MOM_grid_init
- use MOM_grid_initialize, only : set_grid_metrics
- use MOM_hor_index, only : hor_index_type, hor_index_init
- use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid
- use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid
- use MOM_fixed_initialization, only : MOM_initialize_fixed, MOM_initialize_topography
- use MOM_coord_initialization, only : MOM_initialize_coord
- use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit
- use MOM_file_parser, only : read_param, get_param, param_file_type
- use MOM_string_functions, only : lowercase
- use MOM_ALE, only : ALE_CS, ALE_initThicknessToCoord, ALE_init, ALE_updateVerticalGridType
- use MOM_domains, only : MOM_domains_init, MOM_domain_type, clone_MOM_domain
- use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h
- use MOM_regridding, only : regridding_CS, initialize_regridding
- use MOM_regridding, only : regridding_main, set_regrid_params
-
- implicit none ; private
-
- public :: init_oda, oda_end, set_prior_tracer, get_posterior_tracer
- public :: set_analysis_time, oda, save_obs_diff, apply_oda_tracer_increments
+
+! This file is part of MOM6. see LICENSE.md for the license.
+use fms_mod, only : open_namelist_file, close_file, check_nml_error
+use fms_mod, only : error_mesg, FATAL
+use mpp_mod, only : stdout, stdlog, mpp_error, npes=>mpp_npes,pe=>mpp_pe
+use mpp_mod, only : set_current_pelist => mpp_set_current_pelist
+use mpp_mod, only : set_root_pe => mpp_set_root_pe
+use mpp_mod, only : mpp_sync_self, mpp_sum, get_pelist=>mpp_get_current_pelist, mpp_root_pe
+use mpp_mod, only : set_stack_size=>mpp_set_stack_size, broadcast=>mpp_broadcast
+use mpp_io_mod, only : io_set_stack_size=>mpp_io_set_stack_size
+use mpp_io_mod, only : MPP_SINGLE,MPP_MULTI
+use mpp_domains_mod, only : domain2d, mpp_global_field
+use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_data_domain
+use mpp_domains_mod, only : mpp_redistribute, mpp_broadcast_domain
+use mpp_domains_mod, only : set_domains_stack_size=>mpp_domains_set_stack_size
+use diag_manager_mod, only : register_diag_field, diag_axis_init, send_data
+use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size
+use ensemble_manager_mod, only : get_ensemble_pelist, get_ensemble_filter_pelist
+use time_manager_mod, only : time_type, decrement_time, increment_time
+use time_manager_mod, only : get_date, operator(>=),operator(/=),operator(==),operator(<)
+use constants_mod, only : radius, epsln
+! ODA Modules
+use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct
+use ocean_da_core_mod, only : ocean_da_core_init, get_profiles
+!use eakf_oda_mod, only : ensemble_filter
+use write_ocean_obs_mod, only : open_profile_file
+use write_ocean_obs_mod, only : write_profile,close_profile_file
+use kdtree, only : kd_root !# JEDI
+! MOM Modules
+use MOM_io, only : slasher, MOM_read_data
+use MOM_diag_mediator, only : diag_ctrl, set_axes_info
+use MOM_error_handler, only : FATAL, WARNING, MOM_error, MOM_mesg, is_root_pe
+use MOM_get_input, only : get_MOM_input, directories
+use MOM_variables, only : thermo_var_ptrs
+use MOM_grid, only : ocean_grid_type, MOM_grid_init
+use MOM_grid_initialize, only : set_grid_metrics
+use MOM_hor_index, only : hor_index_type, hor_index_init
+use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid
+use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid
+use MOM_fixed_initialization, only : MOM_initialize_fixed, MOM_initialize_topography
+use MOM_coord_initialization, only : MOM_initialize_coord
+use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit
+use MOM_file_parser, only : read_param, get_param, param_file_type
+use MOM_string_functions, only : lowercase
+use MOM_ALE, only : ALE_CS, ALE_initThicknessToCoord, ALE_init, ALE_updateVerticalGridType
+use MOM_domains, only : MOM_domains_init, MOM_domain_type, clone_MOM_domain
+use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h
+use MOM_regridding, only : regridding_CS, initialize_regridding
+use MOM_regridding, only : regridding_main, set_regrid_params
+
+implicit none ; private
+
+public :: init_oda, oda_end, set_prior_tracer, get_posterior_tracer
+public :: set_analysis_time, oda, save_obs_diff, apply_oda_tracer_increments
#include
- type, public :: ODA_CS; private
- type(ocean_control_struct), pointer :: Ocean_prior=> NULL() !< ensemble ocean prior states in DA space
- type(ocean_control_struct), pointer :: Ocean_posterior=> NULL() !< ensemble ocean posterior states
- !! or increments to prior in DA space
- integer :: nk !< number of vertical layers used for DA
- type(ocean_grid_type), pointer :: Grid => NULL() !< MOM6 grid type and decomposition for the DA
- type(pointer_mpp_domain), pointer, dimension(:) :: domains => NULL() !< Pointer to mpp_domain objects
- !! for ensemble members
- type(verticalGrid_type), pointer :: GV => NULL() !< vertical grid for DA
- type(domain2d), pointer :: mpp_domain => NULL() !< Pointer to a mpp domain object for DA
- type(grid_type), pointer :: oda_grid !< local tracer grid
- real, pointer, dimension(:,:,:) :: h => NULL() ! NULL() !< pointer to thermodynamic variables
- integer :: ni, nj !< global grid size
- logical :: reentrant_x !< grid is reentrant in the x direction
- logical :: reentrant_y !< grid is reentrant in the y direction
- logical :: tripolar_N !< grid is folded at its north edge
- logical :: symmetric !< Values at C-grid locations are symmetric
- integer :: assim_method !< Method: NO_ASSIM,EAKF_ASSIM or OI_ASSIM
- integer :: ensemble_size !< Size of the ensemble
- integer :: ensemble_id = 0 !< id of the current ensemble member
- integer, pointer, dimension(:,:) :: ensemble_pelist !< PE list for ensemble members
- integer, pointer, dimension(:) :: filter_pelist !< PE list for ensemble members
- integer :: assim_frequency !< analysis interval in hours
- ! Profiles local to the analysis domain
- type(ocean_profile_type), pointer :: Profiles => NULL() !< pointer to linked list of all available profiles
- type(ocean_profile_type), pointer :: CProfiles => NULL()!< pointer to linked list of current profiles
- type(kd_root), pointer :: kdroot
- type(ALE_CS), pointer :: ALE_CS=>NULL() !< ALE control structure for DA
- logical :: use_ALE_algorithm !< true is using ALE remapping
- type(regridding_CS) :: regridCS !< ALE control structure for regridding
- type(remapping_CS) :: remapCS !< ALE control structure for remapping
- type(time_type) :: Time !< Current Analysis time
- type(diag_ctrl) :: diag_cs ! NULL()
- end type pointer_mpp_domain
-
-
- integer, parameter :: NO_ASSIM = 0, OI_ASSIM=1, EAKF_ASSIM=2
+!> Control structure that contains a transpose of the ocean state across ensemble members.
+type, public :: ODA_CS ; private
+ type(ocean_control_struct), pointer :: Ocean_prior=> NULL() !< ensemble ocean prior states in DA space
+ type(ocean_control_struct), pointer :: Ocean_posterior=> NULL() !< ensemble ocean posterior states
+ !! or increments to prior in DA space
+ integer :: nk !< number of vertical layers used for DA
+ type(ocean_grid_type), pointer :: Grid => NULL() !< MOM6 grid type and decomposition for the DA
+ type(ptr_mpp_domain), pointer, dimension(:) :: domains => NULL() !< Pointer to mpp_domain objects
+ !! for ensemble members
+ type(verticalGrid_type), pointer :: GV => NULL() !< vertical grid for DA
+ type(domain2d), pointer :: mpp_domain => NULL() !< Pointer to a mpp domain object for DA
+ type(grid_type), pointer :: oda_grid !< local tracer grid
+ real, pointer, dimension(:,:,:) :: h => NULL() ! NULL() !< pointer to thermodynamic variables
+ integer :: ni !< global i-direction grid size
+ integer :: nj !< global j-direction grid size
+ logical :: reentrant_x !< grid is reentrant in the x direction
+ logical :: reentrant_y !< grid is reentrant in the y direction
+ logical :: tripolar_N !< grid is folded at its north edge
+ logical :: symmetric !< Values at C-grid locations are symmetric
+ integer :: assim_method !< Method: NO_ASSIM,EAKF_ASSIM or OI_ASSIM
+ integer :: ensemble_size !< Size of the ensemble
+ integer :: ensemble_id = 0 !< id of the current ensemble member
+ integer, pointer, dimension(:,:) :: ensemble_pelist !< PE list for ensemble members
+ integer, pointer, dimension(:) :: filter_pelist !< PE list for ensemble members
+ integer :: assim_frequency !< analysis interval in hours
+ ! Profiles local to the analysis domain
+ type(ocean_profile_type), pointer :: Profiles => NULL() !< pointer to linked list of all available profiles
+ type(ocean_profile_type), pointer :: CProfiles => NULL()!< pointer to linked list of current profiles
+ type(kd_root), pointer :: kdroot => NULL() !< A structure for storing nearest neighbors
+ type(ALE_CS), pointer :: ALE_CS=>NULL() !< ALE control structure for DA
+ logical :: use_ALE_algorithm !< true is using ALE remapping
+ type(regridding_CS) :: regridCS !< ALE control structure for regridding
+ type(remapping_CS) :: remapCS !< ALE control structure for remapping
+ type(time_type) :: Time !< Current Analysis time
+ type(diag_ctrl) :: diag_cs ! A structure with a pointer to a domain2d, to allow for the creation of arrays of pointers.
+type :: ptr_mpp_domain
+ type(domain2d), pointer :: mpp_domain => NULL() !< pointer to an mpp domain2d
+end type ptr_mpp_domain
+
+!>@{ DA parameters
+integer, parameter :: NO_ASSIM = 0, OI_ASSIM=1, EAKF_ASSIM=2
+!!@}
contains
-!V initialize First_guess (prior) and Analysis grid
+!> initialize First_guess (prior) and Analysis grid
!! information for all ensemble members
-!!
- subroutine init_oda(Time, G, GV, CS)
-
- type(time_type), intent(in) :: Time !< The current model time.
- type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- type(ODA_CS), pointer, intent(inout) :: CS
-
- ! Local variables
- type(thermo_var_ptrs) :: tv_dummy
- type(dyn_horgrid_type), pointer :: dG=> NULL()
- type(hor_index_type), pointer :: HI=> NULL()
- type(directories) :: dirs
-
- type(grid_type), pointer :: T_grid !< global tracer grid
- real, dimension(:,:), allocatable :: global2D, global2D_old
- real, dimension(:), allocatable :: lon1D, lat1D, glon1D, glat1D
- type(param_file_type) :: PF
- integer :: n, m, k, i, j, nk
- integer :: is,ie,js,je,isd,ied,jsd,jed
- integer :: stdout_unit
- character(len=32) :: assim_method
- integer :: npes_pm, ens_info(6), ni, nj
- character(len=128) :: mesg
- character(len=32) :: fldnam
- character(len=30) :: coord_mode
- character(len=200) :: inputdir, basin_file
- logical :: reentrant_x, reentrant_y, tripolar_N, symmetric
-
- if (associated(CS)) call mpp_error(FATAL,'Calling oda_init with associated control structure')
- allocate(CS)
+subroutine init_oda(Time, G, GV, CS)
+
+ type(time_type), intent(in) :: Time !< The current model time.
+ type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(ODA_CS), pointer, intent(inout) :: CS !< The DA control structure
+
+! Local variables
+ type(thermo_var_ptrs) :: tv_dummy
+ type(dyn_horgrid_type), pointer :: dG=> NULL()
+ type(hor_index_type), pointer :: HI=> NULL()
+ type(directories) :: dirs
+
+ type(grid_type), pointer :: T_grid !< global tracer grid
+ real, dimension(:,:), allocatable :: global2D, global2D_old
+ real, dimension(:), allocatable :: lon1D, lat1D, glon1D, glat1D
+ type(param_file_type) :: PF
+ integer :: n, m, k, i, j, nk
+ integer :: is,ie,js,je,isd,ied,jsd,jed
+ integer :: stdout_unit
+ character(len=32) :: assim_method
+ integer :: npes_pm, ens_info(6), ni, nj
+ character(len=128) :: mesg
+ character(len=32) :: fldnam
+ character(len=30) :: coord_mode
+ character(len=200) :: inputdir, basin_file
+ logical :: reentrant_x, reentrant_y, tripolar_N, symmetric
+
+ if (associated(CS)) call mpp_error(FATAL,'Calling oda_init with associated control structure')
+ allocate(CS)
! Use ens1 parameters , this could be changed at a later time
! if it were desirable to have alternate parameters, e.g. for the grid
! for the analysis
- call get_MOM_input(PF,dirs,ensemble_num=0)
- call get_param(PF, "MOM", "ASSIM_METHOD", assim_method, &
- "String which determines the data assimilation method" // &
- "Valid methods are: \'EAKF\',\'OI\', and \'NO_ASSIM\'", default='NO_ASSIM')
- call get_param(PF, "MOM", "ASSIM_FREQUENCY", CS%assim_frequency, &
- "data assimilation frequency in hours")
- call get_param(PF, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm , &
- "If True, use the ALE algorithm (regridding/remapping).\n"//&
- "If False, use the layered isopycnal algorithm.", default=.false. )
- call get_param(PF, "MOM", "REENTRANT_X", CS%reentrant_x, &
- "If true, the domain is zonally reentrant.", default=.true.)
- call get_param(PF, "MOM", "REENTRANT_Y", CS%reentrant_y, &
- "If true, the domain is meridionally reentrant.", &
- default=.false.)
- call get_param(PF,"MOM", "TRIPOLAR_N", CS%tripolar_N, &
- "Use tripolar connectivity at the northern edge of the \n"//&
- "domain. With TRIPOLAR_N, NIGLOBAL must be even.", &
- default=.false.)
- call get_param(PF,"MOM", "NIGLOBAL", CS%ni, &
- "The total number of thickness grid points in the \n"//&
- "x-direction in the physical domain.")
- call get_param(PF,"MOM", "NJGLOBAL", CS%nj, &
- "The total number of thickness grid points in the \n"//&
- "y-direction in the physical domain.")
- call get_param(PF, 'MOM', "INPUTDIR", inputdir)
- inputdir = slasher(inputdir)
-
- select case(lowercase(trim(assim_method)))
- case('eakf')
- CS%assim_method = EAKF_ASSIM
- case('oi')
- CS%assim_method = OI_ASSIM
- case('no_assim')
- CS%assim_method = NO_ASSIM
- case default
- call mpp_error(FATAL,'Invalid assimilation method provided')
- end select
-
- ens_info = get_ensemble_size()
- CS%ensemble_size = ens_info(1)
- npes_pm=ens_info(3)
- CS%ensemble_id = get_ensemble_id()
- !! Switch to global pelist
- allocate(CS%ensemble_pelist(CS%ensemble_size,npes_pm))
- allocate(CS%filter_pelist(CS%ensemble_size*npes_pm))
- call get_ensemble_pelist(CS%ensemble_pelist,'ocean')
- call get_ensemble_filter_pelist(CS%filter_pelist,'ocean')
-
- call set_current_pelist(CS%filter_pelist)
-
- allocate(CS%domains(CS%ensemble_size))
- CS%domains(CS%ensemble_id)%mpp_domain => G%Domain%mpp_domain
- do n=1,CS%ensemble_size
- if (.not. associated(CS%domains(n)%mpp_domain)) allocate(CS%domains(n)%mpp_domain)
- call set_root_pe(CS%ensemble_pelist(n,1))
- call mpp_broadcast_domain(CS%domains(n)%mpp_domain)
- enddo
- call set_root_pe(CS%filter_pelist(1))
- allocate(CS%Grid)
- ! params NIHALO_ODA, NJHALO_ODA set the DA halo size
- call MOM_domains_init(CS%Grid%Domain,PF,param_suffix='_ODA')
- allocate(HI)
- call hor_index_init(CS%Grid%Domain, HI, PF, &
- local_indexing=.false.) ! Use global indexing for DA
- call verticalGridInit( PF, CS%GV )
- allocate(dG)
- call create_dyn_horgrid(dG,HI)
- call clone_MOM_domain(CS%Grid%Domain, dG%Domain,symmetric=.false.)
- call set_grid_metrics(dG,PF)
- call MOM_initialize_topography(dg%bathyT,dG%max_depth,dG,PF)
- call MOM_initialize_coord(CS%GV, PF, .false., &
- dirs%output_directory, tv_dummy, dG%max_depth)
- call ALE_init(PF, CS%GV, dG%max_depth, CS%ALE_CS)
- call MOM_grid_init(CS%Grid, PF, global_indexing=.true.)
- call ALE_updateVerticalGridType(CS%ALE_CS,CS%GV)
- call copy_dyngrid_to_MOM_grid(dG, CS%Grid)
- CS%mpp_domain => CS%Grid%Domain%mpp_domain
- CS%Grid%ke = CS%GV%ke
- CS%nk = CS%GV%ke
- ! initialize storage for prior and posterior
- allocate(CS%Ocean_prior)
- call init_ocean_ensemble(CS%Ocean_prior,CS%Grid,CS%GV,CS%ensemble_size)
- allocate(CS%Ocean_posterior)
- call init_ocean_ensemble(CS%Ocean_posterior,CS%Grid,CS%GV,CS%ensemble_size)
- allocate(CS%tv)
-
- call get_param(PF, 'oda_driver', "REGRIDDING_COORDINATE_MODE", coord_mode, &
- "Coordinate mode for vertical regridding.", &
- default="ZSTAR", fail_if_missing=.false.)
- call initialize_regridding(CS%regridCS, CS%GV, dG%max_depth,PF,'oda_driver',coord_mode,'','')
- call initialize_remapping(CS%remapCS,'PLM')
- call set_regrid_params(CS%regridCS, min_thickness=0.)
- call mpp_get_data_domain(G%Domain%mpp_domain,isd,ied,jsd,jed)
- if (.not. associated(CS%h)) then
- allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke)); CS%h(:,:,:)=0.0
-! assign thicknesses
- call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h)
- endif
- allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%T(:,:,:)=0.0
- allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%S(:,:,:)=0.0
-
- call set_axes_info(CS%Grid,CS%GV,PF,CS%diag_cs,set_vertical=.true.)
- do n=1,CS%ensemble_size
- write(fldnam,'(a,i2.2)') 'temp_prior_',n
- CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, &
- 'ocean potential temperature','degC')
- write(fldnam,'(a,i2.2)') 'salt_prior_',n
- CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, &
- 'ocean salinity','psu')
- write(fldnam,'(a,i2.2)') 'temp_posterior_',n
- CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, &
- 'ocean potential temperature','degC')
- write(fldnam,'(a,i2.2)') 'salt_posterior_',n
- CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, &
- 'ocean salinity','psu')
- enddo
-
- call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed)
- allocate(CS%oda_grid)
- CS%oda_grid%x => CS%Grid%geolonT
- CS%oda_grid%y => CS%Grid%geolatT
-
- call get_param(PF, 'oda_driver', "BASIN_FILE", basin_file, &
- "A file in which to find the basin masks, in variable 'basin'.", &
- default="basin.nc")
- basin_file = trim(inputdir) // trim(basin_file)
- allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed))
- CS%oda_grid%basin_mask(:,:) = 0.0
- call MOM_read_data(basin_file,'basin',CS%oda_grid%basin_mask,CS%Grid%domain, timelevel=1)
+ call get_MOM_input(PF,dirs,ensemble_num=0)
+ call get_param(PF, "MOM", "ASSIM_METHOD", assim_method, &
+ "String which determines the data assimilation method" // &
+ "Valid methods are: \'EAKF\',\'OI\', and \'NO_ASSIM\'", default='NO_ASSIM')
+ call get_param(PF, "MOM", "ASSIM_FREQUENCY", CS%assim_frequency, &
+ "data assimilation frequency in hours")
+ call get_param(PF, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm , &
+ "If True, use the ALE algorithm (regridding/remapping).\n"//&
+ "If False, use the layered isopycnal algorithm.", default=.false. )
+ call get_param(PF, "MOM", "REENTRANT_X", CS%reentrant_x, &
+ "If true, the domain is zonally reentrant.", default=.true.)
+ call get_param(PF, "MOM", "REENTRANT_Y", CS%reentrant_y, &
+ "If true, the domain is meridionally reentrant.", &
+ default=.false.)
+ call get_param(PF,"MOM", "TRIPOLAR_N", CS%tripolar_N, &
+ "Use tripolar connectivity at the northern edge of the \n"//&
+ "domain. With TRIPOLAR_N, NIGLOBAL must be even.", &
+ default=.false.)
+ call get_param(PF,"MOM", "NIGLOBAL", CS%ni, &
+ "The total number of thickness grid points in the \n"//&
+ "x-direction in the physical domain.")
+ call get_param(PF,"MOM", "NJGLOBAL", CS%nj, &
+ "The total number of thickness grid points in the \n"//&
+ "y-direction in the physical domain.")
+ call get_param(PF, 'MOM', "INPUTDIR", inputdir)
+ inputdir = slasher(inputdir)
+
+ select case(lowercase(trim(assim_method)))
+ case('eakf')
+ CS%assim_method = EAKF_ASSIM
+ case('oi')
+ CS%assim_method = OI_ASSIM
+ case('no_assim')
+ CS%assim_method = NO_ASSIM
+ case default
+ call mpp_error(FATAL,'Invalid assimilation method provided')
+ end select
+
+ ens_info = get_ensemble_size()
+ CS%ensemble_size = ens_info(1)
+ npes_pm=ens_info(3)
+ CS%ensemble_id = get_ensemble_id()
+ !! Switch to global pelist
+ allocate(CS%ensemble_pelist(CS%ensemble_size,npes_pm))
+ allocate(CS%filter_pelist(CS%ensemble_size*npes_pm))
+ call get_ensemble_pelist(CS%ensemble_pelist,'ocean')
+ call get_ensemble_filter_pelist(CS%filter_pelist,'ocean')
+
+ call set_current_pelist(CS%filter_pelist)
+
+ allocate(CS%domains(CS%ensemble_size))
+ CS%domains(CS%ensemble_id)%mpp_domain => G%Domain%mpp_domain
+ do n=1,CS%ensemble_size
+ if (.not. associated(CS%domains(n)%mpp_domain)) allocate(CS%domains(n)%mpp_domain)
+ call set_root_pe(CS%ensemble_pelist(n,1))
+ call mpp_broadcast_domain(CS%domains(n)%mpp_domain)
+ enddo
+ call set_root_pe(CS%filter_pelist(1))
+ allocate(CS%Grid)
+ ! params NIHALO_ODA, NJHALO_ODA set the DA halo size
+ call MOM_domains_init(CS%Grid%Domain,PF,param_suffix='_ODA')
+ allocate(HI)
+ call hor_index_init(CS%Grid%Domain, HI, PF, &
+ local_indexing=.false.) ! Use global indexing for DA
+ call verticalGridInit( PF, CS%GV )
+ allocate(dG)
+ call create_dyn_horgrid(dG,HI)
+ call clone_MOM_domain(CS%Grid%Domain, dG%Domain,symmetric=.false.)
+ call set_grid_metrics(dG,PF)
+ call MOM_initialize_topography(dg%bathyT,dG%max_depth,dG,PF)
+ call MOM_initialize_coord(CS%GV, PF, .false., &
+ dirs%output_directory, tv_dummy, dG%max_depth)
+ call ALE_init(PF, CS%GV, dG%max_depth, CS%ALE_CS)
+ call MOM_grid_init(CS%Grid, PF, global_indexing=.true.)
+ call ALE_updateVerticalGridType(CS%ALE_CS,CS%GV)
+ call copy_dyngrid_to_MOM_grid(dG, CS%Grid)
+ CS%mpp_domain => CS%Grid%Domain%mpp_domain
+ CS%Grid%ke = CS%GV%ke
+ CS%nk = CS%GV%ke
+ ! initialize storage for prior and posterior
+ allocate(CS%Ocean_prior)
+ call init_ocean_ensemble(CS%Ocean_prior,CS%Grid,CS%GV,CS%ensemble_size)
+ allocate(CS%Ocean_posterior)
+ call init_ocean_ensemble(CS%Ocean_posterior,CS%Grid,CS%GV,CS%ensemble_size)
+ allocate(CS%tv)
+
+ call get_param(PF, 'oda_driver', "REGRIDDING_COORDINATE_MODE", coord_mode, &
+ "Coordinate mode for vertical regridding.", &
+ default="ZSTAR", fail_if_missing=.false.)
+ call initialize_regridding(CS%regridCS, CS%GV, dG%max_depth,PF,'oda_driver',coord_mode,'','')
+ call initialize_remapping(CS%remapCS,'PLM')
+ call set_regrid_params(CS%regridCS, min_thickness=0.)
+ call mpp_get_data_domain(G%Domain%mpp_domain,isd,ied,jsd,jed)
+ if (.not. associated(CS%h)) then
+ allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke)); CS%h(:,:,:)=0.0
+ ! assign thicknesses
+ call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h)
+ endif
+ allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%T(:,:,:)=0.0
+ allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%S(:,:,:)=0.0
+
+ call set_axes_info(CS%Grid,CS%GV,PF,CS%diag_cs,set_vertical=.true.)
+ do n=1,CS%ensemble_size
+ write(fldnam,'(a,i2.2)') 'temp_prior_',n
+ CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, &
+ 'ocean potential temperature','degC')
+ write(fldnam,'(a,i2.2)') 'salt_prior_',n
+ CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, &
+ 'ocean salinity','psu')
+ write(fldnam,'(a,i2.2)') 'temp_posterior_',n
+ CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, &
+ 'ocean potential temperature','degC')
+ write(fldnam,'(a,i2.2)') 'salt_posterior_',n
+ CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, &
+ 'ocean salinity','psu')
+ enddo
+
+ call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed)
+ allocate(CS%oda_grid)
+ CS%oda_grid%x => CS%Grid%geolonT
+ CS%oda_grid%y => CS%Grid%geolatT
+
+ call get_param(PF, 'oda_driver', "BASIN_FILE", basin_file, &
+ "A file in which to find the basin masks, in variable 'basin'.", &
+ default="basin.nc")
+ basin_file = trim(inputdir) // trim(basin_file)
+ allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed))
+ CS%oda_grid%basin_mask(:,:) = 0.0
+ call MOM_read_data(basin_file,'basin',CS%oda_grid%basin_mask,CS%Grid%domain, timelevel=1)
! get global grid information from ocean_model
- allocate(T_grid)
- allocate(T_grid%x(CS%ni,CS%nj))
- allocate(T_grid%y(CS%ni,CS%nj))
- allocate(T_grid%basin_mask(CS%ni,CS%nj))
- call mpp_global_field(CS%mpp_domain, CS%Grid%geolonT, T_grid%x)
- call mpp_global_field(CS%mpp_domain, CS%Grid%geolatT, T_grid%y)
- call mpp_global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask)
- T_grid%ni = CS%ni
- T_grid%nj = CS%nj
- T_grid%nk = CS%nk
- allocate(T_grid%mask(CS%ni,CS%nj,CS%nk))
- allocate(T_grid%z(CS%ni,CS%nj,CS%nk))
- allocate(global2D(CS%ni,CS%nj))
- allocate(global2D_old(CS%ni,CS%nj))
- T_grid%mask(:,:,:) = 0.0
- T_grid%z(:,:,:) = 0.0
-
- do k = 1, CS%nk
- call mpp_global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D)
- do i=1, CS%ni; do j=1, CS%nj
- if ( global2D(i,j) > 1 ) then
- T_grid%mask(i,j,k) = 1.0
- endif
- enddo ; enddo
- if (k == 1) then
- T_grid%z(:,:,k) = global2D/2
- else
- T_grid%z(:,:,k) = T_grid%z(:,:,k-1) + (global2D + global2D_old)/2
- endif
- global2D_old = global2D
- enddo
-
- call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time)
-
- CS%Time=Time
- !! switch back to ensemble member pelist
- call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:))
- end subroutine init_oda
-
- subroutine set_prior_tracer(Time, G, GV, h, tv, CS)
- type(time_type), intent(in) :: Time !< The current model time
- type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
-
- type(ODA_CS), pointer :: CS !< ocean DA control structure
- real, dimension(:,:,:), allocatable :: T, S
- type(ocean_grid_type), pointer :: Grid=>NULL()
- integer :: i,j, m, n, ss
- integer :: is, ie, js, je
- integer :: isc, iec, jsc, jec
- integer :: isd, ied, jsd, jed
- integer :: id
- logical :: used
-
- ! return if not time for analysis
- if (Time < CS%Time) return
-
- if (.not. associated(CS%Grid)) call MOM_ERROR(FATAL,'ODA_CS ensemble horizontal grid not associated')
- if (.not. associated(CS%GV)) call MOM_ERROR(FATAL,'ODA_CS ensemble vertical grid not associated')
-
- !! switch to global pelist
- call set_current_pelist(CS%filter_pelist)
- if (is_root_pe()) print *, 'Setting prior'
-
- isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec
- call mpp_get_compute_domain(CS%domains(CS%ensemble_id)%mpp_domain,is,ie,js,je)
- call mpp_get_data_domain(CS%domains(CS%ensemble_id)%mpp_domain,isd,ied,jsd,jed)
- allocate(T(isd:ied,jsd:jed,CS%nk))
- allocate(S(isd:ied,jsd:jed,CS%nk))
-
- do j=js,je; do i=is,ie
- call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%T(i,j,:), &
- CS%nk, CS%h(i,j,:), T(i,j,:))
- call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%S(i,j,:), &
- CS%nk, CS%h(i,j,:), S(i,j,:))
+ allocate(T_grid)
+ allocate(T_grid%x(CS%ni,CS%nj))
+ allocate(T_grid%y(CS%ni,CS%nj))
+ allocate(T_grid%basin_mask(CS%ni,CS%nj))
+ call mpp_global_field(CS%mpp_domain, CS%Grid%geolonT, T_grid%x)
+ call mpp_global_field(CS%mpp_domain, CS%Grid%geolatT, T_grid%y)
+ call mpp_global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask)
+ T_grid%ni = CS%ni
+ T_grid%nj = CS%nj
+ T_grid%nk = CS%nk
+ allocate(T_grid%mask(CS%ni,CS%nj,CS%nk))
+ allocate(T_grid%z(CS%ni,CS%nj,CS%nk))
+ allocate(global2D(CS%ni,CS%nj))
+ allocate(global2D_old(CS%ni,CS%nj))
+ T_grid%mask(:,:,:) = 0.0
+ T_grid%z(:,:,:) = 0.0
+
+ do k = 1, CS%nk
+ call mpp_global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D)
+ do i=1, CS%ni; do j=1, CS%nj
+ if ( global2D(i,j) > 1 ) then
+ T_grid%mask(i,j,k) = 1.0
+ endif
enddo ; enddo
-
- do m=1,CS%ensemble_size
- call mpp_redistribute(CS%domains(m)%mpp_domain, T,&
- CS%mpp_domain, CS%Ocean_prior%T(:,:,:,m), complete=.true.)
- call mpp_redistribute(CS%domains(m)%mpp_domain, S,&
- CS%mpp_domain, CS%Ocean_prior%S(:,:,:,m), complete=.true.)
- if (CS%Ocean_prior%id_t(m)>0) &
- used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time)
- if (CS%Ocean_prior%id_s(m)>0) &
- used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time)
- enddo
- deallocate(T,S)
-
- !! switch back to ensemble member pelist
- call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:))
-
- return
-
- end subroutine set_prior_tracer
-
- !> Returns posterior adjustments or full state
- !!Note that only those PEs associated with an ensemble member receive data
- subroutine get_posterior_tracer(Time, CS, h, tv, increment)
- type(time_type), intent(in) :: Time !< the current model time
- type(ODA_CS), pointer :: CS !< ocean DA control structure
- real, dimension(:,:,:), pointer :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables
- logical, optional, intent(in) :: increment
-
- type(ocean_control_struct), pointer :: Ocean_increment=>NULL()
- integer :: i, j, m
- logical :: used, get_inc
-
- ! return if not analysis time (retain pointers for h and tv)
- if (Time < CS%Time) return
-
-
- !! switch to global pelist
- call set_current_pelist(CS%filter_pelist)
- if (is_root_pe()) print *, 'Getting posterior'
-
- get_inc = .true.
- if (present(increment)) get_inc = increment
-
- if (get_inc) then
- allocate(Ocean_increment)
- call init_ocean_ensemble(Ocean_increment,CS%Grid,CS%GV,CS%ensemble_size)
- Ocean_increment%T = CS%Ocean_posterior%T - CS%Ocean_prior%T
- Ocean_increment%S = CS%Ocean_posterior%S - CS%Ocean_prior%S
- endif
- do m=1,CS%ensemble_size
- if (get_inc) then
- call mpp_redistribute(CS%mpp_domain, Ocean_increment%T(:,:,:,m), &
- CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.)
- call mpp_redistribute(CS%mpp_domain, Ocean_increment%S(:,:,:,m), &
- CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.)
- else
- call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%T(:,:,:,m), &
- CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.)
- call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%S(:,:,:,m), &
- CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.)
- endif
- enddo
-
- tv => CS%tv
- h => CS%h
- !! switch back to ensemble member pelist
- call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:))
-
- end subroutine get_posterior_tracer
-
- subroutine oda(Time, CS)
- type(time_type), intent(in) :: Time
- type(oda_CS), intent(inout) :: CS
-
- integer :: i, j
- integer :: m
- integer :: yr, mon, day, hr, min, sec
-
- if ( Time >= CS%Time ) then
-
- !! switch to global pelist
- call set_current_pelist(CS%filter_pelist)
-
- call get_profiles(Time, CS%Profiles, CS%CProfiles)
-#ifdef ENABLE_ECDA
- call ensemble_filter(CS%Ocean_prior, CS%Ocean_posterior, CS%CProfiles, CS%kdroot, CS%mpp_domain, CS%oda_grid)
-#endif
-
- !! switch back to ensemble member pelist
- call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:))
-
- endif
-
- return
- end subroutine oda
-
- subroutine oda_end(CS)
- type(ODA_CS), intent(inout) :: CS
-
- end subroutine oda_end
-
- subroutine init_ocean_ensemble(CS,Grid,GV,ens_size)
- type(ocean_control_struct), pointer :: CS !< Pointer to ODA control structure
- type(ocean_grid_type), pointer :: Grid !< Pointer to ocean analysis grid
- type(verticalGrid_type), pointer :: GV !< Pointer to DA vertical grid
- integer, intent(in) :: ens_size !< ensemble size
-
- integer :: n,is,ie,js,je,nk
-
- nk=GV%ke
- is=Grid%isd;ie=Grid%ied
- js=Grid%jsd;je=Grid%jed
- CS%ensemble_size=ens_size
- allocate(CS%T(is:ie,js:je,nk,ens_size))
- allocate(CS%S(is:ie,js:je,nk,ens_size))
- allocate(CS%SSH(is:ie,js:je,ens_size))
- allocate(CS%id_t(ens_size));CS%id_t(:)=-1
- allocate(CS%id_s(ens_size));CS%id_s(:)=-1
-! allocate(CS%U(is:ie,js:je,nk,ens_size))
-! allocate(CS%V(is:ie,js:je,nk,ens_size))
-! allocate(CS%id_u(ens_size));CS%id_u(:)=-1
-! allocate(CS%id_v(ens_size));CS%id_v(:)=-1
- allocate(CS%id_ssh(ens_size));CS%id_ssh(:)=-1
-
- return
- end subroutine init_ocean_ensemble
-
- subroutine set_analysis_time(Time,CS)
- type(time_type), intent(in) :: Time
- type(ODA_CS), pointer, intent(inout) :: CS
-
- integer :: yr, mon, day, hr, min, sec
-
- if (Time >= CS%Time) then
- CS%Time=increment_time(CS%Time,CS%assim_frequency*3600)
-
- call get_date(Time, yr, mon, day, hr, min, sec)
- if (pe() == mpp_root_pe()) print *, 'Model Time: ', yr, mon, day, hr, min, sec
- call get_date(CS%time, yr, mon, day, hr, min, sec)
- if (pe() == mpp_root_pe()) print *, 'Assimilation Time: ', yr, mon, day, hr, min, sec
+ if (k == 1) then
+ T_grid%z(:,:,k) = global2D/2
+ else
+ T_grid%z(:,:,k) = T_grid%z(:,:,k-1) + (global2D + global2D_old)/2
endif
- if (CS%Time < Time) then
- call MOM_error(FATAL, " set_analysis_time: " // &
- "assimilation interval appears to be shorter than " // &
- "the model timestep")
+ global2D_old = global2D
+ enddo
+
+ call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time)
+
+ CS%Time=Time
+ !! switch back to ensemble member pelist
+ call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:))
+end subroutine init_oda
+
+!> Copy ensemble member tracers to ensemble vector.
+subroutine set_prior_tracer(Time, G, GV, h, tv, CS)
+ type(time_type), intent(in) :: Time !< The current model time
+ type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
+
+ type(ODA_CS), pointer :: CS !< ocean DA control structure
+ real, dimension(:,:,:), allocatable :: T, S
+ type(ocean_grid_type), pointer :: Grid=>NULL()
+ integer :: i,j, m, n, ss
+ integer :: is, ie, js, je
+ integer :: isc, iec, jsc, jec
+ integer :: isd, ied, jsd, jed
+ integer :: id
+ logical :: used
+
+ ! return if not time for analysis
+ if (Time < CS%Time) return
+
+ if (.not. associated(CS%Grid)) call MOM_ERROR(FATAL,'ODA_CS ensemble horizontal grid not associated')
+ if (.not. associated(CS%GV)) call MOM_ERROR(FATAL,'ODA_CS ensemble vertical grid not associated')
+
+ !! switch to global pelist
+ call set_current_pelist(CS%filter_pelist)
+ call MOM_mesg('Setting prior')
+
+ isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec
+ call mpp_get_compute_domain(CS%domains(CS%ensemble_id)%mpp_domain,is,ie,js,je)
+ call mpp_get_data_domain(CS%domains(CS%ensemble_id)%mpp_domain,isd,ied,jsd,jed)
+ allocate(T(isd:ied,jsd:jed,CS%nk))
+ allocate(S(isd:ied,jsd:jed,CS%nk))
+
+ do j=js,je; do i=is,ie
+ call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%T(i,j,:), &
+ CS%nk, CS%h(i,j,:), T(i,j,:))
+ call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%S(i,j,:), &
+ CS%nk, CS%h(i,j,:), S(i,j,:))
+ enddo ; enddo
+
+ do m=1,CS%ensemble_size
+ call mpp_redistribute(CS%domains(m)%mpp_domain, T,&
+ CS%mpp_domain, CS%Ocean_prior%T(:,:,:,m), complete=.true.)
+ call mpp_redistribute(CS%domains(m)%mpp_domain, S,&
+ CS%mpp_domain, CS%Ocean_prior%S(:,:,:,m), complete=.true.)
+ if (CS%Ocean_prior%id_t(m)>0) &
+ used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time)
+ if (CS%Ocean_prior%id_s(m)>0) &
+ used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time)
+ enddo
+ deallocate(T,S)
+
+ !! switch back to ensemble member pelist
+ call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:))
+
+ return
+
+end subroutine set_prior_tracer
+
+!> Returns posterior adjustments or full state
+!!Note that only those PEs associated with an ensemble member receive data
+subroutine get_posterior_tracer(Time, CS, h, tv, increment)
+ type(time_type), intent(in) :: Time !< the current model time
+ type(ODA_CS), pointer :: CS !< ocean DA control structure
+ real, dimension(:,:,:), pointer :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables
+ logical, optional, intent(in) :: increment !< True if returning increment only
+
+ type(ocean_control_struct), pointer :: Ocean_increment=>NULL()
+ integer :: i, j, m
+ logical :: used, get_inc
+
+ ! return if not analysis time (retain pointers for h and tv)
+ if (Time < CS%Time) return
+
+
+ !! switch to global pelist
+ call set_current_pelist(CS%filter_pelist)
+ call MOM_mesg('Getting posterior')
+
+ get_inc = .true.
+ if (present(increment)) get_inc = increment
+
+ if (get_inc) then
+ allocate(Ocean_increment)
+ call init_ocean_ensemble(Ocean_increment,CS%Grid,CS%GV,CS%ensemble_size)
+ Ocean_increment%T = CS%Ocean_posterior%T - CS%Ocean_prior%T
+ Ocean_increment%S = CS%Ocean_posterior%S - CS%Ocean_prior%S
+ endif
+ do m=1,CS%ensemble_size
+ if (get_inc) then
+ call mpp_redistribute(CS%mpp_domain, Ocean_increment%T(:,:,:,m), &
+ CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.)
+ call mpp_redistribute(CS%mpp_domain, Ocean_increment%S(:,:,:,m), &
+ CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.)
+ else
+ call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%T(:,:,:,m), &
+ CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.)
+ call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%S(:,:,:,m), &
+ CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.)
endif
- return
+ enddo
+
+ tv => CS%tv
+ h => CS%h
+ !! switch back to ensemble member pelist
+ call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:))
- end subroutine set_analysis_time
+end subroutine get_posterior_tracer
- subroutine save_obs_diff(filename,CS)
- character(len=*), intent(in) :: filename
- type(ODA_CS), pointer, intent(in) :: CS
+!> Gather observations and sall ODA routines
+subroutine oda(Time, CS)
+ type(time_type), intent(in) :: Time !< the current model time
+ type(oda_CS), intent(inout) :: CS !< the ocean DA control structure
- integer :: fid ! profile file handle
- type(ocean_profile_type), pointer :: Prof=>NULL()
+ integer :: i, j
+ integer :: m
+ integer :: yr, mon, day, hr, min, sec
- fid = open_profile_file(trim(filename), nvar=2, thread=MPP_SINGLE, fset=MPP_SINGLE)
- Prof=>CS%CProfiles
+ if ( Time >= CS%Time ) then
!! switch to global pelist
- !call set_current_pelist(CS%filter_pelist)
+ call set_current_pelist(CS%filter_pelist)
- do while (associated(Prof))
- call write_profile(fid,Prof)
- Prof=>Prof%cnext
- enddo
- call close_profile_file(fid)
+ call get_profiles(Time, CS%Profiles, CS%CProfiles)
+#ifdef ENABLE_ECDA
+ call ensemble_filter(CS%Ocean_prior, CS%Ocean_posterior, CS%CProfiles, CS%kdroot, CS%mpp_domain, CS%oda_grid)
+#endif
!! switch back to ensemble member pelist
- !call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:))
-
- return
- end subroutine save_obs_diff
+ call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:))
- subroutine apply_oda_tracer_increments(dt,G,tv,h,CS)
- real, intent(in) :: dt ! the tracer timestep (seconds)
- type(ocean_grid_type), intent(in) :: G !< ocean grid structure
- type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- intent(in) :: h !< layer thickness (m or kg/m2)
- type(ODA_CS), intent(inout) :: CS !< the data assimilation structure
+ endif
+
+ return
+end subroutine oda
+
+!> Finalize DA module
+subroutine oda_end(CS)
+ type(ODA_CS), intent(inout) :: CS !< the ocean DA control structure
+
+end subroutine oda_end
+
+!> Initialize DA module
+subroutine init_ocean_ensemble(CS,Grid,GV,ens_size)
+ type(ocean_control_struct), pointer :: CS !< Pointer to ODA control structure
+ type(ocean_grid_type), pointer :: Grid !< Pointer to ocean analysis grid
+ type(verticalGrid_type), pointer :: GV !< Pointer to DA vertical grid
+ integer, intent(in) :: ens_size !< ensemble size
+
+ integer :: n,is,ie,js,je,nk
+
+ nk=GV%ke
+ is=Grid%isd;ie=Grid%ied
+ js=Grid%jsd;je=Grid%jed
+ CS%ensemble_size=ens_size
+ allocate(CS%T(is:ie,js:je,nk,ens_size))
+ allocate(CS%S(is:ie,js:je,nk,ens_size))
+ allocate(CS%SSH(is:ie,js:je,ens_size))
+ allocate(CS%id_t(ens_size));CS%id_t(:)=-1
+ allocate(CS%id_s(ens_size));CS%id_s(:)=-1
+! allocate(CS%U(is:ie,js:je,nk,ens_size))
+! allocate(CS%V(is:ie,js:je,nk,ens_size))
+! allocate(CS%id_u(ens_size));CS%id_u(:)=-1
+! allocate(CS%id_v(ens_size));CS%id_v(:)=-1
+ allocate(CS%id_ssh(ens_size));CS%id_ssh(:)=-1
+
+ return
+end subroutine init_ocean_ensemble
+
+!> Set the next analysis time
+subroutine set_analysis_time(Time,CS)
+ type(time_type), intent(in) :: Time !< the current model time
+ type(ODA_CS), pointer, intent(inout) :: CS !< the DA control structure
+
+ character(len=160) :: mesg ! The text of an error message
+ integer :: yr, mon, day, hr, min, sec
+
+ if (Time >= CS%Time) then
+ CS%Time=increment_time(CS%Time,CS%assim_frequency*3600)
+
+ call get_date(Time, yr, mon, day, hr, min, sec)
+ write(mesg,*) 'Model Time: ', yr, mon, day, hr, min, sec
+ call MOM_mesg("set_analysis_time: "//trim(mesg))
+ call get_date(CS%time, yr, mon, day, hr, min, sec)
+ write(mesg,*) 'Assimilation Time: ', yr, mon, day, hr, min, sec
+ call MOM_mesg("set_analysis_time: "//trim(mesg))
+ endif
+ if (CS%Time < Time) then
+ call MOM_error(FATAL, " set_analysis_time: " // &
+ "assimilation interval appears to be shorter than " // &
+ "the model timestep")
+ endif
+ return
+
+end subroutine set_analysis_time
+
+!> Write observation differences to a file
+subroutine save_obs_diff(filename,CS)
+ character(len=*), intent(in) :: filename !< name of output file
+ type(ODA_CS), pointer, intent(in) :: CS !< pointer to DA control structure
+
+ integer :: fid ! profile file handle
+ type(ocean_profile_type), pointer :: Prof=>NULL()
+
+ fid = open_profile_file(trim(filename), nvar=2, thread=MPP_SINGLE, fset=MPP_SINGLE)
+ Prof=>CS%CProfiles
+
+ !! switch to global pelist
+ !call set_current_pelist(CS%filter_pelist)
+
+ do while (associated(Prof))
+ call write_profile(fid,Prof)
+ Prof=>Prof%cnext
+ enddo
+ call close_profile_file(fid)
+
+ !! switch back to ensemble member pelist
+ !call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:))
+
+ return
+end subroutine save_obs_diff
+
+
+!> Apply increments to tracers
+subroutine apply_oda_tracer_increments(dt,G,tv,h,CS)
+ real, intent(in) :: dt !< The tracer timestep (seconds)
+ type(ocean_grid_type), intent(in) :: G !< ocean grid structure
+ type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< layer thickness (m or kg/m2)
+ type(ODA_CS), intent(inout) :: CS !< the data assimilation structure
+
+end subroutine apply_oda_tracer_increments
+
+!> \namespace MOM_oda_driver_mod
+!!
+!! \section section_ODA The Ocean data assimilation (DA) and Ensemble Framework
+!!
+!! The DA framework implements ensemble capability in MOM6. Currently, this framework
+!! is enabled using the cpp directive ENSEMBLE_OCEAN. The ensembles need to be generated
+!! at the level of the calling routine for oda_init or above. The ensemble instances may
+!! exist on overlapping or non-overlapping processors. The ensemble information is accessed
+!! via the FMS ensemble manager. An independent PE layout is used to gather (prior) ensemble
+!! member information where this information is stored in the ODA control structure. This
+!! module was developed in collaboration with Feiyu Lu and Tony Rosati in the GFDL prediction
+!! group for use in their coupled ensemble framework. These interfaces should be suitable for
+!! interfacing MOM6 to other data assimilation packages as well.
- end subroutine apply_oda_tracer_increments
end module MOM_oda_driver_mod
diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90
index 10882aed75..949268c7e9 100644
--- a/src/parameterizations/lateral/MOM_MEKE.F90
+++ b/src/parameterizations/lateral/MOM_MEKE.F90
@@ -64,20 +64,24 @@ module MOM_MEKE
logical :: debug !< If true, write out checksums of data for debugging
! Optional storage
- real, dimension(:,:), allocatable :: del2MEKE ! Laplacian of MEKE, used for bi-harmonic diffusion.
+ real, dimension(:,:), allocatable :: del2MEKE !< Laplacian of MEKE, used for bi-harmonic diffusion.
- ! Diagnostic handles
- type(diag_ctrl), pointer :: diag !< A pointer to shared diagnostics data
+ type(diag_ctrl), pointer :: diag => NULL() !< A type that regulates diagnostics output
+ !>@{ Diagnostic handles
integer :: id_MEKE = -1, id_Ue = -1, id_Kh = -1, id_src = -1
integer :: id_Ub = -1, id_Ut = -1
integer :: id_GM_src = -1, id_mom_src = -1, id_decay = -1
integer :: id_KhMEKE_u = -1, id_KhMEKE_v = -1, id_Ku = -1
integer :: id_Le = -1, id_gamma_b = -1, id_gamma_t = -1
integer :: id_Lrhines = -1, id_Leady = -1
+ !!@}
! Infrastructure
integer :: id_clock_pass !< Clock for group pass calls
- type(group_pass_type) :: pass_MEKE, pass_Kh, pass_Ku, pass_del2MEKE !< Type for group-halo pass calls
+ type(group_pass_type) :: pass_MEKE !< Type for group halo pass calls
+ type(group_pass_type) :: pass_Kh !< Type for group halo pass calls
+ type(group_pass_type) :: pass_Ku !< Type for group halo pass calls
+ type(group_pass_type) :: pass_del2MEKE !< Type for group halo pass calls
end type MEKE_CS
contains
@@ -89,13 +93,14 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv)
type(ocean_grid_type), intent(inout) :: G !< Ocean grid.
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg m-2).
- real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1).
- real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at u-points (s-1).
+ real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1).
+ real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at u-points (s-1).
type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type.
real, intent(in) :: dt !< Model(baroclinic) time-step (s).
type(MEKE_CS), pointer :: CS !< MEKE control structure.
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal flux flux (H m2 s-1).
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Meridional mass flux (H m2 s-1).
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal flux flux (H m2 s-1).
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Meridional mass flux (H m2 s-1).
+
! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
mass, & ! The total mass of the water column, in kg m-2.
@@ -210,13 +215,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv)
do j=js,je ; do I=is-1,ie
drag_vel_u(I,j) = 0.0
if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) &
- drag_vel_u(I,j) = visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j)
+ drag_vel_u(I,j) = GV%Z_to_m*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j)
enddo ; enddo
!$OMP do
do J=js-1,je ; do i=is,ie
drag_vel_v(i,J) = 0.0
if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) &
- drag_vel_v(i,J) = visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J)
+ drag_vel_v(i,J) = GV%Z_to_m*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J)
enddo ; enddo
!$OMP do
@@ -607,7 +612,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass)
do while (resid>0.)
n1 = n1 + 1
EKE = EKEmax
- call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), &
+ call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%Zd_to_m*G%bathyT(i,j), &
MEKE%Rd_dx_h(i,j), SN, EKE, &
bottomFac2, barotrFac2, LmixScale, &
Lrhines, Leady)
@@ -712,7 +717,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, SN_u, SN_v, &
beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 )
endif
! Returns bottomFac2, barotrFac2 and LmixScale
- call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), &
+ call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%Zd_to_m*G%bathyT(i,j), &
MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), &
bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), &
Lrhines(i,j), Leady(i,j))
diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90
index 834a265edd..2b637af239 100644
--- a/src/parameterizations/lateral/MOM_MEKE_types.F90
+++ b/src/parameterizations/lateral/MOM_MEKE_types.F90
@@ -2,35 +2,26 @@ module MOM_MEKE_types
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* This program contains the subroutine that calculates the *
-!* effects of horizontal viscosity, including parameterizations of *
-!* the value of the viscosity itself. mesosclae_EKE calculates *
-!* the evolution of sub-grid scale mesoscale EKE. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
implicit none ; private
+!> This type is used to exchange information related to the MEKE calculations.
type, public :: MEKE_type
! Variables
real, dimension(:,:), pointer :: &
- MEKE => NULL(), & ! Vertically averaged eddy kinetic energy, in m2 s-2.
- GM_src => NULL(), & ! MEKE source due to thickness mixing (GM), in W m-2.
- mom_src => NULL(),& ! MEKE source from lateral friction in the momentum
- ! equations, in W m-2.
- Kh => NULL(), & ! The MEKE-derived lateral mixing coefficient in m2 s-1.
- Rd_dx_h => NULL(), &! The deformation radius compared with the grid
- ! spacing, copied from VarMix_CS, nondim.
- Ku => NULL() ! The MEKE-derived lateral viscosity coefficient in m2 s-1.
- ! This viscosity can be negative when representing backscatter
- ! from unresolved eddies (see Jansen and Held, 2014).
+ MEKE => NULL(), & !< Vertically averaged eddy kinetic energy, in m2 s-2.
+ GM_src => NULL(), & !< MEKE source due to thickness mixing (GM), in W m-2.
+ mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations, in W m-2.
+ Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient in m2 s-1.
+ Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing, nondim.
+ !! Rd_dx_h is copied from VarMix_CS.
+ real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient in m2 s-1.
+ !! This viscosity can be negative when representing backscatter
+ !! from unresolved eddies (see Jansen and Held, 2014).
! Parameters
- real :: KhTh_fac = 1.0 ! Multiplier to map Kh(MEKE) to KhTh, nondim
- real :: KhTr_fac = 1.0 ! Multiplier to map Kh(MEKE) to KhTr, nondim.
- real :: backscatter_Ro_pow = 0.0 ! Power in Rossby number function for backscatter.
- real :: backscatter_Ro_c = 0.0 ! Coefficient in Rossby number function for backscatter.
+ real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh, nondim
+ real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr, nondim.
+ real :: backscatter_Ro_pow = 0.0 !< Power in Rossby number function for backscatter.
+ real :: backscatter_Ro_c = 0.0 !< Coefficient in Rossby number function for backscatter.
end type MEKE_type
end module MOM_MEKE_types
diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90
index 11798d3bdb..3be015faa4 100644
--- a/src/parameterizations/lateral/MOM_hor_visc.F90
+++ b/src/parameterizations/lateral/MOM_hor_visc.F90
@@ -1,74 +1,8 @@
+!> Calculates horizontal viscosity and viscous stresses
module MOM_hor_visc
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, April 1994 - June 2002. *
-!* *
-!* This program contains the subroutine that calculates the *
-!* effects of horizontal viscosity, including parameterizations of *
-!* the value of the viscosity itself. horizontal_viscosity calc- *
-!* ulates the acceleration due to some combination of a biharmonic *
-!* viscosity and a Laplacian viscosity. Either or both may use a *
-!* coefficient that depends on the shear and strain of the flow. *
-!* All metric terms are retained. The Laplacian is calculated as *
-!* the divergence of a stress tensor, using the form suggested by *
-!* Smagorinsky (1993). The biharmonic is calculated by twice *
-!* applying the divergence of the stress tensor that is used to *
-!* calculate the Laplacian, but without the dependence on thickness *
-!* in the first pass. This form permits a variable viscosity, and *
-!* indicates no acceleration for either resting fluid or solid body *
-!* rotation. *
-!* *
-!* set_up_hor_visc calculates and stores the values of a number of *
-!* metric functions that are used in horizontal_viscosity. It is *
-!* called by horizontal_viscosity the first time that the latter is *
-!* called. *
-!* *
-!* The form of the Laplacian viscosity is: *
-!* *
-!* diffu = 1/h * {d/dx[KH*h*sh_xx] + d/dy[KH*h*sh_xy]} *
-!* diffv = 1/h * {d/dx[KH*h*sh_xy] - d/dy[KH*h*sh_xx]} *
-!* *
-!* sh_xx = du/dx - dv/dy sh_xy = du/dy + dv/dx *
-!* *
-!* with appropriate metric terms thrown in. KH may either be a *
-!* constant or may vary with the shear, as proposed by Smagorinsky. *
-!* The form of this term is discussed extensively in Griffies and *
-!* Hallberg (MWR, 2000), and the implementation here follows that *
-!* discussion closely. *
-!* *
-!* Only free slip boundary conditions have been coded, although *
-!* no slip boundary conditions could be used with the Laplacian *
-!* viscosity. For a western boundary, for example, the boundary *
-!* conditions with the biharmonic operator would be written as: *
-!* dv/dx = 0, d^3v/dx^3 = 0, u = 0, d^2u/dx^2 = 0 , *
-!* while for a Laplacian operator, they are simply: *
-!* dv/dx = 0, u = 0 . *
-!* These boundary conditions are largely dictated by the use of *
-!* a an Arakawa C-grid and by the varying layer thickness. *
-!* *
-!* *
-!* *
-!* *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the C-grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q, CoriolisBu, hq, str_xy, sh_xy *
-!* j+1 > o > o > At ^: v, diffv, v0 *
-!* j x ^ x ^ x At >: u, diffu, u0 *
-!* j > o > o > At o: h, str_xx, sh_xx *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
use MOM_diag_mediator, only : diag_ctrl, time_type
use MOM_domains, only : pass_var
@@ -88,133 +22,159 @@ module MOM_hor_visc
public horizontal_viscosity, hor_visc_init, hor_visc_end
+!> Control structure for horizontal viscosity
type, public :: hor_visc_CS ; private
- logical :: Laplacian ! Use a Laplacian horizontal viscosity if true.
- logical :: biharmonic ! Use a biharmonic horizontal viscosity if true.
- logical :: no_slip ! If true, no slip boundary conditions are used.
- ! Otherwise free slip boundary conditions are assumed.
- ! The implementation of the free slip boundary
- ! conditions on a C-grid is much cleaner than the
- ! no slip boundary conditions. The use of free slip
- ! b.c.s is strongly encouraged. The no slip b.c.s
- ! are not implemented with the biharmonic viscosity.
- logical :: bound_Kh ! If true, the Laplacian coefficient is locally
- ! limited to guarantee stability.
- logical :: better_bound_Kh ! If true, use a more careful bounding of the
- ! Laplacian viscosity to guarantee stability.
- logical :: bound_Ah ! If true, the biharmonic coefficient is locally
- ! limited to guarantee stability.
- logical :: better_bound_Ah ! If true, use a more careful bounding of the
- ! biharmonic viscosity to guarantee stability.
- real :: bound_coef ! The nondimensional coefficient of the ratio of
- ! the viscosity bounds to the theoretical maximum
- ! for stability without considering other terms.
- ! The default is 0.8.
- logical :: Smagorinsky_Kh ! If true, use Smagorinsky nonlinear eddy
- ! viscosity. KH is the background value.
- logical :: Smagorinsky_Ah ! If true, use a biharmonic form of Smagorinsky
- ! nonlinear eddy viscosity. AH is the background.
- logical :: Leith_Kh ! If true, use 2D Leith nonlinear eddy
- ! viscosity. KH is the background value.
- logical :: Modified_Leith ! If true, use extra component of Leith viscosity
- ! to damp divergent flow. To use, still set Leith_Kh=.TRUE.
- logical :: Leith_Ah ! If true, use a biharmonic form of 2D Leith
- ! nonlinear eddy viscosity. AH is the background.
- logical :: bound_Coriolis ! If true & SMAGORINSKY_AH is used, the biharmonic
- ! viscosity is modified to include a term that
- ! scales quadratically with the velocity shears.
- logical :: use_Kh_bg_2d ! Read 2d background viscosity from a file.
- real :: Kh_bg_min ! The minimum value allowed for Laplacian horizontal
- ! viscosity. The default is 0.0
- logical :: use_land_mask ! Use the land mask for the computation of thicknesses
- ! at velocity locations. This eliminates the dependence on
- ! arbitrary values over land or outside of the domain.
- ! Default is False to maintain answers with legacy experiments
- ! but should be changed to True for new experiments.
+ logical :: Laplacian !< Use a Laplacian horizontal viscosity if true.
+ logical :: biharmonic !< Use a biharmonic horizontal viscosity if true.
+ logical :: no_slip !< If true, no slip boundary conditions are used.
+ !! Otherwise free slip boundary conditions are assumed.
+ !! The implementation of the free slip boundary
+ !! conditions on a C-grid is much cleaner than the
+ !! no slip boundary conditions. The use of free slip
+ !! b.c.s is strongly encouraged. The no slip b.c.s
+ !! are not implemented with the biharmonic viscosity.
+ logical :: bound_Kh !< If true, the Laplacian coefficient is locally
+ !! limited to guarantee stability.
+ logical :: better_bound_Kh !< If true, use a more careful bounding of the
+ !! Laplacian viscosity to guarantee stability.
+ logical :: bound_Ah !< If true, the biharmonic coefficient is locally
+ !! limited to guarantee stability.
+ logical :: better_bound_Ah !< If true, use a more careful bounding of the
+ !! biharmonic viscosity to guarantee stability.
+ real :: bound_coef !< The nondimensional coefficient of the ratio of
+ !! the viscosity bounds to the theoretical maximum
+ !! for stability without considering other terms.
+ !! The default is 0.8.
+ logical :: Smagorinsky_Kh !< If true, use Smagorinsky nonlinear eddy
+ !! viscosity. KH is the background value.
+ logical :: Smagorinsky_Ah !< If true, use a biharmonic form of Smagorinsky
+ !! nonlinear eddy viscosity. AH is the background.
+ logical :: Leith_Kh !< If true, use 2D Leith nonlinear eddy
+ !! viscosity. KH is the background value.
+ logical :: Modified_Leith !< If true, use extra component of Leith viscosity
+ !! to damp divergent flow. To use, still set Leith_Kh=.TRUE.
+ logical :: Leith_Ah !< If true, use a biharmonic form of 2D Leith
+ !! nonlinear eddy viscosity. AH is the background.
+ logical :: bound_Coriolis !< If true & SMAGORINSKY_AH is used, the biharmonic
+ !! viscosity is modified to include a term that
+ !! scales quadratically with the velocity shears.
+ logical :: use_Kh_bg_2d !< Read 2d background viscosity from a file.
+ real :: Kh_bg_min !< The minimum value allowed for Laplacian horizontal
+ !! viscosity, in m2 s-1. The default is 0.0
+ logical :: use_land_mask !< Use the land mask for the computation of thicknesses
+ !! at velocity locations. This eliminates the dependence on
+ !! arbitrary values over land or outside of the domain.
+ !! Default is False to maintain answers with legacy experiments
+ !! but should be changed to True for new experiments.
+ logical :: anisotropic !< If true, allow anisotropic component to the viscosity.
+ real :: Kh_aniso !< The anisotropic viscosity in m2 s-1.
+ logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function
+ !! of state. This is set depending on ANISOTROPIC_MODE.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx
+ !< The background Laplacian viscosity at h points, in units
+ !! of m2 s-1. The actual viscosity may be the larger of this
+ !! viscosity and the Smagorinsky and Leith viscosities.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_2d
+ !< The background Laplacian viscosity at h points, in units
+ !! of m2 s-1. The actual viscosity may be the larger of this
+ !! viscosity and the Smagorinsky and Leith viscosities.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Ah_bg_xx
+ !< The background biharmonic viscosity at h points, in units
+ !! of m4 s-1. The actual viscosity may be the larger of this
+ !! viscosity and the Smagorinsky and Leith viscosities.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Biharm_Const2_xx
+ !< A constant relating the biharmonic viscosity to the
+ !! square of the velocity shear, in m4 s. This value is
+ !! set to be the magnitude of the Coriolis terms once the
+ !! velocity differences reach a value of order 1/2 MAXVEL.
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: reduction_xx
+ !< The amount by which stresses through h points are reduced
+ !! due to partial barriers. Nondimensional.
real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: &
- Kh_bg_xx, &! The background Laplacian viscosity at h points, in units
- ! of m2 s-1. The actual viscosity may be the larger of this
- ! viscosity and the Smagorinsky and Leith viscosities.
- Kh_bg_2d, &! The background Laplacian viscosity at h points, in units
- ! of m2 s-1. The actual viscosity may be the larger of this
- ! viscosity and the Smagorinsky and Leith viscosities.
- Ah_bg_xx, &! The background biharmonic viscosity at h points, in units
- ! of m4 s-1. The actual viscosity may be the larger of this
- ! viscosity and the Smagorinsky and Leith viscosities.
- Kh_Max_xx, &! The maximum permitted Laplacian viscosity, m2 s-1.
- Ah_Max_xx, &! The maximum permitted biharmonic viscosity, m4 s-1.
- Biharm_Const2_xx,&! A constant relating the biharmonic viscosity to the
- ! square of the velocity shear, in m4 s. This value is
- ! set to be the magnitude of the Coriolis terms once the
- ! velocity differences reach a value of order 1/2 MAXVEL.
-
- reduction_xx ! The amount by which stresses through h points are reduced
- ! due to partial barriers. Nondimensional.
-
+ Kh_Max_xx, & !< The maximum permitted Laplacian viscosity, m2 s-1.
+ Ah_Max_xx, & !< The maximum permitted biharmonic viscosity, m4 s-1.
+ n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points
+ n1n1_m_n2n2_h !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points
+
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Kh_bg_xy
+ !< The background Laplacian viscosity at q points, in units
+ !! of m2 s-1. The actual viscosity may be the larger of this
+ !! viscosity and the Smagorinsky and Leith viscosities.
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Ah_bg_xy
+ !< The background biharmonic viscosity at q points, in units
+ !! of m4 s-1. The actual viscosity may be the larger of this
+ !! viscosity and the Smagorinsky and Leith viscosities.
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Biharm_Const2_xy
+ !< A constant relating the biharmonic viscosity to the
+ !! square of the velocity shear, in m4 s. This value is
+ !! set to be the magnitude of the Coriolis terms once the
+ !! velocity differences reach a value of order 1/2 MAXVEL.
+ real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: reduction_xy
+ !< The amount by which stresses through q points are reduced
+ !! due to partial barriers. Nondimensional.
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: &
- Kh_bg_xy, &! The background Laplacian viscosity at q points, in units
- ! of m2 s-1. The actual viscosity may be the larger of this
- ! viscosity and the Smagorinsky and Leith viscosities.
- Ah_bg_xy, &! The background biharmonic viscosity at q points, in units
- ! of m4 s-1. The actual viscosity may be the larger of this
- ! viscosity and the Smagorinsky and Leith viscosities.
- Kh_Max_xy, &! The maximum permitted Laplacian viscosity, m2 s-1.
- Ah_Max_xy, &! The maximum permitted biharmonic viscosity, m4 s-1.
- Biharm_Const2_xy,&! A constant relating the biharmonic viscosity to the
- ! square of the velocity shear, in m4 s. This value is
- ! set to be the magnitude of the Coriolis terms once the
- ! velocity differences reach a value of order 1/2 MAXVEL.
- reduction_xy ! The amount by which stresses through q points are reduced
- ! due to partial barriers. Nondimensional.
-
-! The following variables are precalculated combinations of metric terms.
+ Kh_Max_xy, & !< The maximum permitted Laplacian viscosity, m2 s-1.
+ Ah_Max_xy, & !< The maximum permitted biharmonic viscosity, m4 s-1.
+ n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points
+ n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points
+
real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: &
- dx2h, dy2h, & ! dx^2 and dy^2 at h points, in m2
- dx_dyT, dy_dxT ! dx/dy and dy/dx at h points, nondim
+ dx2h, & !< Pre-calculated dx^2 at h points, in m2
+ dy2h, & !< Pre-calculated dy^2 at h points, in m2
+ dx_dyT, & !< Pre-calculated dx/dy at h points, nondim
+ dy_dxT !< Pre-calculated dy/dx at h points, nondim
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: &
- dx2q, dy2q, & ! dx^2 and dy^2 at q points, in m2
- dx_dyBu, dy_dxBu ! dx/dy and dy/dx at q points, nondim
+ dx2q, & !< Pre-calculated dx^2 at q points, in m2
+ dy2q, & !< Pre-calculated dy^2 at q points, in m2
+ dx_dyBu, & !< Pre-calculated dx/dy at q points, nondim
+ dy_dxBu !< Pre-calculated dy/dx at q points, nondim
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: &
- Idx2dyCu, Idxdy2u ! 1/(dx^2 dy) and 1/(dx dy^2) at u points, in m-3
+ Idx2dyCu, & !< 1/(dx^2 dy) at u points, in m-3
+ Idxdy2u !< 1/(dx dy^2) at u points, in m-3
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: &
- Idx2dyCv, Idxdy2v ! 1/(dx^2 dy) and 1/(dx dy^2) at v points, in m-3
+ Idx2dyCv, & !< 1/(dx^2 dy) at v points, in m-3
+ Idxdy2v !< 1/(dx dy^2) at v points, in m-3
-! The following variables are precalculated time-invariant combinations of
-! parameters and metric terms.
+ ! The following variables are precalculated time-invariant combinations of
+ ! parameters and metric terms.
real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: &
- Laplac_Const_xx, & ! Laplacian metric-dependent constants (nondim)
- Biharm_Const_xx, & ! Biharmonic metric-dependent constants (nondim)
- Laplac3_Const_xx, & ! Laplacian metric-dependent constants (nondim)
- Biharm5_Const_xx ! Biharmonic metric-dependent constants (nondim)
+ Laplac_Const_xx, & !< Laplacian metric-dependent constants (nondim)
+ Biharm_Const_xx, & !< Biharmonic metric-dependent constants (nondim)
+ Laplac3_Const_xx, & !< Laplacian metric-dependent constants (nondim)
+ Biharm5_Const_xx !< Biharmonic metric-dependent constants (nondim)
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: &
- Laplac_Const_xy, & ! Laplacian metric-dependent constants (nondim)
- Biharm_Const_xy, & ! Biharmonic metric-dependent constants (nondim)
- Laplac3_Const_xy, & ! Laplacian metric-dependent constants (nondim)
- Biharm5_Const_xy ! Biharmonic metric-dependent constants (nondim)
+ Laplac_Const_xy, & !< Laplacian metric-dependent constants (nondim)
+ Biharm_Const_xy, & !< Biharmonic metric-dependent constants (nondim)
+ Laplac3_Const_xy, & !< Laplacian metric-dependent constants (nondim)
+ Biharm5_Const_xy !< Biharmonic metric-dependent constants (nondim)
- type(diag_ctrl), pointer :: diag ! structure to regulate diagnostic timing
+ type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics
- ! diagnostic ids
+ !>@{
+ !! Diagnostic id
integer :: id_diffu = -1, id_diffv = -1
integer :: id_Ah_h = -1, id_Ah_q = -1
integer :: id_Kh_h = -1, id_Kh_q = -1
integer :: id_FrictWork = -1, id_FrictWorkIntz = -1
+ !!@}
end type hor_visc_CS
contains
-!> This subroutine determines the acceleration due to the
-!! horizontal viscosity. A combination of biharmonic and Laplacian
-!! forms can be used. The coefficient may either be a constant or
-!! a shear-dependent form. The biharmonic is determined by twice
-!! taking the divergence of an appropriately defined stress tensor.
-!! The Laplacian is determined by doing so once.
-!! To work, the following fields must be set outside of the usual
-!! is to ie range before this subroutine is called:
-!! v[is-2,is-1,ie+1,ie+2], u[is-2,is-1,ie+1,ie+2], and h[is-1,ie+1],
-!! with a similarly sized halo in the y-direction.
+!> Calculates the acceleration due to the horizontal viscosity.
+!!
+!! A combination of biharmonic and Laplacian forms can be used. The coefficient
+!! may either be a constant or a shear-dependent form. The biharmonic is
+!! determined by twice taking the divergence of an appropriately defined stress
+!! tensor. The Laplacian is determined by doing so once.
+!!
+!! To work, the following fields must be set outside of the usual
+!! is:ie range before this subroutine is called:
+!! u[is-2:ie+2,js-2:je+2]
+!! v[is-2:ie+2,js-2:je+2]
+!! h[is-1:ie+1,js-1:je+1]
subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, OBC)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -238,37 +198,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
type(hor_visc_CS), pointer :: CS !< Pontrol structure returned by a previous
!! call to hor_visc_init.
type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type
-
-! Arguments:
-! (in) u - zonal velocity (m/s)
-! (in) v - meridional velocity (m/s)
-! (in) h - layer thickness (m or kg m-2); h units are referred to as H.
-! (out) diffu - zonal acceleration due to convergence of
-! along-coordinate stress tensor (m/s2)
-! (out) diffv - meridional acceleration due to convergence of
-! along-coordinate stress tensor (m/s2)
-! (inout) MEKE - pointer to a structure containing fields related to
-! Mesoscale Eddy Kinetic Energy
-! (in) VarMix - pointer to a structure with fields that specify the
-! spatially variable viscosities
-! (in) G - ocean grid structure
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - control structure returned by a previous call to
-! hor_visc_init
-! (in) OBC - pointer to an open boundary condition type
-
-! By R. Hallberg, August 1998 - November 1998.
-! This subroutine determines the acceleration due to the
-! horizontal viscosity. A combination of biharmonic and Laplacian
-! forms can be used. The coefficient may either be a constant or
-! a shear-dependent form. The biharmonic is determined by twice
-! taking the divergence of an appropriately defined stress tensor.
-! The Laplacian is determined by doing so once.
-! To work, the following fields must be set outside of the usual
-! is to ie range before this subroutine is called:
-! v[is-2,is-1,ie+1,ie+2], u[is-2,is-1,ie+1,ie+2], and h[is-1,ie+1],
-! with a similarly sized halo in the y-direction.
-
+ ! Local variables
real, dimension(SZIB_(G),SZJ_(G)) :: &
u0, & ! Laplacian of u (m-1 s-1)
h_u ! Thickness interpolated to u points, in H.
@@ -335,8 +265,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
! Laplacian viscosity is rescaled
real :: RoScl ! The scaling function for MEKE source term
real :: FatH ! abs(f) at h-point for MEKE source term (s-1)
+ real :: local_strain ! Local variable for interpolating computed strain rates (s-1).
- logical :: rescale_Kh
+ logical :: rescale_Kh, legacy_bound
logical :: find_FrictWork
logical :: apply_OBC = .false.
logical :: use_MEKE_Ku
@@ -372,46 +303,44 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
call MOM_error(FATAL, "MOM_hor_visc: VarMix%Res_fn_h and " //&
"VarMix%Res_fn_q both need to be associated with Resoln_scaled_Kh.")
endif
+ legacy_bound = (CS%Smagorinsky_Kh .or. CS%Leith_Kh) .and. &
+ (CS%bound_Kh .and. .not.CS%better_bound_Kh)
+
+ ! Coefficient for modified Leith
+ if (CS%Modified_Leith) then
+ mod_Leith = 1.0
+ else
+ mod_Leith = 0.0
+ endif
! Toggle whether to use a Laplacian viscosity derived from MEKE
use_MEKE_Ku = associated(MEKE%Ku)
-!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, &
-!$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, &
-!$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, &
-!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE) &
-!$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, &
-!$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, &
-!$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, &
-!$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, &
-!$OMP div_xx, div_xx_dx, div_xx_dy, mod_Leith, &
-!$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min)
+ !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, &
+ !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, &
+ !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, &
+ !$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, &
+ !$OMP mod_Leith, legacy_bound) &
+ !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, &
+ !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, &
+ !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, &
+ !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, &
+ !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, &
+ !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min)
do k=1,nz
-! This code uses boundary conditions that are consistent with
-! free slip and no normal flow boundary conditions. The boundary
-! conditions for the western boundary, for example, are:
-! dv/dx = 0, d^3v/dx^3 = 0, u = 0, d^2u/dx^2 = 0 .
-! The overall scheme is second order accurate.
-! All of the metric terms are retained, and the repeated use of
-! the symmetric stress tensor insures that no stress is applied with
-! no flow or solid-body rotation, even with non-constant values of
-! of the biharmonic viscosity.
-
-! The following are the forms of the horizontal tension and hori-
-! shearing strain advocated by Smagorinsky (1993) and discussed in
-! Griffies and Hallberg (MWR, 2000).
+ ! The following are the forms of the horizontal tension and horizontal
+ ! shearing strain advocated by Smagorinsky (1993) and discussed in
+ ! Griffies and Hallberg (2000).
+
+ ! Calculate horizontal tension
do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
sh_xx(i,j) = (CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u(I,j,k) - &
G%IdyCu(I-1,j) * u(I-1,j,k)) - &
CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - &
G%IdxCv(i,J-1)*v(i,J-1,k)))
- div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - &
- G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + &
- (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - &
- G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ &
- (h(i,j,k) + h_neglect)
enddo ; enddo
+
! Components for the shearing strain
do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J))
@@ -419,7 +348,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
enddo ; enddo
! Interpolate the thicknesses to velocity points.
- ! The extra wide halos are to accomodate the cross-corner-point projections
+ ! The extra wide halos are to accommodate the cross-corner-point projections
! in OBCs, which are not ordinarily be necessary, and might not be necessary
! even with OBCs if the accelerations are zeroed at OBC points, in which
! case the j-loop for h_u could collapse to j=js=1,je+1. -RWH
@@ -546,37 +475,53 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
endif
enddo ; endif
- if (CS%no_slip) then
- do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
- sh_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) + dudy(I,J) )
- enddo ; enddo
- else
- do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
- sh_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) + dudy(I,J) )
+ ! Calculate horizontal divergence (not from continuity) if needed.
+ ! h_u and h_v include modifications at OBCs from above.
+ if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then
+ do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
+ div_xx(i,j) = ((G%dyCu(I ,j) * u(I ,j,k) * h_u(I ,j) - &
+ G%dyCu(I-1,j) * u(I-1,j,k) * h_u(I-1,j) ) + &
+ (G%dxCv(i,J ) * v(i,J ,k) * h_v(i,J ) - &
+ G%dxCv(i,J-1) * v(i,J-1,k) * h_v(i,J-1) ) )*G%IareaT(i,j)/ &
+ (h(i,j,k) + h_neglect)
enddo ; enddo
endif
+ ! Shearing strain (including no-slip boundary conditions at the 2-D land-sea mask).
+ ! dudy and dvdx include modifications at OBCs from above.
if (CS%no_slip) then
do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
- vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) )
+ sh_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) + dudy(I,J) )
enddo ; enddo
else
do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
- vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) )
+ sh_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) + dudy(I,J) )
enddo ; enddo
endif
-! Vorticity gradient
- do J=js-2,Jeq+1 ; do I=is-1,Ieq+1
- vort_xy_dx(i,J) = CS%DY_dxBu(I,J)*(vort_xy(I,J)*G%IdyCu(I,j) - vort_xy(I-1,J)*G%IdyCu(I-1,j))
- enddo ; enddo
+ if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then
+ ! Calculate relative vorticity (including no-slip boundary conditions at the 2-D land-sea mask).
+ ! dudy and dvdx include modifications at OBCs from above.
+ if (CS%no_slip) then
+ do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
+ vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) )
+ enddo ; enddo
+ else
+ do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
+ vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) )
+ enddo ; enddo
+ endif
- do J=js-1,Jeq+1 ; do I=is-2,Ieq+1
- vort_xy_dy(I,j) = CS%DX_dyBu(I,J)*(vort_xy(I,J)*G%IdxCv(i,J) - vort_xy(I,J-1)*G%IdxCv(i,J-1))
- enddo ; enddo
+ ! Vorticity gradient
+ do J=js-2,Jeq+1 ; do I=is-1,Ieq+1
+ vort_xy_dx(i,J) = CS%DY_dxBu(I,J)*(vort_xy(I,J)*G%IdyCu(I,j) - vort_xy(I-1,J)*G%IdyCu(I-1,j))
+ enddo ; enddo
-! Divergence gradient
- if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then
+ do J=js-1,Jeq+1 ; do I=is-2,Ieq+1
+ vort_xy_dy(I,j) = CS%DX_dyBu(I,J)*(vort_xy(I,J)*G%IdxCv(i,J) - vort_xy(I,J-1)*G%IdxCv(i,J-1))
+ enddo ; enddo
+
+ ! Divergence gradient
do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1
div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j))
enddo ; enddo
@@ -586,14 +531,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
enddo ; enddo
endif
-! Coefficient for modified Leith
- if (CS%Modified_Leith) then
- mod_Leith = 1.0
- else
- mod_Leith = 0.0
- endif
-
-! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u)
+ ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u)
if (CS%biharmonic) then
do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1
u0(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*sh_xx(i+1,j) - CS%DY2h(i,j)*sh_xx(i,j)) + &
@@ -641,23 +579,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
if (CS%Laplacian) then
! Determine the Laplacian viscosity at h points, using the
! largest value from several parameterizations.
- Kh_scale = 1.0 ; if (rescale_Kh) Kh_scale = VarMix%Res_fn_h(i,j)
- KhSm = 0.0; KhLth = 0.0
- if ((CS%Smagorinsky_Kh) .or. (CS%Leith_Kh)) then
- if (CS%Smagorinsky_Kh) &
- KhSm = CS%LAPLAC_CONST_xx(i,j) * Shear_mag
- if (CS%Leith_Kh) &
- KhLth = CS%LAPLAC3_CONST_xx(i,j) * Vort_mag
- Kh = Kh_scale * MAX(KhLth, MAX(CS%Kh_bg_xx(i,j), KhSm))
- if (CS%bound_Kh .and. .not.CS%better_bound_Kh) &
- Kh = MIN(Kh, CS%Kh_Max_xx(i,j))
- else
- Kh = Kh_scale * CS%Kh_bg_xx(i,j)
- endif
-
- if (use_MEKE_Ku) then
- Kh = Kh + MEKE%Ku(i,j)
- endif
+ Kh = CS%Kh_bg_xx(i,j) ! Static (pre-computed) background viscosity
+ if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xx(i,j) * Shear_mag )
+ if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xx(i,j) * Vort_mag )
+ ! All viscosity contributions above are subject to resolution scaling
+ if (rescale_Kh) Kh = VarMix%Res_fn_h(i,j) * Kh
+ ! Older method of bounding for stability
+ if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xx(i,j))
+ Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired.
+ if (use_MEKE_Ku) Kh = Kh + MEKE%Ku(i,j) ! *Add* the MEKE contribution (might be negative)
+ if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * ( 1. - CS%n1n2_h(i,j)**2 ) ! *Add* the tension component
+ ! of anisotropic viscosity
+
+ ! Newer method of bounding for stability
if (CS%better_bound_Kh) then
if (Kh >= hrat_min*CS%Kh_Max_xx(i,j)) then
visc_bound_rem = 0.0
@@ -675,9 +609,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
str_xx(i,j) = 0.0
endif ! Laplacian
+ if (CS%anisotropic) then
+ ! Shearing-strain averaged to h-points
+ local_strain = 0.25 * ( (sh_xy(I,J) + sh_xy(I-1,J-1)) + (sh_xy(I-1,J) + sh_xy(I,J-1)) )
+ ! *Add* the shear-strain contribution to the xx-component of stress
+ str_xx(i,j) = str_xx(i,j) - CS%Kh_aniso * CS%n1n2_h(i,j) * CS%n1n1_m_n2n2_h(i,j) * local_strain
+ endif
+
if (CS%biharmonic) then
-! Determine the biharmonic viscosity at h points, using the
-! largest value from several parameterizations.
+ ! Determine the biharmonic viscosity at h points, using the
+ ! largest value from several parameterizations.
AhSm = 0.0; AhLth = 0.0
if ((CS%Smagorinsky_Ah) .or. (CS%Leith_Ah)) then
if (CS%Smagorinsky_Ah) then
@@ -693,9 +634,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm),AhLth)
if (CS%bound_Ah .and. .not.CS%better_bound_Ah) &
Ah = MIN(Ah, CS%Ah_Max_xx(i,j))
- else
- Ah = CS%Ah_bg_xx(i,j)
- endif ! Smagorinsky_Ah or Leith_Ah
+ else
+ Ah = CS%Ah_bg_xx(i,j)
+ endif ! Smagorinsky_Ah or Leith_Ah
if (CS%better_bound_Ah) then
Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j))
@@ -764,8 +705,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
h2uq = 4.0 * h_u(I,j) * h_u(I,j+1)
h2vq = 4.0 * h_v(i,J) * h_v(i+1,J)
-! hq = 2.0 * h2uq * h2vq / (h_neglect3 + (h2uq + h2vq) * &
-! ((h(i,j,k) + h(i+1,j+1,k)) + (h(i,j+1,k) + h(i+1,j,k))))
+ !hq = 2.0 * h2uq * h2vq / (h_neglect3 + (h2uq + h2vq) * &
+ ! ((h(i,j,k) + h(i+1,j+1,k)) + (h(i,j+1,k) + h(i+1,j,k))))
hq = 2.0 * h2uq * h2vq / (h_neglect3 + (h2uq + h2vq) * &
((h_u(I,j) + h_u(I,j+1)) + (h_v(i,J) + h_v(i+1,J))))
@@ -798,26 +739,22 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
if (CS%Laplacian) then
! Determine the Laplacian viscosity at q points, using the
! largest value from several parameterizations.
- Kh_scale = 1.0 ; if (rescale_Kh) Kh_scale = VarMix%Res_fn_q(I,J)
- KhSm = 0.0; KhLth = 0.0
- if ((CS%Smagorinsky_Kh) .or. (CS%Leith_Kh)) then
- if (CS%Smagorinsky_Kh) &
- KhSm = CS%LAPLAC_CONST_xy(I,J) * Shear_mag
- if (CS%Leith_Kh) &
- KhLth = CS%LAPLAC3_CONST_xy(I,J) * Vort_mag
- Kh = Kh_scale * MAX(MAX(CS%Kh_bg_xy(I,J), KhSm), KhLth)
- if (CS%bound_Kh .and. .not.CS%better_bound_Kh) &
- Kh = MIN(Kh, CS%Kh_Max_xy(I,J))
- else
- Kh = Kh_scale * CS%Kh_bg_xy(I,J)
- endif
- if (use_MEKE_Ku) then
+ Kh = CS%Kh_bg_xy(i,j) ! Static (pre-computed) background viscosity
+ if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xy(I,J) * Shear_mag )
+ if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xy(I,J) * Vort_mag)
+ ! All viscosity contributions above are subject to resolution scaling
+ if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh
+ ! Older method of bounding for stability
+ if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xy(i,j))
+ Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired.
+ if (use_MEKE_Ku) then ! *Add* the MEKE contribution (might be negative)
Kh = Kh + 0.25*( (MEKE%Ku(I,J)+MEKE%Ku(I+1,J+1)) &
+(MEKE%Ku(I+1,J)+MEKE%Ku(I,J+1)) )
endif
- ! Place a floor on the viscosity, if desired.
- Kh = MAX(Kh,CS%Kh_bg_min)
+ if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * CS%n1n2_q(I,J)**2 ! *Add* the shear component
+ ! of anisotropic viscosity
+ ! Newer method of bounding for stability
if (CS%better_bound_Kh) then
if (Kh >= hrat_min*CS%Kh_Max_xy(I,J)) then
visc_bound_rem = 0.0
@@ -835,10 +772,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
str_xy(I,J) = 0.0
endif ! Laplacian
+ if (CS%anisotropic) then
+ ! Horizontal-tension averaged to q-points
+ local_strain = 0.25 * ( (sh_xx(i,j) + sh_xx(i+1,j+1)) + (sh_xx(i+1,j) + sh_xx(i,j+1)) )
+ ! *Add* the tension contribution to the xy-component of stress
+ str_xy(I,J) = str_xy(I,J) - CS%Kh_aniso * CS%n1n2_q(i,j) * CS%n1n1_m_n2n2_q(i,j) * local_strain
+ endif
+
if (CS%biharmonic) then
! Determine the biharmonic viscosity at q points, using the
! largest value from several parameterizations.
- AhSm = 0.0; AhLth = 0.0
+ AhSm = 0.0 ; AhLth = 0.0
if (CS%Smagorinsky_Ah .or. CS%Leith_Ah) then
if (CS%Smagorinsky_Ah) then
if (CS%bound_Coriolis) then
@@ -877,8 +821,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
endif
enddo ; enddo
+ ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent.
do j=js,je ; do I=Isq,Ieq
-! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent.
diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - &
CS%DY2h(i+1,j)*str_xx(i+1,j)) + &
G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - &
@@ -899,7 +843,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
enddo
endif
-! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent.
+ ! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent.
do J=Jsq,Jeq ; do i=is,ie
diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - &
CS%DY2q(I,J) *str_xy(I,J)) - &
@@ -921,7 +865,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
endif
if (find_FrictWork) then ; do j=js,je ; do i=is,ie
- ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v)
+ ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v)
FrictWork(i,j,k) = GV%H_to_kg_m2 * ( &
(str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) &
-str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) &
@@ -986,7 +930,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
enddo ! end of k loop
-! Offer fields for diagnostic averaging.
+ ! Offer fields for diagnostic averaging.
if (CS%id_diffu>0) call post_data(CS%id_diffu, diffu, CS%diag)
if (CS%id_diffv>0) call post_data(CS%id_diffv, diffv, CS%diag)
if (CS%id_FrictWork>0) call post_data(CS%id_FrictWork, FrictWork, CS%diag)
@@ -1005,35 +949,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS,
call post_data(CS%id_FrictWorkIntz, FrictWorkIntz, CS%diag)
endif
-
end subroutine horizontal_viscosity
-!> This subroutine allocates space for and calculates static variables
-!! used by this module. The metrics may be 0, 1, or 2-D arrays,
-!! while fields like the background viscosities are 2-D arrays.
-!! ALLOC is a macro defined in MOM_memory.h to either allocate
-!! for dynamic memory, or do nothing when using static memory.
+!> Allocates space for and calculates static variables used by horizontal_viscosity().
+!! hor_visc_init calculates and stores the values of a number of metric functions that
+!! are used in horizontal_viscosity().
subroutine hor_visc_init(Time, G, param_file, diag, CS)
- type(time_type), intent(in) :: Time !< current model time.
+ type(time_type), intent(in) :: Time !< Current model time.
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
!! parameters.
- type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output.
- type(hor_visc_CS), pointer :: CS !< pointer to the control structure for this module
-
-! This subroutine allocates space for and calculates static variables
-! used by this module. The metrics may be 0, 1, or 2-D arrays,
-! while fields like the background viscosities are 2-D arrays.
-! ALLOC is a macro defined in MOM_memory.h to either allocate
-! for dynamic memory, or do nothing when using static memory.
-!
-! Arguments:
-! (in) Time - current model time
-! (in) G - ocean grid structure
-! (in) param_file - structure to parse for model parameter values
-! (in) diag - structure to regulate diagnostic output
-! (in/out) CS - pointer to the control structure for this module
-
+ type(diag_ctrl), target, intent(inout) :: diag !< Structure to regulate diagnostic output.
+ type(hor_visc_CS), pointer :: CS !< Pointer to the control structure for this module
+ ! Local variables
real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v
real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v
! u0v is the Laplacian sensitivities to the v velocities
@@ -1073,6 +1001,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS)
character(len=64) :: inputdir, filename
real :: deg2rad ! Converts degrees to radians
real :: slat_fn ! sin(lat)**Kh_pwr_of_sine
+ real :: aniso_grid_dir(2) ! Vector (n1,n2) for anisotropic direction
+ integer :: aniso_mode ! Selects the mode for setting the anisotropic direction
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
integer :: i, j
@@ -1104,6 +1034,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS)
CS%bound_Ah = .false. ; CS%better_bound_Ah = .false. ; CS%Smagorinsky_Ah = .false. ; CS%Leith_Ah = .false.
CS%bound_Coriolis = .false.
CS%Modified_Leith = .false.
+ CS%anisotropic = .false.
+ CS%dynamic_aniso = .false.
Kh = 0.0 ; Ah = 0.0
@@ -1168,6 +1100,32 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS)
"If true, the Laplacian coefficient is locally limited \n"//&
"to be stable with a better bounding than just BOUND_KH.", &
default=CS%bound_Kh)
+ call get_param(param_file, mdl, "ANISOTROPIC_VISCOSITY", CS%anisotropic, &
+ "If true, allow anistropic viscosity in the Laplacian\n"//&
+ "horizontal viscosity.", default=.false.)
+ endif
+ if (CS%anisotropic .or. get_all) then
+ call get_param(param_file, mdl, "KH_ANISO", CS%Kh_aniso, &
+ "The background Laplacian anisotropic horizontal viscosity.", &
+ units = "m2 s-1", default=0.0)
+ call get_param(param_file, mdl, "ANISOTROPIC_MODE", aniso_mode, &
+ "Selects the mode for setting the direction of anistropy.\n"//&
+ "\t 0 - Points along the grid i-direction.\n"//&
+ "\t 1 - Points towards East.\n"//&
+ "\t 2 - Points along the flow direction, U/|U|.", &
+ default=0)
+ select case (aniso_mode)
+ case (0)
+ call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, &
+ "The vector pointing in the direction of anistropy for\n"//&
+ "horizont viscosity. n1,n2 are the i,j components relative\n"//&
+ "to the grid.", units = "nondim", fail_if_missing=.true.)
+ case (1)
+ call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, &
+ "The vector pointing in the direction of anistropy for\n"//&
+ "horizont viscosity. n1,n2 are the i,j components relative\n"//&
+ "to the spherical coordinates.", units = "nondim", fail_if_missing=.true.)
+ end select
endif
call get_param(param_file, mdl, "BIHARMONIC", CS%biharmonic, &
@@ -1309,6 +1267,24 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS)
ALLOC_(CS%reduction_xx(isd:ied,jsd:jed)) ; CS%reduction_xx(:,:) = 0.0
ALLOC_(CS%reduction_xy(IsdB:IedB,JsdB:JedB)) ; CS%reduction_xy(:,:) = 0.0
+ if (CS%anisotropic) then
+ ALLOC_(CS%n1n2_h(isd:ied,jsd:jed)) ; CS%n1n2_h(:,:) = 0.0
+ ALLOC_(CS%n1n1_m_n2n2_h(isd:ied,jsd:jed)) ; CS%n1n1_m_n2n2_h(:,:) = 0.0
+ ALLOC_(CS%n1n2_q(IsdB:IedB,JsdB:JedB)) ; CS%n1n2_q(:,:) = 0.0
+ ALLOC_(CS%n1n1_m_n2n2_q(IsdB:IedB,JsdB:JedB)) ; CS%n1n1_m_n2n2_q(:,:) = 0.0
+ select case (aniso_mode)
+ case (0)
+ call align_aniso_tensor_to_grid(CS, aniso_grid_dir(1), aniso_grid_dir(2))
+ case (1)
+ ! call align_aniso_tensor_to_grid(CS, aniso_grid_dir(1), aniso_grid_dir(2))
+ case (2)
+ CS%dynamic_aniso = .true.
+ case default
+ call MOM_error(FATAL, "MOM_hor_visc: "//&
+ "Runtime parameter ANISOTROPIC_MODE is out of range.")
+ end select
+ endif
+
if (CS%use_Kh_bg_2d) then
ALLOC_(CS%Kh_bg_2d(isd:ied,jsd:jed)) ; CS%Kh_bg_2d(:,:) = 0.0
call get_param(param_file, mdl, "KH_BG_2D_FILENAME", filename, &
@@ -1639,11 +1615,30 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS)
end subroutine hor_visc_init
+!> Calculates factors in the anisotropic orientation tensor to be align with the grid.
+!! With n1=1 and n2=0, this recovers the approach of Large et al, 2001.
+subroutine align_aniso_tensor_to_grid(CS, n1, n2)
+ type(hor_visc_CS), pointer :: CS !< Control structure for horizontal viscosity
+ real, intent(in) :: n1 !< i-component of direction vector (nondim)
+ real, intent(in) :: n2 !< j-component of direction vector (nondim)
+ ! Local variables
+ real :: recip_n2_norm
+
+ ! For normalizing n=(n1,n2) in case arguments are not a unit vector
+ recip_n2_norm = n1**2 + n2**2
+ if (recip_n2_norm > 0.) recip_n2_norm = 1./recip_n2_norm
+
+ CS%n1n2_h(:,:) = 2. * ( n1 * n2 ) * recip_n2_norm
+ CS%n1n2_q(:,:) = 2. * ( n1 * n2 ) * recip_n2_norm
+ CS%n1n1_m_n2n2_h(:,:) = ( n1 * n1 - n2 * n2 ) * recip_n2_norm
+ CS%n1n1_m_n2n2_q(:,:) = ( n1 * n1 - n2 * n2 ) * recip_n2_norm
+
+end subroutine align_aniso_tensor_to_grid
+
+!> Deallocates any variables allocated in hor_visc_init.
subroutine hor_visc_end(CS)
-! This subroutine deallocates any variables allocated in hor_visc_init.
-! Argument: CS - The control structure returned by a previous call to
-! hor_visc_init.
- type(hor_visc_CS), pointer :: CS
+ type(hor_visc_CS), pointer :: CS !< The control structure returned by a
+ !! previous call to hor_visc_init.
if (CS%Laplacian .or. CS%biharmonic) then
DEALLOC_(CS%dx2h) ; DEALLOC_(CS%dx2q) ; DEALLOC_(CS%dy2h) ; DEALLOC_(CS%dy2q)
@@ -1681,8 +1676,316 @@ subroutine hor_visc_end(CS)
DEALLOC_(CS%Biharm5_Const_xx) ; DEALLOC_(CS%Biharm5_Const_xy)
endif
endif
+ if (CS%anisotropic) then
+ DEALLOC_(CS%n1n2_h)
+ DEALLOC_(CS%n1n2_q)
+ DEALLOC_(CS%n1n1_m_n2n2_h)
+ DEALLOC_(CS%n1n1_m_n2n2_q)
+ endif
deallocate(CS)
end subroutine hor_visc_end
+
+!> \namespace mom_hor_visc
+!!
+!! This module contains the subroutine horizontal_viscosity() that calculates the
+!! effects of horizontal viscosity, including parameterizations of the value of
+!! the viscosity itself. horizontal_viscosity() calculates the acceleration due to
+!! some combination of a biharmonic viscosity and a Laplacian viscosity. Either or
+!! both may use a coefficient that depends on the shear and strain of the flow.
+!! All metric terms are retained. The Laplacian is calculated as the divergence of
+!! a stress tensor, using the form suggested by Smagorinsky (1993). The biharmonic
+!! is calculated by twice applying the divergence of the stress tensor that is
+!! used to calculate the Laplacian, but without the dependence on thickness in the
+!! first pass. This form permits a variable viscosity, and indicates no
+!! acceleration for either resting fluid or solid body rotation.
+!!
+!! The form of the viscous accelerations is discussed extensively in Griffies and
+!! Hallberg (2000), and the implementation here follows that discussion closely.
+!! We use the notation of Smith and McWilliams (2003) with the exception that the
+!! isotropic viscosity is \f$\kappa_h\f$.
+!!
+!! \section section_horizontal_viscosity Horizontal viscosity in MOM
+!!
+!! In general, the horizontal stress tensor can be written as
+!! \f[
+!! {\bf \sigma} =
+!! \begin{pmatrix}
+!! \frac{1}{2} \left( \sigma_D + \sigma_T \right) & \frac{1}{2} \sigma_S \\\\
+!! \frac{1}{2} \sigma_S & \frac{1}{2} \left( \sigma_D - \sigma_T \right)
+!! \end{pmatrix}
+!! \f]
+!! where \f$\sigma_D\f$, \f$\sigma_T\f$ and \f$\sigma_S\f$ are stresses associated with
+!! invariant factors in the strain-rate tensor. For a Newtonian fluid, the stress
+!! tensor is usually linearly related to the strain-rate tensor. The horizontal
+!! strain-rate tensor is
+!! \f[
+!! \dot{\bf e} =
+!! \begin{pmatrix}
+!! \frac{1}{2} \left( \dot{e}_D + \dot{e}_T \right) & \frac{1}{2} \dot{e}_S \\\\
+!! \frac{1}{2} \dot{e}_S & \frac{1}{2} \left( \dot{e}_D - \dot{e}_T \right)
+!! \end{pmatrix}
+!! \f]
+!! where \f$\dot{e}_D = \partial_x u + \partial_y v\f$ is the horizontal divergence,
+!! \f$\dot{e}_T = \partial_x u - \partial_y v\f$ is the horizontal tension, and
+!! \f$\dot{e}_S = \partial_y u + \partial_x v\f$ is the horizontal shear strain.
+!!
+!! The trace of the stress tensor, \f$tr(\bf \sigma) = \sigma_D\f$, is usually
+!! absorbed into the pressure and only the deviatoric stress tensor considered.
+!! From here on, we drop \f$\sigma_D\f$. The trace of the strain tensor, \f$tr(\bf e) =
+!! \dot{e}_D\f$ is non-zero for horizontally divergent flow but only enters the
+!! stress tensor through \f$\sigma_D\f$ and so we will drop \f$\sigma_D\f$ from
+!! calculations of the strain tensor in the code. Therefore the horizontal stress
+!! tensor can be considered to be
+!! \f[
+!! {\bf \sigma} =
+!! \begin{pmatrix}
+!! \frac{1}{2} \sigma_T & \frac{1}{2} \sigma_S \\\\
+!! \frac{1}{2} \sigma_S & - \frac{1}{2} \sigma_T
+!! \end{pmatrix}
+!! .\f]
+!!
+!! The stresses above are linearly related to the strain through a viscosity
+!! coefficient, \f$\kappa_h\f$:
+!! \f{eqnarray*}{
+!! \sigma_T & = & 2 \kappa_h \dot{e}_T \\\\
+!! \sigma_S & = & 2 \kappa_h \dot{e}_S
+!! .
+!! \f}
+!!
+!! The viscosity \f$\kappa_h\f$ may either be a constant or variable. For example,
+!! \f$\kappa_h\f$ may vary with the shear, as proposed by Smagorinsky (1993).
+!!
+!! The accelerations resulting form the divergence of the stress tensor are
+!! \f{eqnarray*}{
+!! \hat{\bf x} \cdot \left( \nabla \cdot {\bf \sigma} \right)
+!! & = &
+!! \partial_x \left( \frac{1}{2} \sigma_T \right)
+!! + \partial_y \left( \frac{1}{2} \sigma_S \right)
+!! \\\\
+!! & = &
+!! \partial_x \left( \kappa_h \dot{e}_T \right)
+!! + \partial_y \left( \kappa_h \dot{e}_S \right)
+!! \\\\
+!! \hat{\bf y} \cdot \left( \nabla \cdot {\bf \sigma} \right)
+!! & = &
+!! \partial_x \left( \frac{1}{2} \sigma_S \right)
+!! + \partial_y \left( \frac{1}{2} \sigma_T \right)
+!! \\\\
+!! & = &
+!! \partial_x \left( \kappa_h \dot{e}_S \right)
+!! + \partial_y \left( - \kappa_h \dot{e}_T \right)
+!! .
+!! \f}
+!!
+!! The form of the Laplacian viscosity in general coordinates is:
+!! \f{eqnarray*}{
+!! \hat{\bf x} \cdot \left( \nabla \cdot \sigma \right)
+!! & = &
+!! \frac{1}{h} \left[ \partial_x \left( \kappa_h h \dot{e}_T \right)
+!! + \partial_y \left( \kappa_h h \dot{e}_S \right) \right]
+!! \\\\
+!! \hat{\bf y} \cdot \left( \nabla \cdot \sigma \right)
+!! & = &
+!! \frac{1}{h} \left[ \partial_x \left( \kappa_h h \dot{e}_S \right)
+!! - \partial_y \left( \kappa_h h \dot{e}_T \right) \right]
+!! .
+!! \f}
+!!
+!! \subsection section_laplacian_viscosity_coefficient Laplacian viscosity coefficient
+!!
+!! The horizontal viscosity coefficient, \f$\kappa_h\f$, can have multiple components.
+!! The isotropic components are:
+!! - A uniform background component, \f$\kappa_{bg}\f$.
+!! - A constant but spatially variable 2D map, \f$\kappa_{2d}(x,y)\f$.
+!! - A ''MICOM'' viscosity, \f$U_\nu \Delta(x,y)\f$, which uses a constant
+!! velocity scale, \f$U_\nu\f$ and a measure of the grid-spacing \f$\Delta(x,y)^2 =
+!! \frac{2 \Delta x^2 \Delta y^2}{\Delta x^2 + \Delta y^2}\f$.
+!! - A function of
+!! latitude, \f$\kappa_{\phi}(x,y) = \kappa_{\pi/2} |\sin(\phi)|^n\f$.
+!! - A dynamic Smagorinsky viscosity, \f$\kappa_{Sm}(x,y,t) = C_{Sm} \Delta^2 \sqrt{\dot{e}_T^2 + \dot{e}_S^2}\f$.
+!! - A dynamic Leith viscosity, \f$\kappa_{Lth}(x,y,t) =
+!! C_{Lth} \Delta^3 \sqrt{|\nabla \zeta|^2 + |\nabla \dot{e}_D|^2}\f$.
+!!
+!! A maximum stable viscosity, \f$\kappa_{max}(x,y)\f$ is calculated based on the
+!! grid-spacing and time-step and used to clip calculated viscosities.
+!!
+!! The static components of \f$\kappa_h\f$ are first combined as follows:
+!! \f[
+!! \kappa_{static} = \min \left[ \max\left(
+!! \kappa_{bg},
+!! U_\nu \Delta(x,y),
+!! \kappa_{2d}(x,y),
+!! \kappa_\phi(x,y)
+!! \right)
+!! , \kappa_{max}(x,y) \right]
+!! \f]
+!! and stored in the module control structure as variables Kh_bg_xx and
+!! Kh_bg_xy for the tension (h-points) and shear (q-points) components
+!! respectively.
+!!
+!! The full viscosity includes the dynamic components as follows:
+!! \f[
+!! \kappa_h(x,y,t) = r(\Delta,L_d)
+!! \max \left( \kappa_{static}, \kappa_{Sm}, \kappa_{Lth} \right)
+!! \f]
+!! where \f$r(\Delta,L_d)\f$ is a resolution function.
+!!
+!! The dynamic Smagorinsky and Leith viscosity schemes are exclusive with each
+!! other.
+!!
+!! \subsection section_viscous_boundary_conditions Viscous boundary conditions
+!!
+!! Free slip boundary conditions have been coded, although no slip boundary
+!! conditions can be used with the Laplacian viscosity based on the 2D land-sea
+!! mask. For a western boundary, for example, the boundary conditions with the
+!! biharmonic operator would be written as:
+!! \f[
+!! \partial_x v = 0 ; \partial_x^3 v = 0 ; u = 0 ; \partial_x^2 u = 0 ,
+!! \f]
+!! while for a Laplacian operator, they are simply
+!! \f[
+!! \partial_x v = 0 ; u = 0 .
+!! \f]
+!! These boundary conditions are largely dictated by the use of an Arakawa
+!! C-grid and by the varying layer thickness.
+!!
+!! \subsection section_anisotropic_viscosity Anisotropic viscosity
+!!
+!! Large et al., 2001, proposed enhancing viscosity in a particular direction and the
+!! approach was generalized in Smith and McWilliams, 2003. We use the second form of their
+!! two coefficient anisotropic viscosity (section 4.3). We also replace their
+!! \f$A^\prime\f$ nd $D$ such that \f$2A^\prime = 2 \kappa_h + D\f$ and
+!! \f$\kappa_a = D\f$ so that \f$\kappa_h\f$ can be considered the isotropic
+!! viscosity and \f$\kappa_a=D\f$ can be consider the anisotropic viscosity. The
+!! direction of anisotropy is defined by a unit vector \f$\hat{\bf
+!! n}=(n_1,n_2)\f$.
+!!
+!! The contributions to the stress tensor are
+!! \f[
+!! \begin{pmatrix}
+!! \sigma_T \\\\ \sigma_S
+!! \end{pmatrix}
+!! =
+!! \left[
+!! \begin{pmatrix}
+!! 2 \kappa_h + \kappa_a & 0 \\\\
+!! 0 & 2 \kappa_h
+!! \end{pmatrix}
+!! + 2 \kappa_a n_1 n_2
+!! \begin{pmatrix}
+!! - 2 n_1 n_2 & n_1^2 - n_2^2 \\\\
+!! n_1^2 - n_2^2 & 2 n_1 n_2
+!! \end{pmatrix}
+!! \right]
+!! \begin{pmatrix}
+!! \dot{e}_T \\\\ \dot{e}_S
+!! \end{pmatrix}
+!! \f]
+!! Dissipation of kinetic energy requires \f$\kappa_h \geq 0\f$ and \f$2 \kappa_h + \kappa_a \geq 0\f$.
+!! Note that when anisotropy is aligned with the x-direction, \f$n_1 = \pm 1\f$, then
+!! \f$n_2 = 0\f$ and the cross terms vanish. The accelerations in this aligned limit
+!! with constant coefficients become
+!! \f{eqnarray*}{
+!! \hat{\bf x} \cdot \nabla \cdot {\bf \sigma}
+!! & = &
+!! \partial_x \left( \left( \kappa_h + \frac{1}{2} \kappa_a \right) \dot{e}_T \right)
+!! + \partial_y \left( \kappa_h \dot{e}_S \right)
+!! \\\\
+!! & = &
+!! \left( \kappa_h + \kappa_a \right) \partial_{xx} u
+!! + \kappa_h \partial_{yy} u
+!! - \frac{1}{2} \kappa_a \partial_x \left( \partial_x u + \partial_y v \right)
+!! \\\\
+!! \hat{\bf y} \cdot \nabla \cdot {\bf \sigma}
+!! & = &
+!! \partial_x \left( \kappa_h \dot{e}_S \right)
+!! - \partial_y \left( \left( \kappa_h + \frac{1}{2} \kappa_a \right) \dot{e}_T \right)
+!! \\\\
+!! & = &
+!! \kappa_h \partial_{xx} v
+!! + \left( \kappa_h + \kappa_a \right) \partial_{yy} v
+!! - \frac{1}{2} \kappa_a \partial_y \left( \partial_x u + \partial_y v \right)
+!! \f}
+!! which has contributions akin to a negative divergence damping (a divergence
+!! enhancement?) but which is weaker than the enhanced tension terms by half.
+!!
+!! \subsection section_viscous_discretization Discretization
+!!
+!! The horizontal tension, \f$\dot{e}_T\f$, is stored in variable sh_xx and
+!! discretized as
+!! \f[
+!! \dot{e}_T
+!! = \frac{\Delta y}{\Delta x} \delta_i \left( \frac{1}{\Delta y} u \right)
+!! - \frac{\Delta x}{\Delta y} \delta_j \left( \frac{1}{\Delta x} v \right)
+!! .
+!! \f]
+!! The horizontal divergent strain, \f$\dot{e}_D\f$, is stored in variable
+!! div_xx and discretized as
+!! \f[
+!! \dot{e}_D
+!! = \frac{1}{h A} \left( \delta_i \left( \overline{h}^i \Delta y \, u \right)
+!! + \delta_j \left( \overline{h}^j\Delta x \, v \right) \right)
+!! .
+!! \f]
+!! Note that for expediency this is the exact discretization used in the
+!! continuity equation.
+!!
+!! The horizontal shear strain, \f$\dot{e}_S\f$, is stored in variable sh_xy
+!! and discretized as
+!! \f[
+!! \dot{e}_S = v_x + u_y
+!! \f]
+!! where
+!! \f{align*}{
+!! v_x &= \frac{\Delta y}{\Delta x} \delta_i \left( \frac{1}{\Delta y} v \right) \\\\
+!! u_y &= \frac{\Delta x}{\Delta y} \delta_j \left( \frac{1}{\Delta x} u \right)
+!! \f}
+!! which are calculated separately so that no-slip or free-slip boundary
+!! conditions can be applied to \f$v_x\f$ and \f$u_y\f$ where appropriate.
+!!
+!! The tendency for the x-component of the divergence of stress is stored in
+!! variable diffu and discretized as
+!! \f[
+!! \hat{\bf x} \cdot \left( \nabla \cdot {\bf \sigma} \right) =
+!! \frac{1}{A \overline{h}^i} \left(
+!! \frac{1}{\Delta y} \delta_i \left( h \Delta y^2 \kappa_h \dot{e}_T \right) +
+!! \frac{1}{\Delta x} \delta_j \left( \tilde{h}^{ij} \Delta x^2 \kappa_h \dot{e}_S \right)
+!! \right)
+!! .
+!! \f]
+!!
+!! The tendency for the y-component of the divergence of stress is stored in
+!! variable diffv and discretized as
+!! \f[
+!! \hat{\bf y} \cdot \left( \nabla \cdot {\bf \sigma} \right) =
+!! \frac{1}{A \overline{h}^j} \left(
+!! \frac{1}{\Delta y} \delta_i \left( \tilde{h}^{ij} \Delta y^2 A_M \dot{e}_S \right)
+!! - \frac{1}{\Delta x} \delta_j \left( h \Delta x^2 A_M \dot{e}_T \right)
+!! \right)
+!! .
+!! \f]
+!!
+!! \subsection section_viscous_refs References
+!!
+!! Griffies, S.M., and Hallberg, R.W., 2000: Biharmonic friction with a
+!! Smagorinsky-like viscosity for use in large-scale eddy-permitting ocean models.
+!! Monthly Weather Review, 128(8), 2935-2946.
+!! https://doi.org/10.1175/1520-0493(2000)128%3C2935:BFWASL%3E2.0.CO;2
+!!
+!! Large, W.G., Danabasoglu, G., McWilliams, J.C., Gent, P.R. and Bryan, F.O.,
+!! 2001: Equatorial circulation of a global ocean climate model with
+!! anisotropic horizontal viscosity.
+!! Journal of Physical Oceanography, 31(2), pp.518-536.
+!! https://doi.org/10.1175/1520-0485(2001)031%3C0518:ECOAGO%3E2.0.CO;2
+!!
+!! Smagorinsky, J., 1993: Some historical remarks on the use of nonlinear
+!! viscosities. Large eddy simulation of complex engineering and geophysical
+!! flows, 1, 69-106.
+!!
+!! Smith, R.D., and McWilliams, J.C., 2003: Anisotropic horizontal viscosity for
+!! ocean models. Ocean Modelling, 5(2), 129-156.
+!! https://doi.org/10.1016/S1463-5003(02)00016-1
+
end module MOM_hor_visc
diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90
index 3be1ae6192..ed8245d2be 100644
--- a/src/parameterizations/lateral/MOM_internal_tides.F90
+++ b/src/parameterizations/lateral/MOM_internal_tides.F90
@@ -1,30 +1,10 @@
+!> Subroutines that use the ray-tracing equations to propagate the internal tide energy density.
+!!
+!! \author Benjamin Mater & Robert Hallberg, 2015
module MOM_internal_tides
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Benjamin Mater & Robert Hallberg, 2015 *
-!* *
-!* This program contains the subroutines that use the ray-tracing *
-!* equations to propagate the internal tide energy density. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v, tauy *
-!* j x ^ x ^ x At >: u, taux *
-!* j > o > o > At o: h, fluxes. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_debugging, only : is_NaN
use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_axis_init
use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr
@@ -38,18 +18,11 @@ module MOM_internal_tides
use MOM_io, only : slasher, vardesc, MOM_read_data
use MOM_restart, only : register_restart_field, MOM_restart_CS, restart_init, save_restart
use MOM_spatial_means, only : global_area_mean
-use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-)
-use MOM_time_manager, only : get_time, get_date, set_time, set_date
-use MOM_time_manager, only : time_type_to_real
+use MOM_time_manager, only : time_type, time_type_to_real, operator(+), operator(/), operator(-)
use MOM_variables, only : surface, thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
use MOM_wave_structure, only: wave_structure_init, wave_structure, wave_structure_CS
-! Forcing is a structure containing pointers to the forcing fields
-! which may be used to drive MOM. All fluxes are positive downward.
-! Surface is a structure containing pointers to various fields that
-! may be used describe the surface state of MOM.
-
!use, intrinsic :: IEEE_ARITHMETIC
implicit none ; private
@@ -60,105 +33,97 @@ module MOM_internal_tides
public internal_tides_init, internal_tides_end
public get_lowmode_loss
+!> This control structure has parameters for the MOM_internal_tides module
type, public :: int_tide_CS ; private
- logical :: do_int_tides ! If true, use the internal tide code.
- integer :: nFreq = 0
- integer :: nMode = 1
- integer :: nAngle = 24
- integer :: energized_angle = -1
- logical :: corner_adv ! If true, use a corner advection rather than PPM.
- logical :: upwind_1st ! If true, use a first-order upwind scheme.
- logical :: simple_2nd ! If true, use a simple second order (arithmetic
- ! mean) interpolation of the edge values instead
- ! of the higher order interpolation.
- logical :: vol_CFL ! If true, use the ratio of the open face lengths
- ! to the tracer cell areas when estimating CFL
- ! numbers. Without aggress_adjust, the default is
- ! false; it is always true with.
- logical :: use_PPMang ! If true, use PPM for advection of energy in
- ! angular space.
+ logical :: do_int_tides !< If true, use the internal tide code.
+ integer :: nFreq = 0 !< The number of internal tide frequency bands
+ integer :: nMode = 1 !< The number of internal tide vertical modes
+ integer :: nAngle = 24 !< The number of internal tide angular orientations
+ integer :: energized_angle = -1 !< If positive, only this angular band is energized for debugging purposes
+ logical :: corner_adv !< If true, use a corner advection rather than PPM.
+ logical :: upwind_1st !< If true, use a first-order upwind scheme.
+ logical :: simple_2nd !< If true, use a simple second order (arithmetic mean) interpolation
+ !! of the edge values instead of the higher order interpolation.
+ logical :: vol_CFL !< If true, use the ratio of the open face lengths to the tracer cell
+ !! areas when estimating CFL numbers. Without aggress_adjust,
+ !! the default is false; it is always true with aggress_adjust.
+ logical :: use_PPMang !< If true, use PPM for advection of energy in angular space.
real, allocatable, dimension(:,:) :: refl_angle
- ! local coastline/ridge/shelf angles read from file
+ !< local coastline/ridge/shelf angles read from file
! (could be in G control structure)
- real :: nullangle = -999.9 ! placeholder value in cell with no reflection
+ real :: nullangle = -999.9 !< placeholder value in cells with no reflection
real, allocatable, dimension(:,:) :: refl_pref
- ! partial reflection coeff for each ``coast cell"
+ !< partial reflection coeff for each "coast cell"
! (could be in G control structure)
logical, allocatable, dimension(:,:) :: refl_pref_logical
- ! true if reflecting cell with partial reflection
+ !< true if reflecting cell with partial reflection
! (could be in G control structure)
logical, allocatable, dimension(:,:) :: refl_dbl
- ! identifies reflection cells where double reflection
- ! is possible (i.e. ridge cells)
+ !< identifies reflection cells where double reflection
+ !! is possible (i.e. ridge cells)
! (could be in G control structure)
real, allocatable, dimension(:,:,:,:) :: cp
- ! horizontal phase speed [m s-1]
+ !< horizontal phase speed [m s-1]
real, allocatable, dimension(:,:,:,:,:) :: TKE_leak_loss
- ! energy lost due to misc background processes [W m-2]
+ !< energy lost due to misc background processes [W m-2]
real, allocatable, dimension(:,:,:,:,:) :: TKE_quad_loss
- ! energy lost due to quadratic bottom drag [W m-2]
+ !< energy lost due to quadratic bottom drag [W m-2]
real, allocatable, dimension(:,:,:,:,:) :: TKE_Froude_loss
- ! energy lost due to wave breaking [W m-2]
+ !< energy lost due to wave breaking [W m-2]
real, allocatable, dimension(:,:) :: TKE_itidal_loss_fixed
- ! fixed part of the energy lost due to small-scale drag
- ! [kg m-2] here; will be multiplied by N and En to get
- ! into [W m-2]
+ !< fixed part of the energy lost due to small-scale drag
+ !! [kg m-2] here; will be multiplied by N and En to get into [W m-2]
real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss
- ! energy lost due to small-scale wave drag [W m-2]
- real, allocatable, dimension(:,:) :: tot_leak_loss, tot_quad_loss, &
- tot_itidal_loss, tot_Froude_loss, tot_allprocesses_loss
- ! energy loss rates summed over angle, freq, and mode
- real :: q_itides ! fraction of local dissipation (nondimensional)
- real :: En_sum ! global sum of energy for use in debugging
- type(time_type),pointer :: Time
- ! The current model time
- character(len=200) :: inputdir
- ! directory to look for coastline angle file
- real :: decay_rate ! A constant rate at which internal tide energy is
- ! lost to the interior ocean internal wave field.
- real :: cdrag ! The bottom drag coefficient for MEKE (non-dim).
+ !< energy lost due to small-scale wave drag [W m-2]
+ real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes,
+ !! summed over angle, frequency and mode [W m-2]
+ real, allocatable, dimension(:,:) :: tot_quad_loss !< Energy loss rates due to quadratic bottom drag,
+ !! summed over angle, frequency and mode [W m-2]
+ real, allocatable, dimension(:,:) :: tot_itidal_loss !< Energy loss rates due to small-scale drag,
+ !! summed over angle, frequency and mode [W m-2]
+ real, allocatable, dimension(:,:) :: tot_Froude_loss !< Energy loss rates due to wave breaking,
+ !! summed over angle, frequency and mode [W m-2]
+ real, allocatable, dimension(:,:) :: tot_allprocesses_loss !< Energy loss rates due to all processes,
+ !! summed over angle, frequency and mode [W m-2]
+ real :: q_itides !< fraction of local dissipation (nondimensional)
+ real :: En_sum !< global sum of energy for use in debugging
+ type(time_type), pointer :: Time => NULL() !< A pointer to the model's clock.
+ character(len=200) :: inputdir !< directory to look for coastline angle file
+ real :: decay_rate !< A constant rate at which internal tide energy is
+ !! lost to the interior ocean internal wave field.
+ real :: cdrag !< The bottom drag coefficient (non-dim).
logical :: apply_background_drag
- ! If true, apply a drag due to background processes as a sink.
+ !< If true, apply a drag due to background processes as a sink.
logical :: apply_bottom_drag
- ! If true, apply a quadratic bottom drag as a sink.
+ !< If true, apply a quadratic bottom drag as a sink.
logical :: apply_wave_drag
- ! If true, apply scattering due to small-scale
- ! roughness as a sink.
+ !< If true, apply scattering due to small-scale roughness as a sink.
logical :: apply_Froude_drag
- ! If true, apply wave breaking as a sink.
- real, dimension(:,:,:,:,:), pointer :: &
- En ! The internal wave energy density as a function of
- ! (i,j,angle,frequency,mode)
- real, dimension(:,:,:), pointer :: &
- En_restart ! The internal wave energy density as a function of
- ! (i,j,angle); temporary for restart
- real, allocatable, dimension(:) :: &
- frequency ! The frequency of each band.
-
- real :: int_tide_source_x ! delete later
- ! X Location of generation site
- ! for internal tide for testing
- real :: int_tide_source_y ! delete later
- ! Y Location of generation site
- ! for internal tide for testing
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- type(wave_structure_CS), pointer :: wave_structure_CSp => NULL()
-
+ !< If true, apply wave breaking as a sink.
+ real, dimension(:,:,:,:,:), pointer :: En => NULL()
+ !< The internal wave energy density as a function of (i,j,angle,frequency,mode)
+ real, dimension(:,:,:), pointer :: En_restart => NULL()
+ !< The internal wave energy density as a function of (i,j,angle); temporary for restart
+ real, allocatable, dimension(:) :: frequency !< The frequency of each band, in s-1.
+
+ !### Delete later
+ real :: int_tide_source_x !< X Location of generation site for internal tide testing
+ real :: int_tide_source_y !< Y Location of generation site for internal tide testing
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the
+ !! timing of diagnostic output.
+ type(wave_structure_CS), pointer :: wave_structure_CSp => NULL()
+ !< A pointer to the wave_structure module control structure
+
+ !>@{ Diag handles
! Diag handles relevant to all modes, frequencies, and angles
- integer :: id_itide_drag = -1
+ integer :: id_tot_En = -1, id_TKE_itidal_input = -1, id_itide_drag = -1
integer :: id_refl_pref = -1, id_refl_ang = -1, id_land_mask = -1
integer :: id_dx_Cv = -1, id_dy_Cu = -1
- integer :: id_TKE_itidal_input = -1
! Diag handles considering: sums over all modes, frequencies, and angles
- integer :: id_tot_En = -1, &
- id_tot_leak_loss = -1, &
- id_tot_quad_loss = -1, &
- id_tot_itidal_loss = -1, &
- id_tot_Froude_loss = -1, &
- id_tot_allprocesses_loss = -1
+ integer :: id_tot_leak_loss = -1, id_tot_quad_loss = -1, id_tot_itidal_loss = -1
+ integer :: id_tot_Froude_loss = -1, id_tot_allprocesses_loss = -1
! Diag handles considering: all modes & freqs; summed over angles
integer, allocatable, dimension(:,:) :: &
id_En_mode, &
@@ -170,17 +135,21 @@ module MOM_internal_tides
integer, allocatable, dimension(:,:) :: &
id_En_ang_mode, &
id_itidal_loss_ang_mode
+ !!@}
end type int_tide_CS
+!> A structure with the active energy loop bounds.
type :: loop_bounds_type ; private
+ !>@{ The active loop bounds
integer :: ish, ieh, jsh, jeh
+ !!@}
end type loop_bounds_type
contains
-!> This subroutine calls other subroutines in this file that are needed to
-!! refract, propagate, and dissipate energy density of the internal tide.
+!> Calls subroutines in this file that are needed to refract, propagate,
+!! and dissipate energy density of the internal tide.
subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
G, GV, CS)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
@@ -192,32 +161,16 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
!! (needed for wave structure).
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: TKE_itidal_input !< The energy input to the
!! internal waves, in W m-2.
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: vel_btTide !< Barotropic velocity read
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: vel_btTide !< Barotropic velocity read
!! from file, in m s-1.
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency, in s-1.
real, intent(in) :: dt !< Length of time over which these fluxes
!! will be applied, in s.
- type(int_tide_CS), pointer :: CS !< A pointer to the control structure
- !! returned by a previous call to
- !! int_tide_init.
+ type(int_tide_CS), pointer :: CS !< The control structure returned by a
+ !! previous call to int_tide_init.
real, dimension(SZI_(G),SZJ_(G),CS%nMode), &
- intent(in) :: cn
-
- ! This subroutine calls other subroutines in this file that are needed to
- ! refract, propagate, and dissipate energy density of the internal tide.
- !
- ! Arguments:
- ! (in) h - Layer thickness, in m or kg m-2 (needed for wave structure).
- ! (in) tv - Pointer to thermodynamic variables (needed for wave structure).
- ! (in) cn - Internal gravity wave speeds of modes, in m s-1.
- ! (in) TKE_itidal_input - The energy input to the internal waves, in W m-2.
- ! (in) vel_btTide - Barotropic velocity read from file, in m s-1
- ! (in) Nb - Near-bottom buoyancy frequency, in s-1
- ! (in) dt - Length of time over which these fluxes will be applied, in s.
- ! (in) G - The ocean's grid structure.
- ! (in) GV - The ocean's vertical grid structure.
- ! (in) CS - A pointer to the control structure returned by a previous
- ! call to int_tide_init.
+ intent(in) :: cn !< The internal wave speeds of each mode, in m s-1.
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G),2) :: &
test
real, dimension(SZI_(G),SZJ_(G),CS%nFreq,CS%nMode) :: &
@@ -239,6 +192,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
real :: En_new, En_check ! for debugging
real :: En_initial, Delta_E_check ! for debugging
real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! for debugging
+ character(len=160) :: mesg ! The text of an error message
integer :: a, m, fr, i, j, is, ie, js, je, isd, ied, jsd, jed, nAngle, nzm
integer :: id_g, jd_g ! global (decomp-invar) indices (for debugging)
type(group_pass_type), save :: pass_test, pass_En
@@ -288,7 +242,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
call create_group_pass(pass_test, test(:,:,1), test(:,:,2), G%domain, stagger=AGRID)
call start_group_pass(pass_test, G%domain)
- ! Apply half the refraction.*****************************************************
+ ! Apply half the refraction.
do m=1,CS%nMode ; do fr=1,CS%nFreq
call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, CS%nAngle, CS%use_PPMang)
enddo ; enddo
@@ -298,10 +252,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
- print *, 'After first refraction: En<0.0 at ig=', id_g, ', jg=', jd_g
- print *, 'En=',CS%En(i,j,a,fr,m)
- print *, 'Setting En to zero'; CS%En(i,j,a,fr,m) = 0.0
- !stop
+ write(mesg,*) 'After first refraction: En<0.0 at ig=', id_g, ', jg=', jd_g, &
+ 'En=',CS%En(i,j,a,fr,m)
+ call MOM_error(WARNING, "propagate_int_tide: "//trim(mesg))
+ CS%En(i,j,a,fr,m) = 0.0
+! call MOM_error(FATAL, "propagate_int_tide: stopped due to negative energy.")
endif
enddo ; enddo
enddo ; enddo ; enddo
@@ -313,7 +268,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
! Rotate points in the halos as necessary.
call correct_halo_rotation(CS%En, test, G, CS%nAngle)
- ! Propagate the waves.***********************************************************
+ ! Propagate the waves.
do m=1,CS%NMode ; do fr=1,CS%Nfreq
call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, G, CS, CS%NAngle)
enddo ; enddo
@@ -323,34 +278,18 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset
- CS%En(i,j,a,fr,m) = 0.0
- if (abs(CS%En(i,j,a,fr,m))>1.0)then! only print if large
- print *, 'After propagation: En<0.0 at ig=', id_g, ', jg=', jd_g
- print *, 'En=',CS%En(i,j,a,fr,m)
- print *, 'Setting En to zero'
- !stop
+ if (abs(CS%En(i,j,a,fr,m))>1.0) then ! only print if large
+ write(mesg,*) 'After propagation: En<0.0 at ig=', id_g, ', jg=', jd_g, &
+ 'En=', CS%En(i,j,a,fr,m)
+ call MOM_error(WARNING, "propagate_int_tide: "//trim(mesg))
+! call MOM_error(FATAL, "propagate_int_tide: stopped due to negative energy.")
endif
+ CS%En(i,j,a,fr,m) = 0.0
endif
enddo ; enddo
enddo ; enddo ; enddo
- !! Test if energy has passed coast for debugging only; delete later
- !do j=js,je
- ! do i=is,ie
- ! id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset
- ! if (id_g == 106 .and. jd_g == 55 ) then
- !print *, 'After propagation:'
- !print *, 'En_O =', CS%En(i,j,:,1,1), 'refl_angle=', CS%refl_angle(i,j)
- !print *, 'En_W =', CS%En(i-1,j,:,1,1), 'refl_angle=', CS%refl_angle(i-1,j)
- !print *, 'En_NW =', CS%En(i-1,j+1,:,1,1), 'refl_angle=', CS%refl_angle(i-1,j+1)
- !print *, 'En_N =', CS%En(i,j+1,:,1,1), 'refl_angle=', CS%refl_angle(i,j+1)
- !print *, 'En_NE =', CS%En(i+1,j+1,:,1,1), 'refl_angle=', CS%refl_angle(i+1,j+1)
- !print *, 'En_E =', CS%En(i+1,j,:,1,1), 'refl_angle=', CS%refl_angle(i+1,j)
- ! endif
- ! enddo
- ! enddo
-
- ! Apply the other half of the refraction.****************************************
+ ! Apply the other half of the refraction.
do m=1,CS%NMode ; do fr=1,CS%Nfreq
call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, CS%NAngle, CS%use_PPMang)
enddo ; enddo
@@ -360,13 +299,16 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
- print *, 'After second refraction: En<0.0 at ig=', id_g, ', jg=', jd_g
- !stop
+ write(mesg,*) 'After second refraction: En<0.0 at ig=', id_g, ', jg=', jd_g, &
+ 'En=',CS%En(i,j,a,fr,m)
+ call MOM_error(WARNING, "propagate_int_tide: "//trim(mesg))
+ CS%En(i,j,a,fr,m) = 0.0
+! call MOM_error(FATAL, "propagate_int_tide: stopped due to negative energy.")
endif
enddo ; enddo
enddo ; enddo ; enddo
- ! Apply various dissipation mechanisms.******************************************
+ ! Apply various dissipation mechanisms.
if (CS%apply_background_drag .or. CS%apply_bottom_drag &
.or. CS%apply_wave_drag .or. CS%apply_Froude_drag &
.or. (CS%id_tot_En > 0)) then
@@ -394,8 +336,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
- print *, 'After leak loss: En<0.0 at ig=', id_g, ', jg=', jd_g
- !stop
+ write(mesg,*) 'After leak loss: En<0.0 at ig=', id_g, ', jg=', jd_g, &
+ 'En=',CS%En(i,j,a,fr,m)
+ call MOM_error(WARNING, "propagate_int_tide: "//trim(mesg), all_print=.true.)
+ CS%En(i,j,a,fr,m) = 0.0
+! call MOM_error(FATAL, "propagate_int_tide: stopped due to negative energy.")
endif
enddo ; enddo
enddo ; enddo ; enddo
@@ -403,7 +348,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
! Extract the energy for mixing due to bottom drag-------------------------------
if (CS%apply_bottom_drag) then
do j=jsd,jed ; do i=isd,ied
- I_D_here = 1.0 / max(G%bathyT(i,j), 1.0)
+ ! Note the 1 m dimensional scale here. Should this be a parameter?
+ I_D_here = 1.0 / (GV%Z_to_m*max(G%bathyT(i,j), 1.0*GV%m_to_Z))
drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, vel_btTide(i,j)**2 + &
tot_En(i,j) * I_rho0 * I_D_here)) * I_D_here
enddo ; enddo
@@ -419,7 +365,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
- print *, 'After bottom loss: En<0.0 at ig=', id_g, ', jg=', jd_g
+ write(mesg,*) 'After bottom loss: En<0.0 at ig=', id_g, ', jg=', jd_g, &
+ 'En=',CS%En(i,j,a,fr,m)
+ call MOM_error(WARNING, "propagate_int_tide: "//trim(mesg), all_print=.true.)
+ CS%En(i,j,a,fr,m) = 0.0
+! call MOM_error(FATAL, "propagate_int_tide: stopped due to negative energy.")
!stop
endif
enddo ; enddo
@@ -439,23 +389,6 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
nzm = CS%wave_structure_CSp%num_intfaces(i,j)
Ub(i,j,fr,m) = CS%wave_structure_CSp%Uavg_profile(i,j,nzm)
Umax(i,j,fr,m) = maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm))
- !! for debugging print profile, etc. Delete later
- !if (id_g == 260 .and. &
- ! jd_g == 50 .and. &
- ! tot_En_mode(i,j,1,1)>500.0) then
- ! print *, 'Profiles for mode ',m,' and frequency ',fr
- ! print *, 'id_g=', id_g, 'jd_g=', jd_g
- ! print *, 'c',m,'=', cn(i,j,m)
- ! print *, 'nzm=', nzm
- ! print *, 'z=', CS%wave_structure_CSp%z_depths(i,j,1:nzm)
- ! print *, 'N2=', CS%wave_structure_CSp%N2(i,j,1:nzm)
- ! print *, 'Ub=', Ub(i,j,fr,m)
- ! print *, 'Umax=', Umax(i,j,fr,m)
- ! print *, 'Upro=', CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)
- ! print *, 'Wpro=', CS%wave_structure_CSp%W_profile(i,j,1:nzm)
- ! print *, 'En',m,'=', tot_En_mode(i,j,fr,m)
- ! if (m==3) stop
- !endif ! for debug - delete later
enddo ; enddo ! i-loop, j-loop
enddo ; enddo ! fr-loop, m-loop
endif ! apply_wave or _Froude_drag (Ub or Umax needed)
@@ -470,8 +403,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
- print *, 'After wave drag loss: En<0.0 at ig=', id_g, ', jg=', jd_g
- !stop
+ write(mesg,*) 'After wave drag loss: En<0.0 at ig=', id_g, ', jg=', jd_g, &
+ 'En=',CS%En(i,j,a,fr,m)
+ call MOM_error(WARNING, "propagate_int_tide: "//trim(mesg), all_print=.true.)
+ CS%En(i,j,a,fr,m) = 0.0
+! call MOM_error(FATAL, "propagate_int_tide: stopped due to negative energy.")
endif
enddo ; enddo
enddo ; enddo ; enddo
@@ -506,10 +442,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
! Re-scale (reduce) energy due to breaking
CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m)/Fr2_max
! Check (for debugging only)
- if (abs(En_new - En_check) > 1e-10) then
- call MOM_error(WARNING, "MOM_internal_tides: something's wrong with Fr-breaking.")
- print *, "En_new=", En_new
- print *, "En_check=", En_check
+ if (abs(En_new - En_check) > 1e-10) then
+ call MOM_error(WARNING, "MOM_internal_tides: something is wrong with Fr-breaking.", &
+ all_print=.true.)
+ write(mesg,*) "En_new=", En_new , "En_check=", En_check
+ call MOM_error(WARNING, "MOM_internal_tides: "//trim(mesg), all_print=.true.)
endif
enddo
! Check (for debugging)
@@ -517,9 +454,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
TKE_Froude_loss_check = abs(Delta_E_check)/dt
TKE_Froude_loss_tot = sum(CS%TKE_Froude_loss(i,j,:,fr,m))
if (abs(TKE_Froude_loss_check - TKE_Froude_loss_tot) > 1e-10) then
- call MOM_error(WARNING, "MOM_internal_tides: something's wrong with Fr energy update.")
- print *, "TKE_Froude_loss_check=", TKE_Froude_loss_check
- print *, "TKE_Froude_loss_tot=", TKE_Froude_loss_tot
+ call MOM_error(WARNING, "MOM_internal_tides: something is wrong with Fr energy update.", &
+ all_print=.true.)
+ write(mesg,*) "TKE_Froude_loss_check=", TKE_Froude_loss_check, &
+ "TKE_Froude_loss_tot=", TKE_Froude_loss_tot
+ call MOM_error(WARNING, "MOM_internal_tides: "//trim(mesg), all_print=.true.)
endif
endif ! Fr2>1
endif ! Kmag2>0
@@ -532,7 +471,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset
- print *, 'After Froude loss: En<0.0 at ig=', id_g, ', jg=', jd_g
+ write(mesg,*) 'After Froude loss: En<0.0 at ig=', id_g, ', jg=', jd_g, &
+ 'En=',CS%En(i,j,a,fr,m)
+ call MOM_error(WARNING, "propagate_int_tide: "//trim(mesg), all_print=.true.)
+ CS%En(i,j,a,fr,m) = 0.0
+! call MOM_error(FATAL, "propagate_int_tide: stopped due to negative energy.")
!stop
endif
enddo ; enddo
@@ -540,7 +483,6 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
! Check for energy conservation on computational domain.*************************
do m=1,CS%NMode ; do fr=1,CS%Nfreq
- !print *, 'sum_En: mode(',m,'), freq(',fr,'):'
call sum_En(G,CS,CS%En(:,:,:,fr,m),'prop_int_tide')
enddo ; enddo
@@ -637,23 +579,20 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, &
end subroutine propagate_int_tide
-!> This subroutine checks for energy conservation on computational domain
+!> Checks for energy conservation on computational domain
subroutine sum_En(G, CS, En, label)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(int_tide_CS), pointer :: CS
- real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle), intent(in) :: En
- character(len=*), intent(in) :: label
-
- ! This subroutine checks for energy conservation on computational domain
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(int_tide_CS), pointer :: CS !< The control structure returned by a
+ !! previous call to int_tide_init.
+ real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle), &
+ intent(in) :: En !< The energy density of the internal tides, in J m-2.
+ character(len=*), intent(in) :: label !< A label to use in error messages
+ ! Local variables
integer :: m,fr,a
real :: En_sum, tmpForSumming, En_sum_diff, En_sum_pdiff
- integer :: seconds
- real :: Isecs_per_day = 1.0 / 86400.0
+ character(len=160) :: mesg ! The text of an error message
real :: days
- call get_time(CS%Time, seconds)
- days = real(seconds) * Isecs_per_day
-
En_sum = 0.0
tmpForSumming = 0.0
do a=1,CS%nAngle
@@ -669,25 +608,27 @@ subroutine sum_En(G, CS, En, label)
CS%En_sum = En_sum
!! Print to screen
!if (is_root_pe()) then
- ! print *, label,':','days =', days
- ! print *, 'En_sum=', En_sum
- ! print *, 'En_sum_diff=', En_sum_diff
- ! print *, 'Percent change=', En_sum_pdiff, '%'
- ! !if (abs(En_sum_pdiff) > 1.0) then ; stop ; endif
+ ! days = time_type_to_real(CS%Time) / 86400.0
+ ! write(mesg,*) trim(label)//': days =', days, ', En_sum=', En_sum, &
+ ! ', En_sum_diff=', En_sum_diff, ', Percent change=', En_sum_pdiff, '%'
+ ! call MOM_mesg(mesg)
+ !if (is_root_pe() .and. (abs(En_sum_pdiff) > 1.0)) &
+ ! call MOM_error(FATAL, "Run stopped due to excessive internal tide energy change.")
!endif
end subroutine sum_En
-!> This subroutine calculates the energy lost from the propagating internal tide due to
+!> Calculates the energy lost from the propagating internal tide due to
!! scattering over small-scale roughness along the lines of Jayne & St. Laurent (2001).
subroutine itidal_lowmode_loss(G, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(int_tide_CS), pointer :: CS
+ type(int_tide_CS), pointer :: CS !< The control structure returned by a
+ !! previous call to int_tide_init.
real, dimension(G%isd:G%ied,G%jsd:G%jed), &
intent(in) :: Nb !< Near-bottom stratification, in s-1.
real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), &
intent(inout) :: Ub !< Rms (over one period) near-bottom horizontal
- !! mode velocity , in m s-1.
+ !! mode velocity, in m s-1.
real, dimension(G%isd:G%ied,G%jsd:G%jed), &
intent(in) :: TKE_loss_fixed !< Fixed part of energy loss,
!! in kg m-2 (rho*kappa*h^2).
@@ -699,20 +640,7 @@ subroutine itidal_lowmode_loss(G, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt,
real, intent(in) :: dt !< Time increment, in s.
logical,optional, intent(in) :: full_halos !< If true, do the calculation over the
!! entirecomputational domain.
-
- ! This subroutine calculates the energy lost from the propagating internal tide due to
- ! scattering over small-scale roughness along the lines of Jayne & St. Laurent (2001).
- !
- ! Arguments:
- ! (in) Nb - near-bottom stratification, in s-1.
- ! (in) Ub - rms (over one period) near-bottom horizontal mode velocity , in m s-1.
- ! (inout) En - energy density of the internal waves, in J m-2.
- ! (in) TKE_loss_fixed - fixed part of energy loss, in kg m-2 (rho*kappa*h^2)
- ! (out) TKE_loss - energy loss rate, in W m-2 (q*rho*kappa*h^2*N*U^2)
- ! (in) dt - time increment, in s
- ! (in,opt) full_halos - If true, do the calculation over the entire
- ! computational domain.
-
+ ! Local variables
integer :: j,i,m,fr,a, is, ie, js, je
real :: En_tot ! energy for a given mode, frequency, and point summed over angles
real :: TKE_loss_tot ! dissipation for a given mode, frequency, and point summed over angles
@@ -765,7 +693,7 @@ subroutine itidal_lowmode_loss(G, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt,
! En(i,j,a,fr,m) = En(i,j,a,fr,m) - TKE_loss(i,j,a,fr,m)*dt
! else
! call MOM_error(WARNING, "itidal_lowmode_loss: energy loss greater than avalable, "// &
- ! " setting En to zero.")
+ ! " setting En to zero.", all_print=.true.)
! En(i,j,a,fr,m) = 0.0
! endif
! enddo
@@ -780,21 +708,17 @@ end subroutine itidal_lowmode_loss
!> This subroutine extracts the energy lost from the propagating internal which has
!> been summed across all angles, frequencies, and modes for a given mechanism and location.
+!!
!> It can be called from another module to get values from this module's (private) CS.
subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum)
- integer, intent(in) :: i,j
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(int_tide_CS), pointer :: CS
- character(len=*), intent(in) :: mechanism
- real, intent(out) :: TKE_loss_sum !< Total energy loss rate due to specified
- !! mechanism, in W m-2.
-
- ! This subroutine extracts the energy lost from the propagating internal which has
- ! been summed across all angles, frequencies, and modes for a given mechanism and location.
- ! It can be called from another module to get values from this module's (private) CS.
- !
- ! Arguments:
- ! (out) TKE_loss_sum - total energy loss rate due to specified mechanism, in W m-2.
+ integer, intent(in) :: i !< The i-index of the value to be reported.
+ integer, intent(in) :: j !< The j-index of the value to be reported.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(int_tide_CS), pointer :: CS !< The control structure returned by a
+ !! previous call to int_tide_init.
+ character(len=*), intent(in) :: mechanism !< The named mechanism of loss to return
+ real, intent(out) :: TKE_loss_sum !< Total energy loss rate due to specified
+ !! mechanism, in W m-2.
if (mechanism == 'LeakDrag') TKE_loss_sum = CS%tot_leak_loss(i,j) ! not used for mixing yet
if (mechanism == 'QuadDrag') TKE_loss_sum = CS%tot_quad_loss(i,j) ! not used for mixing yet
@@ -803,30 +727,22 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum)
end subroutine get_lowmode_loss
-!> This subroutine does refraction on the internal waves at a single frequency.
+!> Implements refraction on the internal waves at a single frequency.
subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- integer, intent(in) :: NAngle
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ integer, intent(in) :: NAngle !< The number of wave orientations in the
+ !! discretized wave energy spectrum.
real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), &
- intent(inout) :: En !< The internal gravity wave energy density as a
- !! function of space and angular resolution,
- !! in J m-2 radian-1.
+ intent(inout) :: En !< The internal gravity wave energy density as a
+ !! function of space and angular resolution,
+ !! in J m-2 radian-1.
real, dimension(G%isd:G%ied,G%jsd:G%jed), &
- intent(in) :: cn !< Baroclinic mode speed, in m s-1.
- real, intent(in) :: freq !< Wave frequency, in s-1.
- real, intent(in) :: dt !< Time step, in s.
- logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather
- !! than upwind.
- ! This subroutine does refraction on the internal waves at a single frequency.
-
- ! Arguments:
- ! (inout) En - the internal gravity wave energy density as a function of space
- ! and angular resolution, in J m-2 radian-1.
- ! (in) cn - baroclinic mode speed, in m s-1
- ! (in) freq - wave frequency, in s-1
- ! (in) dt - time step, in s
- ! (in) use_PPMang - if true, use PPM for advection rather than upwind
-
+ intent(in) :: cn !< Baroclinic mode speed, in m s-1.
+ real, intent(in) :: freq !< Wave frequency, in s-1.
+ real, intent(in) :: dt !< Time step, in s.
+ logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather
+ !! than upwind.
+ ! Local variables
integer, parameter :: stencil = 2
real, dimension(SZI_(G),1-stencil:NAngle+stencil) :: &
En2d
@@ -941,30 +857,29 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang)
! Update and copy back to En.
do a=1,na ; do i=is,ie
- !if (En2d(i,a)+(Flux_E(i,A-1)-Flux_E(i,A)) < 0.0)then ! for debugging
- ! print *,"refract: OutFlux>Available" ; !stop
+ !if (En2d(i,a)+(Flux_E(i,A-1)-Flux_E(i,A)) < 0.0) then ! for debugging
+ ! call MOM_error(FATAL, "refract: OutFlux>Available")
!endif
En(i,j,a) = En2d(i,a) + (Flux_E(i,A-1) - Flux_E(i,A))
enddo ; enddo
enddo ! j-loop
end subroutine refract
-!> This subroutine calculates the 1-d flux for advection in angular space
-!! using a monotonic piecewise parabolic scheme. Should be within i and j spatial
-!! loops.
+!> This subroutine calculates the 1-d flux for advection in angular space using a monotonic
+!! piecewise parabolic scheme. This needs to be called from within i and j spatial loops.
subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang)
- integer, intent(in) :: NAngle
- real, intent(in) :: dt
- integer, intent(in) :: halo_ang
+ integer, intent(in) :: NAngle !< The number of wave orientations in the
+ !! discretized wave energy spectrum.
+ real, intent(in) :: dt !< Time increment in s.
+ integer, intent(in) :: halo_ang !< The halo size in angular space
real, dimension(1-halo_ang:NAngle+halo_ang), &
- intent(in) :: En2d
+ intent(in) :: En2d !< The internal gravity wave energy density as a
+ !! function of angular resolution, in J m-2 radian-1.
real, dimension(1-halo_ang:NAngle+halo_ang), &
- intent(in) :: CFL_ang
- real, dimension(0:NAngle), intent(out) :: Flux_En
-
- ! This subroutine calculates the 1-d flux for advection in angular space
- ! using a monotonic piecewise parabolic scheme. Should be within i and j spatial
- ! loops
+ intent(in) :: CFL_ang !< The CFL number of the energy advection across angles
+ real, dimension(0:NAngle), intent(out) :: Flux_En !< The time integrated internal wave energy flux
+ !! across angles, in J m-2 radian-1.
+ ! Local variables
real :: flux
real :: u_ang
real :: Angle_size
@@ -1032,28 +947,22 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang)
enddo
end subroutine PPM_angular_advect
-!> This subroutine does refraction on the internal waves at a single frequency.
+!> Propagates internal waves at a single frequency.
subroutine propagate(En, cn, freq, dt, G, CS, NAngle)
- type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
- integer, intent(in) :: NAngle
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
+ integer, intent(in) :: NAngle !< The number of wave orientations in the
+ !! discretized wave energy spectrum.
real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), &
- intent(inout) :: En !< The internal gravity wave energy density as a
- !! function of space and angular resolution,
- !! in J m-2 radian-1.
+ intent(inout) :: En !< The internal gravity wave energy density as a
+ !! function of space and angular resolution,
+ !! in J m-2 radian-1.
real, dimension(G%isd:G%ied,G%jsd:G%jed), &
- intent(in) :: cn !< Baroclinic mode speed, in m s-1.
- real, intent(in) :: freq !< Wave frequency, in s-1.
- real, intent(in) :: dt !< Time step, in s.
- type(int_tide_CS), pointer :: CS
- ! This subroutine does refraction on the internal waves at a single frequency.
-
- ! Arguments:
- ! (inout) En - the internal gravity wave energy density as a function of space
- ! and angular resolution, in J m-2 radian-1.
- ! (in) cn - baroclinic mode speed, in m s-1
- ! (in) freq - wave frequency, in s-1
- ! (in) dt - time step, in s
-
+ intent(in) :: cn !< Baroclinic mode speed, in m s-1.
+ real, intent(in) :: freq !< Wave frequency, in s-1.
+ real, intent(in) :: dt !< Time step, in s.
+ type(int_tide_CS), pointer :: CS !< The control structure returned by a
+ !! previous call to int_tide_init.
+ ! Local variables
real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: &
speed ! The magnitude of the group velocity at the q points for corner adv, in m s-1.
integer, parameter :: stencil = 2
@@ -1174,27 +1083,13 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS
intent(in) :: speed !< The magnitude of the group velocity at the cell
!! corner points, in m s-1.
integer, intent(in) :: energized_wedge !< Index of current ray direction.
- integer, intent(in) :: NAngle
+ integer, intent(in) :: NAngle !< The number of wave orientations in the
+ !! discretized wave energy spectrum.
real, intent(in) :: dt !< Time increment in s.
type(int_tide_CS), pointer :: CS !< The control structure returned by a previous
!! call to continuity_PPM_init.
type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds.
-
- ! This subroutine does first-order corner advection. It was written with the hopes
- ! of smoothing out the garden sprinkler effect, but is too numerically diffusive to
- ! be of much use as of yet. It is not yet compatible with reflection schemes (BDM).
-
- ! Arguments: En - The energy density integrated over an angular band, in W m-2,
- ! intent in/out.
- ! (in) energized_wedge - index of current ray direction
- ! (in) speed - The magnitude of the group velocity at the cell corner
- ! points, in m s-1.
- ! (in) dt - Time increment in s.
- ! (in) G - The ocean's grid structure.
- ! (in) CS - The control structure returned by a previous call to
- ! continuity_PPM_init.
- ! (in) LB - A structure with the active energy loop bounds.
-
+ ! Local variables
integer :: i, j, k, ish, ieh, jsh, jeh, m
real :: TwoPi, Angle_size
real :: energized_angle ! angle through center of current wedge
@@ -1439,31 +1334,25 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS
enddo ; enddo
end subroutine propagate_corner_spread
-! #@# This subroutine needs a doxygen description
+!> Propagates the internal wave energy in the logical x-direction.
subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- integer, intent(in) :: NAngle
+ integer, intent(in) :: NAngle !< The number of wave orientations in the
+ !! discretized wave energy spectrum.
real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), &
intent(inout) :: En !< The energy density integrated over an angular
!! band, in J m-2, intent in/out.
real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), &
intent(in) :: speed_x !< The magnitude of the group velocity at the
!! Cu points, in m s-1.
- real, dimension(Nangle), intent(in) :: Cgx_av, dCgx
+ real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band.
+ real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the
+ !! edges of each angular band.
real, intent(in) :: dt !< Time increment in s.
type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call
!! to continuity_PPM_init.
type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds.
-
- ! Arguments: En - The energy density integrated over an angular band, in J m-2,
- ! intent in/out.
- ! (in) speed_x - The magnitude of the group velocity at the Cu
- ! points, in m s-1.
- ! (in) dt - Time increment in s.
- ! (in) G - The ocean's grid structure.
- ! (in) CS - The control structure returned by a previous call to
- ! continuity_PPM_init.
- ! (in) LB - A structure with the active energy loop bounds.
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
EnL, EnR ! Left and right face energy densities, in J m-2.
real, dimension(SZIB_(G),SZJ_(G)) :: &
@@ -1519,8 +1408,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB)
! Update reflected energy (Jm-2)
do j=jsh,jeh ; do i=ish,ieh
!do a=1,CS%nAngle
- ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging
- ! print *,"propagate_x: OutFlux>Available" ; !stop
+ ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging
+ ! call MOM_error(FATAL, "propagate_x: OutFlux>Available")
! endif
!enddo
En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:))
@@ -1528,31 +1417,25 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB)
end subroutine propagate_x
-! #@# This subroutine needs a doxygen description.
+!> Propagates the internal wave energy in the logical y-direction.
subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- integer, intent(in) :: NAngle
+ integer, intent(in) :: NAngle !< The number of wave orientations in the
+ !! discretized wave energy spectrum.
real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), &
intent(inout) :: En !< The energy density integrated over an angular
!! band, in J m-2, intent in/out.
real, dimension(G%isd:G%ied,G%JsdB:G%JedB), &
intent(in) :: speed_y !< The magnitude of the group velocity at the
!! Cv points, in m s-1.
- real, dimension(Nangle), intent(in) :: Cgy_av, dCgy
+ real, dimension(Nangle), intent(in) :: Cgy_av !< The average y-projection in each angular band.
+ real, dimension(Nangle), intent(in) :: dCgy !< The difference in y-projections between the
+ !! edges of each angular band.
real, intent(in) :: dt !< Time increment in s.
type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call
!! to continuity_PPM_init.
type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds.
-
- ! Arguments: En - The energy density integrated over an angular band, in J m-2,
- ! intent in/out.
- ! (in) speed_y - The magnitude of the group velocity at the Cv
- ! points, in m s-1.
- ! (in) dt - Time increment in s.
- ! (in) G - The ocean's grid structure.
- ! (in) CS - The control structure returned by a previous call to
- ! continuity_PPM_init.
- ! (in) LB - A structure with the active energy loop bounds.
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
EnL, EnR ! South and north face energy densities, in J m-2.
real, dimension(SZI_(G),SZJB_(G)) :: &
@@ -1562,6 +1445,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB)
!real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p
real, dimension(SZI_(G),SZJB_(G),Nangle) :: &
Fdt_m, Fdt_p! South and north energy fluxes, in J
+ character(len=160) :: mesg ! The text of an error message
integer :: i, j, k, ish, ieh, jsh, jeh, a
ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh
@@ -1589,12 +1473,10 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB)
Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J)
Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J)
!if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging
- ! print *,"propagate_y: OutFlux>Available prior to reflection" ; !stop
- ! print *,"flux_y_south=",flux_y(i,J-1)
- ! print *,"flux_y_north=",flux_y(i,J)
- ! print *,"En=",En(i,j,a)
- ! print *,"cn_south=", speed_y(i,J-1) * (Cgy_av(a))
- ! print *,"cn_north=", speed_y(i,J) * (Cgy_av(a))
+ ! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.)
+ ! write(mesg,*) "flux_y_south=",flux_y(i,J-1),"flux_y_north=",flux_y(i,J),"En=",En(i,j,a), &
+ ! "cn_south=", speed_y(i,J-1) * (Cgy_av(a)), "cn_north=", speed_y(i,J) * (Cgy_av(a))
+ ! call MOM_error(WARNING, mesg, .true.)
!endif
enddo ; enddo
@@ -1617,7 +1499,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB)
do j=jsh,jeh ; do i=ish,ieh
!do a=1,CS%nAngle
! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging
- ! print *,"propagate_y: OutFlux>Available" ; !stop
+ ! call MOM_error(FATAL, "propagate_y: OutFlux>Available", .true.)
! endif
!enddo
En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:))
@@ -1625,7 +1507,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB)
end subroutine propagate_y
-!> This subroutines evaluates the zonal mass or volume fluxes in a layer.
+!> Evaluates the zonal mass or volume fluxes in a layer.
subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity, in m s-1.
@@ -1638,21 +1520,12 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL)
real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport,
!! in J s-1.
real, intent(in) :: dt !< Time increment in s.
- integer, intent(in) :: j, ish, ieh !< The index range to work on.
+ integer, intent(in) :: j !< The j-index to work on.
+ integer, intent(in) :: ish !< The start i-index range to work on.
+ integer, intent(in) :: ieh !< The end i-index range to work on.
logical, intent(in) :: vol_CFL !< If true, rescale the ratio of face areas to
!! the cell areas when estimating the CFL number.
-
- ! This subroutines evaluates the zonal mass or volume fluxes in a layer.
- !
- ! Arguments: u - Zonal velocity, in m s-1.
- ! (in) h - Energy density used to calculate the fluxes, in J m-2.
- ! (in) hL, hR - Left- and right- Energy densities in the reconstruction, in J m-2.
- ! (out) uh - The zonal energy transport, in J s-1.
- ! (in) dt - Time increment in s.
- ! (in) G - The ocean's grid structure.
- ! (in) j, ish, ieh - The index range to work on.
- ! (in) vol_CFL - If true, rescale the ratio of face areas to the cell
- ! areas when estimating the CFL number.
+ ! Local variables
real :: CFL ! The CFL number based on the local velocity and grid spacing, ND.
real :: curv_3 ! A measure of the thickness curvature over a grid length,
! with the same units as h_in.
@@ -1678,7 +1551,7 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL)
enddo
end subroutine zonal_flux_En
-!> This subroutines evaluates the meridional mass or volume fluxes in a layer.
+!> Evaluates the meridional mass or volume fluxes in a layer.
subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity, in m s-1.
@@ -1691,21 +1564,13 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL)
real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport,
!! in J s-1.
real, intent(in) :: dt !< Time increment in s.
- integer, intent(in) :: J, ish, ieh !< The index range to work on.
+ integer, intent(in) :: J !< The j-index to work on.
+ integer, intent(in) :: ish !< The start i-index range to work on.
+ integer, intent(in) :: ieh !< The end i-index range to work on.
logical, intent(in) :: vol_CFL !< If true, rescale the ratio of face
!! areas to the cell areas when estimating
!! the CFL number.
- ! This subroutines evaluates the meridional mass or volume fluxes in a layer.
- !
- ! Arguments: v - Meridional velocity, in m s-1.
- ! (in) h - Energy density used to calculate the fluxes, in J m-2.
- ! (in) hL, hR - Left- and right- Energy densities in the reconstruction, in J m-2.
- ! (out) vh - The meridional energy transport, in J s-1.
- ! (in) dt - Time increment in s.
- ! (in) G - The ocean's grid structure.
- ! (in) J, ish, ieh - The index range to work on.
- ! (in) vol_CFL - If true, rescale the ratio of face areas to the cell
- ! areas when estimating the CFL number.
+ ! Local variables
real :: CFL ! The CFL number based on the local velocity and grid spacing, ND.
real :: curv_3 ! A measure of the thickness curvature over a grid length,
! with the same units as h_in.
@@ -1730,17 +1595,19 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL)
enddo
end subroutine merid_flux_En
-!> This subroutine does reflection of the internal waves at a single frequency.
+!> Reflection of the internal waves at a single frequency.
subroutine reflect(En, NAngle, CS, G, LB)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- integer, intent(in) :: NAngle
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ integer, intent(in) :: NAngle !< The number of wave orientations in the
+ !! discretized wave energy spectrum.
real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), &
- intent(inout) :: En
- type(int_tide_CS), pointer :: CS
- type(loop_bounds_type), intent(in) :: LB
-
- ! This subroutine does reflection of the internal waves at a single frequency.
-
+ intent(inout) :: En !< The internal gravity wave energy density as a
+ !! function of space and angular resolution,
+ !! in J m-2 radian-1.
+ type(int_tide_CS), pointer :: CS !< The control structure returned by a
+ !! previous call to int_tide_init.
+ type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds.
+ ! Local variables
real, dimension(G%isd:G%ied,G%jsd:G%jed) :: angle_c
! angle of boudary wrt equator
real, dimension(G%isd:G%ied,G%jsd:G%jed) :: part_refl
@@ -1784,10 +1651,9 @@ subroutine reflect(En, NAngle, CS, G, LB)
!do j=jsc-1,jec+1
do j=jsh,jeh
- jd_g = j + G%jdg_offset
!do i=isc-1,iec+1
do i=ish,ieh
- id_g = i + G%idg_offset
+ ! jd_g = j + G%jdg_offset ; id_g = i + G%idg_offset
! redistribute energy in angular space if ray will hit boundary
! i.e., if energy is in a reflecting cell
if (angle_c(i,j) /= CS%nullangle) then
@@ -1832,34 +1698,30 @@ subroutine reflect(En, NAngle, CS, G, LB)
enddo ! j-loop
! Check to make sure no energy gets onto land (only run for debugging)
- !do j=jsc,jec
- ! jd_g = j + G%jdg_offset
- ! do i=isc,iec
- ! id_g = i + G%idg_offset
- ! do a=1,NAngle
- ! if (En(i,j,a) > 0.001 .and. G%mask2dT(i,j) == 0) then
- ! print *, 'En=', En(i,j,a), 'a=', a, 'ig_g=',id_g, 'jg_g=',jd_g
- ! !stop 'Energy detected out of bounds!'
- ! endif
- ! enddo ! a-loop
- ! enddo ! i-loop
- !enddo ! j-loop
+ ! do a=1,NAngle ; do j=jsc,jec ; do i=isc,iec
+ ! if (En(i,j,a) > 0.001 .and. G%mask2dT(i,j) == 0) then
+ ! jd_g = j + G%jdg_offset ; id_g = i + G%idg_offset
+ ! write (mesg,*) 'En=', En(i,j,a), 'a=', a, 'ig_g=',id_g, 'jg_g=',jd_g
+ ! call MOM_error(FATAL, "reflect: Energy detected out of bounds: "//trim(mesg), .true.)
+ ! endif
+ ! enddo ; enddo ; enddo
end subroutine reflect
-!> This subroutine moves energy across lines of partial reflection to prevent
+!> Moves energy across lines of partial reflection to prevent
!! reflection of energy that is supposed to get across.
subroutine teleport(En, NAngle, CS, G, LB)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- integer, intent(in) :: NAngle
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ integer, intent(in) :: NAngle !< The number of wave orientations in the
+ !! discretized wave energy spectrum.
real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), &
- intent(inout) :: En
- type(int_tide_CS), pointer :: CS
- type(loop_bounds_type), intent(in) :: LB
-
- ! This subroutine moves energy across lines of partial reflection to prevent
- ! reflection of energy that is supposed to get across.
-
+ intent(inout) :: En !< The internal gravity wave energy density as a
+ !! function of space and angular resolution,
+ !! in J m-2 radian-1.
+ type(int_tide_CS), pointer :: CS !< The control structure returned by a
+ !! previous call to int_tide_init.
+ type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds.
+ ! Local variables
real, dimension(G%isd:G%ied,G%jsd:G%jed) :: angle_c
! angle of boudary wrt equator
real, dimension(G%isd:G%ied,G%jsd:G%jed) :: part_refl
@@ -1874,6 +1736,7 @@ subroutine teleport(En, NAngle, CS, G, LB)
real, dimension(1:NAngle) :: angle_i ! angle of incident ray wrt equator
real, dimension(1:NAngle) :: cos_angle, sin_angle
real :: En_tele ! energy to be "teleported"
+ character(len=160) :: mesg ! The text of an error message
integer :: i, j, a
!integer :: isd, ied, jsd, jed ! start and end local indices on data domain
! ! (values include halos)
@@ -1935,9 +1798,8 @@ subroutine teleport(En, NAngle, CS, G, LB)
En(i,j,a) = En(i,j,a) - En_tele
En(i+ios,j+jos,a) = En(i+ios,j+jos,a) + En_tele
else
- call MOM_error(WARNING, "teleport: no receptive ocean cell", .true.)
- print *, 'idg=',id_g,'jd_g=',jd_g,'a=',a
- stop
+ write(mesg,*) 'idg=',id_g,'jd_g=',jd_g,'a=',a
+ call MOM_error(FATAL, "teleport: no receptive ocean cell at "//trim(mesg), .true.)
endif
endif ! incidence check
endif ! energy check
@@ -1948,21 +1810,25 @@ subroutine teleport(En, NAngle, CS, G, LB)
end subroutine teleport
-!> This subroutine rotates points in the halos where required to accomodate
+!> Rotates points in the halos where required to accomodate
!! changes in grid orientation, such as at the tripolar fold.
subroutine correct_halo_rotation(En, test, G, NAngle)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- real, dimension(:,:,:,:,:), intent(inout) :: En
- real, dimension(SZI_(G),SZJ_(G),2), intent(in) :: test
- integer, intent(in) :: NAngle
- ! This subroutine rotates points in the halos where required to accomodate
- ! changes in grid orientation, such as at the tripolar fold.
-
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(:,:,:,:,:), intent(inout) :: En !< The internal gravity wave energy density as a
+ !! function of space, angular orientation, frequency,
+ !! and vertical mode, in J m-2 radian-1.
+ real, dimension(SZI_(G),SZJ_(G),2), &
+ intent(in) :: test !< An x-unit vector that has been passed through
+ !! the halo updates, to enable the rotation of the
+ !! wave energies in the halo region to be corrected.
+ integer, intent(in) :: NAngle !< The number of wave orientations in the
+ !! discretized wave energy spectrum.
+ ! Local variables
real, dimension(G%isd:G%ied,NAngle) :: En2d
integer, dimension(G%isd:G%ied) :: a_shift
integer :: i_first, i_last, a_new
integer :: a, i, j, isd, ied, jsd, jed, m, fr
- character(len=80) :: mesg
+ character(len=160) :: mesg ! The text of an error message
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
do j=jsd,jed
@@ -2002,7 +1868,7 @@ subroutine correct_halo_rotation(En, test, G, NAngle)
enddo
end subroutine correct_halo_rotation
-!> This subroutine calculates left/right edge values for PPM reconstruction.
+!> Calculates left/right edge values for PPM reconstruction in x-direction.
subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D).
@@ -2012,22 +1878,13 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd)
logical, optional, intent(in) :: simple_2nd !< If true, use the arithmetic mean
!! energy densities as default edge values
!! for a simple 2nd order scheme.
-
- ! This subroutine calculates left/right edge values for PPM reconstruction.
- ! Arguments: h_in - Energy density in a sector (2D)
- ! (out) h_l,h_r - left/right edge value of reconstruction (2D)
- ! (in) G - The ocean's grid structure.
- ! (in) LB - A structure with the active loop bounds.
- ! (in, opt) simple_2nd - If true, use the arithmetic mean energy densities as
- ! default edge values for a simple 2nd order scheme.
-
- ! Local variables with useful mnemonic names.
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes.
real, parameter :: oneSixth = 1./6.
real :: h_ip1, h_im1
real :: dMx, dMn
logical :: use_CW84, use_2nd
- character(len=256) :: mesg
+ character(len=256) :: mesg ! The text of an error message
integer :: i, j, isl, iel, jsl, jel, stencil
use_2nd = .false. ; if (present(simple_2nd)) use_2nd = simple_2nd
@@ -2087,7 +1944,7 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd)
call PPM_limit_pos(h_in, h_l, h_r, 0.0, G, isl, iel, jsl, jel)
end subroutine PPM_reconstruction_x
-!> This subroutine calculates left/right edge valus for PPM reconstruction.
+!> Calculates left/right edge valus for PPM reconstruction in y-direction.
subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D).
@@ -2097,22 +1954,13 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd)
logical, optional, intent(in) :: simple_2nd !< If true, use the arithmetic mean
!! energy densities as default edge values
!! for a simple 2nd order scheme.
-
- ! This subroutine calculates left/right edge valus for PPM reconstruction.
- ! Arguments: h_in - Energy density in a sector (2D)
- ! (out) h_l,h_r - left/right edge value of reconstruction (2D)
- ! (in) G - The ocean's grid structure.
- ! (in) LB - A structure with the active loop bounds.
- ! (in, opt) simple_2nd - If true, use the arithmetic mean energy densities as
- ! default edge values for a simple 2nd order scheme.
-
- ! Local variables with useful mnemonic names.
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes.
real, parameter :: oneSixth = 1./6.
real :: h_jp1, h_jm1
real :: dMx, dMn
logical :: use_2nd
- character(len=256) :: mesg
+ character(len=256) :: mesg ! The text of an error message
integer :: i, j, isl, iel, jsl, jel, stencil
use_2nd = .false. ; if (present(simple_2nd)) use_2nd = simple_2nd
@@ -2170,7 +2018,7 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd)
call PPM_limit_pos(h_in, h_l, h_r, 0.0, G, isl, iel, jsl, jel)
end subroutine PPM_reconstruction_y
-!> This subroutine limits the left/right edge values of the PPM reconstruction
+!> Limits the left/right edge values of the PPM reconstruction
!! to give a reconstruction that is positive-definite. Here this is
!! reinterpreted as giving a constant thickness if the mean thickness is less
!! than h_min, with a minimum of h_min otherwise.
@@ -2181,24 +2029,13 @@ subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie)
real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right edge value (2D).
real, intent(in) :: h_min !< The minimum thickness that can be
!! obtained by a concave parabolic fit.
- integer, intent(in) :: iis, iie, jis, jie !< Index range for
- !! computation.
-
- ! This subroutine limits the left/right edge values of the PPM reconstruction
- ! to give a reconstruction that is positive-definite. Here this is
- ! reinterpreted as giving a constant thickness if the mean thickness is less
- ! than h_min, with a minimum of h_min otherwise.
- ! Arguments: h_in - thickness of layer (2D)
- ! (inout) h_L - left edge value (2D)
- ! (inout) h_R - right edge value (2D)
- ! (in) h_min - The minimum thickness that can be obtained by a
- ! concave parabolic fit.
- ! (in) iis, iie, jis, jie - Index range for computation.
- ! (in) G - The ocean's grid structure.
-
+ integer, intent(in) :: iis !< Start i-index for computations
+ integer, intent(in) :: iie !< End i-index for computations
+ integer, intent(in) :: jis !< Start j-index for computations
+ integer, intent(in) :: jie !< End j-index for computations
! Local variables
real :: curv, dh, scale
- character(len=256) :: mesg
+ character(len=256) :: mesg ! The text of an error message
integer :: i,j
do j=jis,jie ; do i=iis,iie
@@ -2225,17 +2062,12 @@ end subroutine PPM_limit_pos
! subroutine register_int_tide_restarts(G, param_file, CS, restart_CS)
! type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
-! type(int_tide_CS), pointer :: CS
-! type(MOM_restart_CS), pointer :: restart_CS
+! type(int_tide_CS), pointer :: CS !< The control structure returned by a
+! !! previous call to int_tide_init.
+! type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure.
! ! This subroutine is not currently in use!!
-! ! Arguments: G - The ocean's grid structure.
-! ! (in) param_file - A structure indicating the open file to parse for
-! ! model parameter values.
-! ! (in/out) CS - A pointer that is set to point to the control structure
-! ! for this module.
-! ! (in) restart_CS - A pointer to the restart control structure.
! ! This subroutine is used to allocate and register any fields in this module
! ! that should be written to or read from the restart file.
! logical :: use_int_tides
@@ -2267,17 +2099,9 @@ end subroutine PPM_limit_pos
! 'h','1','1',"J m-2")
! call register_restart_field(CS%En_restart, vd, .false., restart_CS)
-! !--------------------check----------------------------------------------
-! if (is_root_pe()) then
-! print *,'register_int_tide_restarts: CS and CS%En_restart allocated!'
-! print *,'register_int_tide_restarts: CS%En_restart registered!'
-! print *,'register_int_tide_restarts: done!'
-! endif
-! !-----------------------------------------------------------------------
-
! end subroutine register_int_tide_restarts
-! #@# This subroutine needs a doxygen comment.
+!> This subroutine initializes the internal tides module.
subroutine internal_tides_init(Time, G, GV, param_file, diag, CS)
type(time_type), target, intent(in) :: Time !< The current model time.
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
@@ -2288,15 +2112,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS)
!! diagnostic output.
type(int_tide_CS),pointer :: CS !< A pointer that is set to point to the control
!! structure for this module.
-
- ! Arguments: Time - The current model time.
- ! (in) G - The ocean's grid structure.
- ! (in) GV - The ocean's vertical grid structure.
- ! (in) param_file - A structure indicating the open file to parse for
- ! model parameter values.
- ! (in) diag - A structure that is used to regulate diagnostic output.
- ! (in/out) CS - A pointer that is set to point to the control structure
- ! for this module
+ ! Local variables
real :: Angle_size ! size of wedges, rad
real, allocatable :: angles(:) ! orientations of wedge centers, rad
real, allocatable, dimension(:,:) :: h2 ! topographic roughness scale, m^2
@@ -2497,7 +2313,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS)
call MOM_read_data(filename, 'h2', h2, G%domain, timelevel=1)
do j=G%jsc,G%jec ; do i=G%isc,G%iec
! Restrict rms topo to 10 percent of column depth.
- h2(i,j) = min(0.01*G%bathyT(i,j)**2, h2(i,j))
+ h2(i,j) = min(0.01*(G%Zd_to_m*G%bathyT(i,j))**2, h2(i,j))
! Compute the fixed part; units are [kg m-2] here
! will be multiplied by N and En to get into [W m-2]
CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0*&
@@ -2714,11 +2530,10 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS)
end subroutine internal_tides_init
-
+!> This subroutine deallocates the memory associated with the internal tides control structure
subroutine internal_tides_end(CS)
- type(int_tide_CS), pointer :: CS
- ! Arguments: CS - A pointer to the control structure returned by a previous
- ! call to internal_tides_init, it will be deallocated here.
+ type(int_tide_CS), pointer :: CS !< A pointer to the control structure returned by a previous
+ !! call to internal_tides_init, it will be deallocated here.
if (associated(CS)) then
if (associated(CS%En)) deallocate(CS%En)
@@ -2731,5 +2546,4 @@ subroutine internal_tides_end(CS)
CS => NULL()
end subroutine internal_tides_end
-
end module MOM_internal_tides
diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
index ecc586d025..7f33140fb7 100644
--- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
+++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
@@ -393,11 +393,11 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS)
"Module must be initialized before it is used.")
if (CS%calculate_Eady_growth_rate) then
- call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=2)
+ call find_eta(h, tv, G, GV, e, halo_size=2)
if (CS%use_stored_slopes) then
call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, &
CS%slope_x, CS%slope_y, N2_u, N2_v, 1)
- call calc_Visbeck_coeffs(h, e, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS)
+ call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS)
! call calc_slope_functions_using_just_e(h, G, CS, e, .false.)
else
!call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y)
@@ -417,19 +417,17 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS)
end subroutine calc_slope_functions
!> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al.
-subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS)
+subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS)
type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface position (m)
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: slope_x !< Zonal isoneutral slope
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points (1/s2)
real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope
real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points (1/s2)
type(VarMix_CS), pointer :: CS !< Variable mixing coefficients
+
! Local variables
- real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points (for diagnostics)
- real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at u points (for diagnostics)
real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s)
real :: S2 ! Interface slope squared (non-dim)
real :: N2 ! Brunt-Vaisala frequency (1/s)
@@ -438,8 +436,6 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS)
integer :: is, ie, js, je, nz
integer :: i, j, k, kb_max
real :: S2max, wNE, wSE, wSW, wNW
- real :: SN_u_local(SZIB_(G), SZJ_(G),SZK_(G))
- real :: SN_v_local(SZI_(G), SZJB_(G),SZK_(G))
real :: H_u(SZIB_(G)), H_v(SZI_(G))
real :: S2_u(SZIB_(G), SZJ_(G))
real :: S2_v(SZI_(G), SZJB_(G))
@@ -456,12 +452,7 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS)
S2max = CS%Visbeck_S_max**2
-!$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h, &
-!$OMP S2_u,S2_v,slope_x,slope_y, &
-!$OMP SN_u_local,SN_v_local,N2_u,N2_v, S2max) &
-!$OMP private(E_x,E_y,S2,H_u,H_v,Hdn,Hup,H_geom,N2, &
-!$OMP wNE, wSE, wSW, wNW)
-!$OMP do
+ !$OMP parallel do default(shared)
do j=js-1,je+1 ; do i=is-1,ie+1
CS%SN_u(i,j) = 0.0
CS%SN_v(i,j) = 0.0
@@ -471,7 +462,7 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS)
! calculate the first-mode gravity wave speed and then blend the equatorial
! and midlatitude deformation radii, using calc_resoln_function as a template.
-!$OMP do
+ !$OMP parallel do default(shared) private(S2,H_u,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW)
do j = js,je
do I=is-1,ie
CS%SN_u(I,j) = 0. ; H_u(I) = 0. ; S2_u(I,j) = 0.
@@ -517,7 +508,7 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS)
enddo
enddo
-!$OMP do
+ !$OMP parallel do default(shared) private(S2,H_v,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW)
do J = js-1,je
do i=is,ie
CS%SN_v(i,J) = 0. ; H_v(i) = 0. ; S2_v(i,J) = 0.
@@ -563,8 +554,6 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS)
enddo
enddo
-!$OMP end parallel
-
! Offer diagnostic fields for averaging.
if (query_averaging_enabled(CS%diag)) then
if (CS%id_S2_u > 0) call post_data(CS%id_S2_u, S2_u, CS%diag)
@@ -600,6 +589,8 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes)
real :: N2 ! Brunt-Vaisala frequency (1/s)
real :: Hup, Hdn ! Thickness from above, below (m or kg m-2)
real :: H_geom ! The geometric mean of Hup*Hdn, in m or kg m-2.
+ real :: Z_to_L ! A conversion factor between from units for e to the
+ ! units for lateral distances.
real :: one_meter ! One meter in thickness units of m or kg m-2.
integer :: is, ie, js, je, nz
integer :: i, j, k, kb_max
@@ -618,33 +609,25 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes)
one_meter = 1.0 * GV%m_to_H
h_neglect = GV%H_subroundoff
- H_cutoff = real(2*nz) * (GV%Angstrom + h_neglect)
-
-!$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h,H_cutoff,h_neglect, &
-!$OMP one_meter,SN_u_local,SN_v_local,calculate_slopes) &
-!$OMP private(E_x,E_y,S2,Hdn,Hup,H_geom,N2)
-!$OMP do
- do j=js-1,je+1 ; do i=is-1,ie+1
- CS%SN_u(i,j) = 0.0
- CS%SN_v(i,j) = 0.0
- enddo ; enddo
+ H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect)
+ Z_to_L = GV%Z_to_m
! To set the length scale based on the deformation radius, use wave_speed to
! calculate the first-mode gravity wave speed and then blend the equatorial
! and midlatitude deformation radii, using calc_resoln_function as a template.
-!$OMP do
+ !$OMP parallel do default(shared) private(E_x,E_y,S2,Hdn,Hup,H_geom,N2)
do k=nz,CS%VarMix_Ktop,-1
if (calculate_slopes) then
! Calculate the interface slopes E_x and E_y and u- and v- points respectively
do j=js-1,je+1 ; do I=is-1,ie
- E_x(I,j) = (e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j)
+ E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j)
! Mask slopes where interface intersects topography
if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0.
enddo ; enddo
do J=js-1,je ; do i=is-1,ie+1
- E_y(i,J) = (e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J)
+ E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J)
! Mask slopes where interface intersects topography
if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0.
enddo ; enddo
@@ -666,10 +649,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes)
Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect)
Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect)
H_geom = sqrt(Hdn*Hup)
- N2 = GV%g_prime(k) / (GV%H_to_m * max(Hdn,Hup,one_meter))
+ N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter))
if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) &
S2 = 0.0
- SN_u_local(I,j,k) = (H_geom * GV%H_to_m) * S2 * N2
+ SN_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2
enddo ; enddo
do J=js-1,je ; do i=is,ie
S2 = ( E_y(i,J)**2 + 0.25*( &
@@ -677,52 +660,56 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes)
Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect)
Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect)
H_geom = sqrt(Hdn*Hup)
- N2 = GV%g_prime(k) / (GV%H_to_m * max(Hdn,Hup,one_meter))
+ N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter))
if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) &
S2 = 0.0
- SN_v_local(i,J,k) = (H_geom * GV%H_to_m) * S2 * N2
+ SN_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2
enddo ; enddo
enddo ! k
-!$OMP do
- do j = js,je
+ !$OMP parallel do default(shared)
+ do j=js,je
+ do I=is-1,ie ; CS%SN_u(I,j) = 0.0 ; enddo
do k=nz,CS%VarMix_Ktop,-1 ; do I=is-1,ie
CS%SN_u(I,j) = CS%SN_u(I,j) + SN_u_local(I,j,k)
enddo ; enddo
! SN above contains S^2*N^2*H, convert to vertical average of S*N
do I=is-1,ie
- !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom ) )
+ !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) ))
!The code below behaves better than the line above. Not sure why? AJA
- if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_m ) then
- CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / max(G%bathyT(I,j), G%bathyT(I+1,j)) )
+ if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then
+ CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / &
+ (max(G%bathyT(I,j), G%bathyT(I+1,j))) )
else
CS%SN_u(I,j) = 0.0
endif
enddo
enddo
-!$OMP do
+ !$OMP parallel do default(shared)
do J=js-1,je
- do k=nz,CS%VarMix_Ktop,-1 ; do I=is,ie
+ do i=is,ie ; CS%SN_v(i,J) = 0.0 ; enddo
+ do k=nz,CS%VarMix_Ktop,-1 ; do i=is,ie
CS%SN_v(i,J) = CS%SN_v(i,J) + SN_v_local(i,J,k)
enddo ; enddo
do i=is,ie
- !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom ) )
+ !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) ))
!The code below behaves better than the line above. Not sure why? AJA
- if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_m ) then
- CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / max(G%bathyT(i,J), G%bathyT(i,J+1)) )
+ if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then
+ CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / &
+ (max(G%bathyT(i,J), G%bathyT(i,J+1))) )
else
CS%SN_v(I,j) = 0.0
endif
enddo
enddo
-!$OMP end parallel
end subroutine calc_slope_functions_using_just_e
!> Initializes the variables mixing coefficients container
-subroutine VarMix_init(Time, G, param_file, diag, CS)
+subroutine VarMix_init(Time, G, GV, param_file, diag, CS)
type(time_type), intent(in) :: Time !< Current model time
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(param_file_type), intent(in) :: param_file !< Parameter file handles
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure
type(VarMix_CS), pointer :: CS !< Variable mixing coefficients
@@ -804,6 +791,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS)
CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn
call get_param(param_file, mdl, "USE_MEKE", use_MEKE, &
default=.false., do_not_log=.true.)
+ CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE
CS%calculate_Eady_growth_rate = CS%calculate_Eady_growth_rate .or. use_MEKE
call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, &
default=0., do_not_log=.true.)
@@ -839,7 +827,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS)
call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, &
"A diapycnal diffusivity that is used to interpolate \n"//&
"more sensible values of T & S into thin layers.", &
- default=1.0e-6)
+ default=1.0e-6, scale=GV%m_to_Z**2) !### Add units argument.
endif
if (CS%calculate_Eady_growth_rate) then
diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
index ba76c208cc..27a60e7a38 100644
--- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
+++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
@@ -15,7 +15,7 @@ module MOM_mixed_layer_restrat
use MOM_hor_index, only : hor_index_type
use MOM_io, only : vardesc, var_desc
use MOM_lateral_mixing_coeffs, only : VarMix_CS
-use MOM_restart, only : register_restart_field, MOM_restart_CS
+use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
use MOM_EOS, only : calculate_density
@@ -138,17 +138,17 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization (H units)
htot_slow, & ! The sum of the thicknesses of layers in the mixed layer (H units)
Rml_av_slow ! g_Rho0 times the average mixed layer density (m s-2)
- real :: g_Rho0 ! G_Earth/Rho0 (m4 s-2 kg-1)
+ real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1)
real :: rho_ml(SZI_(G)) ! Potential density relative to the surface (kg m-3)
real :: p0(SZI_(G)) ! A pressure of 0 (Pa)
- real :: h_vel ! htot interpolated onto velocity points in metre (not H).
+ real :: h_vel ! htot interpolated onto velocity points in Z (not H).
real :: absf ! absolute value of f, interpolated to velocity points (s-1)
- real :: u_star ! surface friction velocity, interpolated to velocity points (m s-1)
+ real :: u_star ! surface friction velocity, interpolated to velocity points (Z s-1)
real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1)
real :: timescale ! mixing growth timescale (sec)
real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected (H units)
- real :: dz_neglect ! A tiny thickness (in m) that is usually lost in roundoff so can be neglected
+ real :: dz_neglect ! A tiny thickness (in Z) that is usually lost in roundoff so can be neglected
real :: I4dt ! 1/(4 dt) (sec-1)
real :: Ihtot,Ihtot_slow! total mixed layer thickness
real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux
@@ -273,9 +273,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
uDml(:) = 0.0 ; vDml(:) = 0.0
uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0
I4dt = 0.25 / dt
- g_Rho0 = GV%g_Earth/GV%Rho0
+ g_Rho0 = GV%g_Earth / GV%Rho0
h_neglect = GV%H_subroundoff
- dz_neglect = GV%H_subroundoff*GV%H_to_m
+ dz_neglect = GV%H_subroundoff*GV%H_to_Z
proper_averaging = .not. CS%MLE_use_MLD_ave_bug
if (CS%front_length>0.) then
res_upscale = .true.
@@ -304,7 +304,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
keep_going = .true.
do k=1,nz
do i=is-1,ie+1
- h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom),0.0)
+ 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)
@@ -338,7 +338,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
call hchksum(h,'mixed_layer_restrat: h',G%HI,haloshift=1,scale=GV%H_to_m)
call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1)
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)
+ call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=GV%m_to_Z)
endif
! TO DO:
@@ -348,7 +348,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
! U - Component
!$OMP do
do j=js,je ; do I=is-1,ie
- u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))
+ u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))
absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J)))
! If needed, res_scaling_fac = min( ds, L_d ) / l_f
if (res_upscale) res_scaling_fac = &
@@ -358,23 +358,23 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star)
! momentum mixing rate: pi^2*visc/h_ml^2
! 0.41 is the von Karmen constant, 9.8696 = pi^2.
- h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_m
+ h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_Z
mom_mixrate = (0.41*9.8696)*u_star**2 / &
(absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star)
timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)
timescale = timescale * CS%ml_restrat_coef
if (res_upscale) timescale = timescale * res_scaling_fac
uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* &
- G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%m_to_H)
+ G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H)
! As above but using the slow filtered MLD
- h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_m
+ h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z
mom_mixrate = (0.41*9.8696)*u_star**2 / &
(absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star)
timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)
timescale = timescale * CS%ml_restrat_coef2
if (res_upscale) timescale = timescale * res_scaling_fac
uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* &
- G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%m_to_H)
+ G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H)
if (uDml(I) + uDml_slow(I) == 0.) then
do k=1,nz ; uhml(I,j,k) = 0.0 ; enddo
@@ -424,7 +424,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
! V- component
!$OMP do
do J=js-1,je ; do i=is,ie
- u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))
+ u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))
absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
! If needed, res_scaling_fac = min( ds, L_d ) / l_f
if (res_upscale) res_scaling_fac = &
@@ -434,23 +434,23 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star)
! momentum mixing rate: pi^2*visc/h_ml^2
! 0.41 is the von Karmen constant, 9.8696 = pi^2.
- h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_m
+ h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_Z
mom_mixrate = (0.41*9.8696)*u_star**2 / &
(absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star)
timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)
timescale = timescale * CS%ml_restrat_coef
if (res_upscale) timescale = timescale * res_scaling_fac
vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* &
- G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%m_to_H)
+ G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H)
! As above but using the slow filtered MLD
- h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_m
+ h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z
mom_mixrate = (0.41*9.8696)*u_star**2 / &
(absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star)
timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)
timescale = timescale * CS%ml_restrat_coef2
if (res_upscale) timescale = timescale * res_scaling_fac
vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* &
- G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%m_to_H)
+ G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H)
if (vDml(i) + vDml_slow(i) == 0.) then
do k=1,nz ; vhml(i,J,k) = 0.0 ; enddo
@@ -559,17 +559,17 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS)
real, dimension(SZI_(G),SZJ_(G)) :: &
htot, & ! The sum of the thicknesses of layers in the mixed layer (H units)
Rml_av ! g_Rho0 times the average mixed layer density (m s-2)
- real :: g_Rho0 ! G_Earth/Rho0 (m4 s-2 kg-1)
+ real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1)
real :: Rho0(SZI_(G)) ! Potential density relative to the surface (kg m-3)
real :: p0(SZI_(G)) ! A pressure of 0 (Pa)
- real :: h_vel ! htot interpolated onto velocity points (meter; not H)
+ real :: h_vel ! htot interpolated onto velocity points (Z; not H)
real :: absf ! absolute value of f, interpolated to velocity points (s-1)
- real :: u_star ! surface friction velocity, interpolated to velocity points (m s-1)
+ real :: u_star ! surface friction velocity, interpolated to velocity points (Z s-1)
real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1)
real :: timescale ! mixing growth timescale (sec)
real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected (H units)
- real :: dz_neglect ! tiny thickness (in m) that usually lost in roundoff and can be neglected (meter)
+ real :: dz_neglect ! tiny thickness (in Z) that usually lost in roundoff and can be neglected (meter)
real :: I4dt ! 1/(4 dt)
real :: I2htot ! Twice the total mixed layer thickness at velocity points (H units)
real :: z_topx2 ! depth of the top of a layer at velocity points (H units)
@@ -597,10 +597,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS)
uDml(:) = 0.0 ; vDml(:) = 0.0
I4dt = 0.25 / dt
- g_Rho0 = GV%g_Earth/GV%Rho0
+ g_Rho0 = GV%g_Earth / GV%Rho0
use_EOS = associated(tv%eqn_of_state)
h_neglect = GV%H_subroundoff
- dz_neglect = GV%H_subroundoff*GV%H_to_m
+ dz_neglect = GV%H_subroundoff*GV%H_to_Z
if (.not.use_EOS) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// &
"An equation of state must be used with this module.")
@@ -625,7 +625,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS)
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)
- h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom),0.0)
+ h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0)
enddo
enddo
@@ -644,9 +644,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS)
do i=is,ie ; utimescale_diag(i,j) = 0.0 ; enddo
do i=is,ie ; vtimescale_diag(i,j) = 0.0 ; enddo
do I=is-1,ie
- h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_m
+ h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z
- u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))
+ u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))
absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J)))
! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star)
! momentum mixing rate: pi^2*visc/h_ml^2
@@ -661,7 +661,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS)
utimescale_diag(I,j) = timescale
uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* &
- G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%m_to_H)
+ G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H)
if (uDml(i) == 0) then
do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo
@@ -692,9 +692,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS)
! V- component
!$OMP do
do J=js-1,je ; do i=is,ie
- h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_m
+ h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z
- u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))
+ u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))
absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star)
! momentum mixing rate: pi^2*visc/h_ml^2
@@ -709,7 +709,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS)
vtimescale_diag(i,J) = timescale
vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* &
- G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%m_to_H)
+ G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H)
if (vDml(i) == 0) then
do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo
else
@@ -771,17 +771,22 @@ end subroutine mixedlayer_restrat_BML
!> Initialize the mixed layer restratification module
-logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS)
+logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS, restart_CS)
type(time_type), intent(in) :: Time !< Current model time
type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
type(param_file_type), intent(in) :: param_file !< Parameter file to parse
type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics
type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure
+ type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure
+
! Local variables
-! This include declares and sets the variable "version".
-#include "version_variable.h"
- real :: flux_to_kg_per_s
+ real :: H_rescale ! A rescaling factor for thicknesses from the representation in
+ ! a restart file to the internal representation in this run.
+ real :: flux_to_kg_per_s ! A unit conversion factor for fluxes.
+ ! This include declares and sets the variable "version".
+# include "version_variable.h"
+ integer :: i, j
! Read all relevant parameters and write them to the model log.
call log_version(param_file, mdl, version, "")
@@ -878,7 +883,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS)
CS%id_MLD = register_diag_field('ocean_model', 'MLD_restrat', diag%axesT1, Time, &
'Mixed Layer Depth as used in the mixed-layer restratification parameterization', 'm')
CS%id_Rml = register_diag_field('ocean_model', 'ML_buoy_restrat', diag%axesT1, Time, &
- 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', 'm s2')
+ 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', &
+ 'm s2', conversion=GV%m_to_Z)
CS%id_uDml = register_diag_field('ocean_model', 'udml_restrat', diag%axesCu1, Time, &
'Transport stream function amplitude for zonal restratification of mixed layer', 'm3 s-1')
CS%id_vDml = register_diag_field('ocean_model', 'vdml_restrat', diag%axesCv1, Time, &
@@ -888,6 +894,26 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS)
CS%id_vml = register_diag_field('ocean_model', 'vml_restrat', diag%axesCv1, Time, &
'Surface meridional velocity component of mixed layer restratification', 'm s-1')
+ ! Rescale variables from restart files if the internal dimensional scalings have changed.
+ if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then
+ if (query_initialized(CS%MLD_filtered, "MLD_MLE_filtered", restart_CS) .and. &
+ (GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then
+ H_rescale = GV%m_to_H / GV%m_to_H_restart
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ CS%MLD_filtered(i,j) = H_rescale * CS%MLD_filtered(i,j)
+ enddo ; enddo
+ endif
+ endif
+ if (CS%MLE_MLD_decay_time2>0.) then
+ if (query_initialized(CS%MLD_filtered_slow, "MLD_MLE_filtered_slow", restart_CS) .and. &
+ (GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then
+ H_rescale = GV%m_to_H / GV%m_to_H_restart
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ CS%MLD_filtered_slow(i,j) = H_rescale * CS%MLD_filtered_slow(i,j)
+ enddo ; enddo
+ endif
+ endif
+
! If MLD_filtered is being used, we need to update halo regions after a restart
if (associated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain)
@@ -899,7 +925,7 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS)
type(hor_index_type), intent(in) :: HI !< Horizontal index structure
type(param_file_type), intent(in) :: param_file !< Parameter file to parse
type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure
- type(MOM_restart_CS), pointer :: restart_CS !< Restart structure
+ type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure
! Local variables
type(vardesc) :: vd
logical :: mixedlayer_restrat_init
@@ -937,7 +963,7 @@ end subroutine mixedlayer_restrat_register_restarts
!> \namespace mom_mixed_layer_restrat
!!
-!! \section mle-module Mixed-layer eddy parameterization module
+!! \section section_mle Mixed-layer eddy parameterization module
!!
!! The subroutines in this file implement a parameterization of unresolved viscous
!! mixed layer restratification of the mixed layer as described in Fox-Kemper et
@@ -956,7 +982,7 @@ end subroutine mixedlayer_restrat_register_restarts
!! grid scale (whichever is smaller to the dominant horizontal length-scale of the
!! sub-meso-scale mixed layer instabilities.
!!
-!! \subsection section-submeso-nutshell "Sub-meso" in a nutshell
+!! \subsection section_mle_nutshell "Sub-meso" in a nutshell
!!
!! The parameterization is colloquially referred to as "sub-meso".
!!
@@ -995,7 +1021,7 @@ end subroutine mixedlayer_restrat_register_restarts
!! \f$ C_e \f$ is hard-coded as 0.0625. \f$ \tau \f$ is calculated from the surface friction velocity \f$ u^* \f$.
!! \todo Explain expression for momentum mixing time-scale.
!!
-!! \subsection section-mle-filtering Time-filtering of mixed-layer depth
+!! \subsection section_mle_filtering Time-filtering of mixed-layer depth
!!
!! Using the instantaneous mixed-layer depth is inconsistent with the finite life-time of
!! mixed-layer instabilities. We provide a one-sided running-mean filter of mixed-layer depth, \f$ H \f$, of the form:
@@ -1006,7 +1032,7 @@ end subroutine mixedlayer_restrat_register_restarts
!! but to decay with time-scale \f$ \tau_h \f$.
!! \f$ \bar{H} \f$ is substituted for \f$ H \f$ in the above equations.
!!
-!! \subsection section-mle-mld Defining the mixed-layer-depth
+!! \subsection section_mle_mld Defining the mixed-layer-depth
!!
!! If the parameter MLE_USE_PBL_MLD=True then the mixed-layer depth is defined/diagnosed by the
!! boundary-layer parameterization (e.g. ePBL, KPP, etc.).
@@ -1015,7 +1041,7 @@ end subroutine mixedlayer_restrat_register_restarts
!! as the depth of a given density difference, \f$ \Delta \rho \f$, with the surface where the
!! density difference is the parameter MLE_DENSITY_DIFF.
!!
-!! \subsection section-mle-ref References
+!! \subsection section_mle_ref References
!!
!! Fox-Kemper, B., Ferrari, R. and Hallberg, R., 2008:
!! Parameterization of Mixed Layer Eddies. Part I: Theory and Diagnosis
diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90
index 4ef29b9e9d..982b73698f 100644
--- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90
+++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90
@@ -52,7 +52,7 @@ module MOM_thickness_diffuse
!! longer than DT, or 0 (the default) to use DT.
integer :: nkml !< number of layers within mixed layer
logical :: debug !< write verbose checksums for debugging purposes
- type(diag_ctrl), pointer :: diag ! structure used to regulate timing of diagnostics
+ type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics
real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity (W m-2)
real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope (nondim)
real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope (nondim)
@@ -86,7 +86,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS
type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion
! Local variables
real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean
- ! sea level,in H units, positive up.
+ ! sea level, in Z, positive up.
real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! uhD & vhD are the diffusive u*h &
real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! v*h fluxes (m2 H s-1)
@@ -111,7 +111,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS
KH_v_CFL ! The maximum stable interface height diffusivity at v grid points (m2 s-1)
real :: Khth_Loc_u(SZIB_(G), SZJ_(G))
real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity (m2/s)
- real :: H_to_m, m_to_H ! Local copies of unit conversion factors.
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected, in H.
real, dimension(:,:), pointer :: cg1 => null() !< Wave speed (m/s)
@@ -130,7 +129,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
h_neglect = GV%H_subroundoff
- H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H
if (associated(MEKE)) then
if (associated(MEKE%GM_src)) then
@@ -162,7 +160,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS
enddo ; enddo
! Calculates interface heights, e, in m.
- call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=1)
+ call find_eta(h, tv, G, GV, e, halo_size=1)
! Set the diffusivities.
!$OMP parallel default(none) shared(is,ie,js,je,Khth_Loc_u,CS,use_VarMix,VarMix, &
@@ -376,7 +374,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS
do j=js,je ; do i=is,ie
h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * &
((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k)))
- if (h(i,j,k) < GV%Angstrom) h(i,j,k) = GV%Angstrom
+ if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H
enddo ; enddo
enddo
@@ -402,15 +400,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
CS, int_slope_u, int_slope_v, slope_x, slope_y)
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)), intent(in) :: h !< Layer thickness (m or kg/m2)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (m)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z)
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces
!! at u points (m2/s)
real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces
!! at v points (m2/s)
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes (m3/s)
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes (m3/s)
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes (m2 H s-1)
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes (m2 H s-1)
real, dimension(:,:), pointer :: cg1 !< Wave speed (m/s)
real, intent(in) :: dt !< Time increment (s)
type(MEKE_type), pointer :: MEKE !< MEKE control structue
@@ -425,6 +423,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
!! density gradients.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points
real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points
+
! Local variables
real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: &
T, & ! The temperature (or density) in C, with the values in
@@ -434,12 +433,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
Rho, & ! Density itself, when a nonlinear equation of state is
! not in use.
h_avail, & ! The mass available for diffusion out of each face, divided
- ! by dt, in m3 s-1.
+ ! by dt, in H m2 s-1.
h_frac ! The fraction of the mass in the column above the bottom
! interface of a layer that is within a layer, ND. 0 0.0) &
h_frac(i,j,k) = h_avail(i,j,k) / h_avail_rsum(i,j,k+1)
@@ -587,7 +583,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
!$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 present_slope_x,H_to_m,m_to_H,G_rho0) &
+!$OMP present_slope_x,G_rho0) &
!$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, &
@@ -644,7 +640,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect
haR = 0.5*(h(i+1,j,k-1) + h(i+1,j,k)) + h_neglect
if (GV%Boussinesq) then
- dzaL = haL * H_to_m ; dzaR = haR * H_to_m
+ dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z
else
dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect
dzaR = 0.5*(e(i+1,j,K-1) - e(i+1,j,K+1)) + dz_neglect
@@ -663,8 +659,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
haB = 0.5*(h(i,j,k) + h(i+1,j,k)) + h_neglect
! hN2_u is used with the FGNV streamfunction formulation
- hN2_u(I,K) = (0.5 * H_to_m * ( hg2A / haA + hg2B / haB )) * &
- max(drdz*G_rho0 , N2_floor)
+ hN2_u(I,K) = (0.5 * GV%H_to_Z * ( hg2A / haA + hg2B / haB )) * &
+ max(drdz*G_rho0, N2_floor)
endif
if (present_slope_x) then
Slope = slope_x(I,j,k)
@@ -679,7 +675,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! This estimate of slope is accurate for small slopes, but bounded
! to be between -1 and 1.
- mag_grad2 = drdx**2 + drdz**2
+ mag_grad2 = drdx**2 + (GV%m_to_Z*drdz)**2
if (mag_grad2 > 0.0) then
Slope = drdx / sqrt(mag_grad2)
slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2
@@ -693,13 +689,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! that ignore density gradients along layers.
if (present_int_slope_u) then
Slope = (1.0 - int_slope_u(I,j,K)) * Slope + &
- int_slope_u(I,j,K) * ((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j))
+ int_slope_u(I,j,K) * GV%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j))
slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K)
endif
if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope
! Estimate the streamfunction at each interface (m3 s-1).
- Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope)
+ Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*GV%m_to_Z*Slope)
! Avoid moving dense water upslope from below the level of
! the bottom on the receiving side.
@@ -725,10 +721,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (present_slope_x) then
Slope = slope_x(I,j,k)
else
- Slope = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j)
+ Slope = GV%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j)
endif
if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope
- Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope)
+ Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*GV%m_to_Z*Slope)
hN2_u(I,K) = GV%g_prime(K)
endif ! if (use_EOS)
else ! if (k > nk_linear)
@@ -741,9 +737,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (CS%use_FGNV_streamfn) then
do k=1,nz ; do I=is-1,ie ; if (G%mask2dCu(I,j)>0.) then
- h_harm = H_to_m * max( h_neglect, &
+ h_harm = max( h_neglect, &
2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) )
- c2_h_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / h_harm
+ c2_h_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm)
endif ; enddo ; enddo
! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010.
@@ -764,9 +760,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (uhtot(I,j) <= 0.0) then
! The transport that must balance the transport below is positive.
- Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) * H_to_m
+ Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z
else ! (uhtot(I,j) > 0.0)
- Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) * H_to_m
+ Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) * GV%H_to_Z
endif
! The actual streamfunction at each interface.
@@ -777,7 +773,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! Make sure that there is enough mass above to allow the streamfunction
! to satisfy the boundary condition of 0 at the surface.
- Sfn_in_h = min(max(Sfn_est * m_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K))
+ Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K))
! The actual transport is limited by the mass available in the two
! neighboring grid cells.
@@ -819,7 +815,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! A second order centered estimate is used for the density transfered
! between water columns.
- Work_u(I,j) = Work_u(I,j) + ( G_scale * H_to_m ) * &
+ Work_u(I,j) = Work_u(I,j) + G_scale * &
( uhtot(I,j) * drdkDe_u(I,K) - &
(uhD(I,j,K) * drdi_u(I,K)) * 0.25 * &
((e(i,j,K) + e(i,j,K+1)) + (e(i+1,j,K) + e(i+1,j,K+1))) )
@@ -836,7 +832,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
!$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,m_to_H,H_to_m,G_rho0) &
+!$OMP present_slope_y,G_rho0) &
!$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, &
@@ -890,7 +886,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect
haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect
if (GV%Boussinesq) then
- dzaL = haL * H_to_m ; dzaR = haR * H_to_m
+ dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z
else
dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect
dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect
@@ -909,8 +905,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
haB = 0.5*(h(i,j,k) + h(i,j+1,k)) + h_neglect
! hN2_v is used with the FGNV streamfunction formulation
- hN2_v(i,K) = (0.5 * H_to_m * ( hg2A / haA + hg2B / haB )) * &
- max(drdz*G_rho0 , N2_floor)
+ hN2_v(i,K) = (0.5 * GV%H_to_Z * ( hg2A / haA + hg2B / haB )) * &
+ max(drdz*G_rho0, N2_floor)
endif
if (present_slope_y) then
Slope = slope_y(i,J,k)
@@ -925,7 +921,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! This estimate of slope is accurate for small slopes, but bounded
! to be between -1 and 1.
- mag_grad2 = drdy**2 + drdz**2
+ mag_grad2 = drdy**2 + (GV%m_to_Z*drdz)**2
if (mag_grad2 > 0.0) then
Slope = drdy / sqrt(mag_grad2)
slope2_Ratio_v(i,K) = Slope**2 * I_slope_max2
@@ -939,13 +935,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! that ignore density gradients along layers.
if (present_int_slope_v) then
Slope = (1.0 - int_slope_v(i,J,K)) * Slope + &
- int_slope_v(i,J,K) * ((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J))
+ int_slope_v(i,J,K) * GV%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J))
slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K)
endif
if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope
! Estimate the streamfunction at each interface (m3 s-1).
- Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope)
+ Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*GV%m_to_Z*Slope)
! Avoid moving dense water upslope from below the level of
! the bottom on the receiving side.
@@ -971,10 +967,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (present_slope_y) then
Slope = slope_y(i,J,k)
else
- Slope = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J)
+ Slope = GV%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J)
endif
if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope
- Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope)
+ Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*GV%m_to_Z*Slope)
hN2_v(i,K) = GV%g_prime(K)
endif ! if (use_EOS)
else ! if (k > nk_linear)
@@ -987,9 +983,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (CS%use_FGNV_streamfn) then
do k=1,nz ; do i=is,ie ; if (G%mask2dCv(i,J)>0.) then
- h_harm = H_to_m * max( h_neglect, &
+ h_harm = max( h_neglect, &
2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) )
- c2_h_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / h_harm
+ c2_h_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm)
endif ; enddo ; enddo
! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010.
@@ -1010,9 +1006,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (vhtot(i,J) <= 0.0) then
! The transport that must balance the transport below is positive.
- Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) * H_to_m
+ Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z
else ! (vhtot(I,j) > 0.0)
- Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) * H_to_m
+ Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) * GV%H_to_Z
endif
! The actual streamfunction at each interface.
@@ -1023,7 +1019,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! Make sure that there is enough mass above to allow the streamfunction
! to satisfy the boundary condition of 0 at the surface.
- Sfn_in_h = min(max(Sfn_est * m_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K))
+ Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K))
! The actual transport is limited by the mass available in the two
! neighboring grid cells.
@@ -1065,7 +1061,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! A second order centered estimate is used for the density transfered
! between water columns.
- Work_v(i,J) = Work_v(i,J) + ( G_scale * H_to_m ) * &
+ Work_v(i,J) = Work_v(i,J) + G_scale * &
( vhtot(i,J) * drdkDe_v(i,K) - &
(vhD(i,J,K) * drdj_v(i,K)) * 0.25 * &
((e(i,j,K) + e(i,j,K+1)) + (e(i,j+1,K) + e(i,j+1,K+1))) )
@@ -1098,7 +1094,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
drdiB = drho_dT_u(I) * (T(i+1,j,1)-T(i,j,1)) + &
drho_dS_u(I) * (S(i+1,j,1)-S(i,j,1))
endif
- Work_u(I,j) = Work_u(I,j) + ( G_scale * H_to_m ) * &
+ Work_u(I,j) = Work_u(I,j) + G_scale * &
( (uhD(I,j,1) * drdiB) * 0.25 * &
((e(i,j,1) + e(i,j,2)) + (e(i+1,j,1) + e(i+1,j,2))) )
@@ -1123,7 +1119,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
drdjB = drho_dT_v(i) * (T(i,j+1,1)-T(i,j,1)) + &
drho_dS_v(i) * (S(i,j+1,1)-S(i,j,1))
endif
- Work_v(i,J) = Work_v(i,J) - ( G_scale * H_to_m ) * &
+ Work_v(i,J) = Work_v(i,J) - G_scale * &
( (vhD(i,J,1) * drdjB) * 0.25 * &
((e(i,j,1) + e(i,j,2)) + (e(i,j+1,1) + e(i,j+1,2))) )
enddo
@@ -1154,7 +1150,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn)
integer, intent(in) :: nk !< Number of layers
real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers (m s-2)
real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces (m s-2)
- real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction (m3 s-1)
+ real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction (Z m2 s-1 or arbitrary units)
!! On entry, equals diffusivity times slope.
!! On exit, equals the streamfunction.
! Local variables
@@ -1188,7 +1184,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV
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)), intent(in) :: h !< Layer thickness (H)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (m)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z)
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces
!! at u points (m2/s)
real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces
@@ -1248,7 +1244,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV
real :: sl_Kp1 ! The sign-corrected slope of the interface below, ND.
real :: I_sl_K ! The (limited) inverse of sl_K, ND.
real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1, ND.
- real :: I_4t ! A quarter of inverse of the damping timescale, in s-1.
+ real :: I_4t ! A quarter of a unit conversion factor divided by
+ ! the damping timescale, in s-1.
real :: Fn_R ! A function of Rsl, such that Rsl < Fn_R < 1.
real :: denom, I_denom ! A denominator and its inverse, various units.
real :: Kh_min ! A local floor on the diffusivity, in m2 s-1.
@@ -1344,7 +1341,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV
! Limit the diffusivities
- I_4t = Kh_scale / (4.0*dt)
+ I_4t = GV%Z_to_m*Kh_scale / (4.0*dt)
do n=1,2
if (n==1) then ; jsh = js ; ish = is-1
@@ -1387,7 +1384,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV
! dH = I_4t * (h(i+1,j,k) - h(i,j,k)) / denom
adH = abs(dH)
- sign = 1.0 ; if (dH < 0) sign = -1.0
+ sign = 1.0*GV%Z_to_m ; if (dH < 0) sign = -1.0*GV%Z_to_m
sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)
sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j)
@@ -1410,7 +1407,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV
! dH = I_4t * (h(i,j+1,k) - h(i,j,k)) / denom
adH = abs(dH)
- sign = 1.0 ; if (dH < 0) sign = -1.0
+ sign = 1.0*GV%Z_to_m ; if (dH < 0) sign = -1.0*GV%Z_to_m
sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)
sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J)
@@ -1604,10 +1601,10 @@ end subroutine add_detangling_Kh
subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here)
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)), intent(in) :: h !< Layer thickness (m or kg/m2)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature (C)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity (ppt)
- real, intent(in) :: kappa !< Constant diffusivity to use (m2/s)
+ real, intent(in) :: kappa !< Constant diffusivity to use (Z2/s)
real, intent(in) :: dt !< Time increment (s)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (C)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity (ppt)
@@ -1636,8 +1633,8 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here)
is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo
nz = G%ke
h_neglect = GV%H_subroundoff
- kap_dt_x2 = (2.0*kappa*dt)*GV%m_to_H**2
- h0 = 1.0e-16*sqrt(kappa*dt)*GV%m_to_H
+ kap_dt_x2 = (2.0*kappa*dt)*GV%Z_to_H**2
+ h0 = 1.0e-16*sqrt(kappa*dt)*GV%Z_to_H
if (kap_dt_x2 <= 0.0) then
!$OMP parallel do default(none) shared(is,ie,js,je,nz,T_f,T_in,S_f,S_in)
@@ -1745,7 +1742,7 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS)
call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, &
"A diapycnal diffusivity that is used to interpolate \n"//&
"more sensible values of T & S into thin layers.", &
- default=1.0e-6)
+ default=1.0e-6, scale=GV%m_to_Z**2)
call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, &
"If true, use the streamfunction formulation of\n"// &
"Ferrari et al., 2010, which effectively emphasizes\n"//&
@@ -1821,15 +1818,18 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS)
CS%id_sfn_y = register_diag_field('ocean_model', 'GM_sfn_y', diag%axesCvi, Time, &
'Parameterized Meridional Overturning Streamfunction', 'm3 s-1')
CS%id_sfn_unlim_x = register_diag_field('ocean_model', 'GM_sfn_unlim_x', diag%axesCui, Time, &
- 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', 'm3 s-1')
+ 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', &
+ 'm3 s-1', conversion=GV%Z_to_m)
CS%id_sfn_unlim_y = register_diag_field('ocean_model', 'GM_sfn_unlim_y', diag%axesCvi, Time, &
- 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', 'm3 s-1')
+ 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', &
+ 'm3 s-1', conversion=GV%Z_to_m)
end subroutine thickness_diffuse_init
!> Deallocate the thickness diffusion control structure
subroutine thickness_diffuse_end(CS)
- type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion
+ type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion
+
if (associated(CS)) deallocate(CS)
end subroutine thickness_diffuse_end
diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90
index c9b0c96da2..a552bfe1ca 100644
--- a/src/parameterizations/lateral/MOM_tidal_forcing.F90
+++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90
@@ -1,38 +1,8 @@
+!> Tidal contributions to geopotential
module MOM_tidal_forcing
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* Code by Robert Hallberg, August 2005, based on C-code by Harper *
-!* Simmons, February, 2003, in turn based on code by Brian Arbic. *
-!* *
-!* The main subroutine in this file calculates the total tidal *
-!* contribution to the geopotential, including self-attraction and *
-!* loading terms and the astronomical contributions. All options *
-!* are selected with entries in a file that is parsed at run-time. *
-!* Overall tides are enabled with a line '#define TIDES' in that file.*
-!* Tidal constituents must be individually enabled with lines like *
-!* '#define TIDE_M2'. This file has default values of amplitude, *
-!* frequency, Love number, and phase at time 0 for the Earth's M2, *
-!* S2, N2, K2, K1, O1, P1, Q1, MF, and MM tidal constituents, but *
-!* the frequency, amplitude and phase ant time 0 for each constituent *
-!* can be changed at run time by setting variables like TIDE_M2_FREQ, *
-!* TIDE_M2_AMP and TIDE_M2_PHASE_T0 (for M2). *
-!* *
-!* In addition, the approach to calculating self-attraction and *
-!* loading is set at run time. The default is to use the scalar *
-!* approximation, with a coefficient TIDE_SAL_SCALAR_VALUE that must *
-!* be set in the run-time file (for global runs, 0.094 is typical). *
-!* Alternately, TIDAL_SAL_FROM_FILE can be set to read the SAL from *
-!* a file containing the results of a previous simulation. To iterate *
-!* the SAL to convergence, USE_PREVIOUS_TIDES may be useful (for *
-!* details, see Arbic et al., 2004, DSR II). With TIDAL_SAL_FROM_FILE *
-!* or USE_PREVIOUS_TIDES,a list of input files must be provided to *
-!* describe each constituent's properties from a previous solution. *
-!* *
-!***********************************************************************
-
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, &
CLOCK_MODULE
use MOM_domains, only : pass_var
@@ -49,41 +19,42 @@ module MOM_tidal_forcing
#include
-integer, parameter :: MAX_CONSTITUENTS = 10 ! The maximum number of tidal
- ! constituents that could be used.
+integer, parameter :: MAX_CONSTITUENTS = 10 !< The maximum number of tidal
+ !! constituents that could be used.
+!> The control structure for the MOM_tidal_forcing mldule
type, public :: tidal_forcing_CS ; private
- logical :: use_sal_scalar ! If true, use the scalar approximation when
- ! calculating self-attraction and loading.
- logical :: tidal_sal_from_file ! If true, Read the tidal self-attraction
- ! and loading from input files, specified
- ! by TIDAL_INPUT_FILE.
- logical :: use_prev_tides ! If true, use the SAL from the previous
- ! iteration of the tides to facilitate convergence.
- real :: sal_scalar ! The constant of proportionality between sea surface
- ! height (really it should be bottom pressure) anomalies
- ! and bottom geopotential anomalies.
- integer :: nc ! The number of tidal constituents in use.
+ logical :: use_sal_scalar !< If true, use the scalar approximation when
+ !! calculating self-attraction and loading.
+ logical :: tidal_sal_from_file !< If true, Read the tidal self-attraction
+ !! and loading from input files, specified
+ !! by TIDAL_INPUT_FILE.
+ logical :: use_prev_tides !< If true, use the SAL from the previous
+ !! iteration of the tides to facilitate convergence.
+ real :: sal_scalar !< The constant of proportionality between sea surface
+ !! height (really it should be bottom pressure) anomalies
+ !! and bottom geopotential anomalies.
+ integer :: nc !< The number of tidal constituents in use.
real, dimension(MAX_CONSTITUENTS) :: &
- freq, & ! The frequency of a tidal constituent, in s-1.
- phase0, & ! The phase of a tidal constituent at time 0, in radians.
- amp, & ! The amplitude of a tidal constituent at time 0, in m.
- love_no ! The Love number of a tidal constituent at time 0, ND.
- integer :: struct(MAX_CONSTITUENTS)
- character (len=16) :: const_name(MAX_CONSTITUENTS)
+ freq, & !< The frequency of a tidal constituent, in s-1.
+ phase0, & !< The phase of a tidal constituent at time 0, in radians.
+ amp, & !< The amplitude of a tidal constituent at time 0, in m.
+ love_no !< The Love number of a tidal constituent at time 0, ND.
+ integer :: struct(MAX_CONSTITUENTS) !< An encoded spatial structure for each constituent
+ character (len=16) :: const_name(MAX_CONSTITUENTS) !< The name of each constituent
real, pointer, dimension(:,:,:) :: &
- sin_struct => NULL(), & ! The sine and cosine based structures that can
- cos_struct => NULL(), & ! be associated with the astronomical forcing.
- cosphasesal => NULL(), & ! The cosine and sine of the phase of the
- sinphasesal => NULL(), & ! self-attraction and loading amphidromes.
- ampsal => NULL(), & ! The amplitude of the SAL, in m.
- cosphase_prev => NULL(), & ! The cosine and sine of the phase of the
- sinphase_prev => NULL(), & ! amphidromes in the previous tidal solutions.
- amp_prev => NULL() ! The amplitude of the previous tidal solution, in m.
+ sin_struct => NULL(), & !< The sine and cosine based structures that can
+ cos_struct => NULL(), & !< be associated with the astronomical forcing.
+ cosphasesal => NULL(), & !< The cosine and sine of the phase of the
+ sinphasesal => NULL(), & !< self-attraction and loading amphidromes.
+ ampsal => NULL(), & !< The amplitude of the SAL, in m.
+ cosphase_prev => NULL(), & !< The cosine and sine of the phase of the
+ sinphase_prev => NULL(), & !< amphidromes in the previous tidal solutions.
+ amp_prev => NULL() !< The amplitude of the previous tidal solution, in m.
end type tidal_forcing_CS
-integer :: id_clock_tides
+integer :: id_clock_tides !< CPU clock for tides
contains
@@ -95,23 +66,10 @@ module MOM_tidal_forcing
subroutine tidal_forcing_init(Time, G, param_file, CS)
type(time_type), intent(in) :: Time !< The current model time.
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
- type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
- !! parameters.
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters.
type(tidal_forcing_CS), pointer :: CS !< A pointer that is set to point to the control
!! structure for this module.
-
-! This subroutine allocates space for the static variables used
-! by this module. The metrics may be effectively 0, 1, or 2-D arrays,
-! while fields like the background viscosities are 2-D arrays.
-! ALLOC is a macro defined in MOM_memory.h for allocate or nothing with
-! static memory.
-!
-! Arguments: Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module.
+ ! Local variables
real, dimension(SZI_(G), SZJ_(G)) :: &
phase, & ! The phase of some tidal constituent.
lat_rad, lon_rad ! Latitudes and longitudes of h-points in radians.
@@ -383,33 +341,34 @@ subroutine tidal_forcing_init(Time, G, param_file, CS)
end subroutine tidal_forcing_init
-! #@# This subroutine needs a doxygen description.
-subroutine find_in_files(tidal_input_files,varname,array,G)
- character(len=*), intent(in) :: tidal_input_files(:)
- character(len=*), intent(in) :: varname
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: array
-
+!> This subroutine finds a named variable in a list of files and reads its
+!! values into a domain-decomposed 2-d array
+subroutine find_in_files(filenames, varname, array, G)
+ character(len=*), dimension(:), intent(in) :: filenames !< The names of the files to search for the named variable
+ character(len=*), intent(in) :: varname !< The name of the variable to read
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: array !< The array to fill with the data
+ ! Local variables
integer :: nf
- do nf=1,size(tidal_input_files)
- if (LEN_TRIM(tidal_input_files(nf)) == 0) cycle
- if (field_exists(tidal_input_files(nf), varname, G%Domain%mpp_domain)) then
- call MOM_read_data(tidal_input_files(nf), varname, array, G%Domain)
+ do nf=1,size(filenames)
+ if (LEN_TRIM(filenames(nf)) == 0) cycle
+ if (field_exists(filenames(nf), varname, G%Domain%mpp_domain)) then
+ call MOM_read_data(filenames(nf), varname, array, G%Domain)
return
endif
enddo
- do nf=size(tidal_input_files),1,-1
- if (file_exists(tidal_input_files(nf), G%Domain)) then
+ do nf=size(filenames),1,-1
+ if (file_exists(filenames(nf), G%Domain)) then
call MOM_error(FATAL, "MOM_tidal_forcing.F90: Unable to find "// &
trim(varname)//" in any of the tidal input files, last tried "// &
- trim(tidal_input_files(nf)))
+ trim(filenames(nf)))
endif
enddo
call MOM_error(FATAL, "MOM_tidal_forcing.F90: Unable to find any of the "// &
- "tidal input files, including "//trim(tidal_input_files(1)))
+ "tidal input files, including "//trim(filenames(1)))
end subroutine find_in_files
@@ -418,18 +377,9 @@ end subroutine find_in_files
!! and loading.
subroutine tidal_forcing_sensitivity(G, CS, deta_tidal_deta)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a previous call to
- !! tidal_forcing_init.
+ type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a previous call to tidal_forcing_init.
real, intent(out) :: deta_tidal_deta !< The partial derivative of eta_tidal with
!! the local value of eta, nondim.
-! This subroutine calculates returns the partial derivative of the local
-! geopotential height with the input sea surface height due to self-attraction
-! and loading.
-! (in) G - The ocean's grid structure.
-! (in) CS - The control structure returned by a previous call to
-! tidal_forcing_init.
-! (out) deta_tidal_deta - the partial derivative of eta_tidal with the
-! local value of eta, nondim.
if (CS%USE_SAL_SCALAR .and. CS%USE_PREV_TIDES) then
deta_tidal_deta = 2.0*CS%SAL_SCALAR
@@ -443,44 +393,31 @@ end subroutine tidal_forcing_sensitivity
!> This subroutine calculates the geopotential anomalies that drive the tides,
!! including self-attraction and loading. Optionally, it also returns the
!! partial derivative of the local geopotential height with the input sea surface
-!! height. For now, eta and eta_tidal are both geopotential heights in m, but
-!! probably the input for eta should really be replaced with the column mass
-!! anomalies.
-subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta)
+!! height. For now, eta and eta_tidal are both geopotential heights in depth
+!! units, but probably the input for eta should really be replaced with the
+!! column mass anomalies.
+subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to_Z)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(time_type), intent(in) :: Time !< The time for the caluculation.
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from
- !! a time-mean geoid in m.
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential
- !! anomalies, in m.
+ !! a time-mean geoid in depth units (Z).
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height
+ !! anomalies, in depth units (Z).
type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a
!! previous call to tidal_forcing_init.
real, optional, intent(out) :: deta_tidal_deta !< The partial derivative of
!! eta_tidal with the local value of
!! eta, nondim.
+ real, optional, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta.
-! This subroutine calculates the geopotential anomalies that drive the tides,
-! including self-attraction and loading. Optionally, it also returns the
-! partial derivative of the local geopotential height with the input sea surface
-! height. For now, eta and eta_tidal are both geopotential heights in m, but
-! probably the input for eta should really be replaced with the column mass
-! anomalies.
-!
-! Arguments: Time - The time for the caluculation.
-! (in) eta - The sea surface height anomaly from a time-mean geoid in m.
-! (out) eta_tidal - The tidal forcing geopotential anomalies, in m.
-! (in) G - The ocean's grid structure.
-! (in) CS - The control structure returned by a previous call to
-! tidal_forcing_init.
-! (out) deta_tidal_deta - the partial derivative of eta_tidal with the
-! local value of eta, nondim.
-
+ ! Local variables
real :: eta_astro(SZI_(G),SZJ_(G))
real :: eta_SAL(SZI_(G),SZJ_(G))
real :: now ! The relative time in seconds.
real :: amp_cosomegat, amp_sinomegat
real :: cosomegat, sinomegat
- real :: eta_prop
+ real :: m_Z ! A scaling factor from m to depth units.
+ real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal.
integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
@@ -513,10 +450,12 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta)
enddo ; enddo
endif
+ m_Z = 1.0 ; if (present(m_to_Z)) m_Z = m_to_Z
+
do c=1,CS%nc
m = CS%struct(c)
- amp_cosomegat = CS%amp(c)*CS%love_no(c)*cos(CS%freq(c)*now + CS%phase0(c))
- amp_sinomegat = CS%amp(c)*CS%love_no(c)*sin(CS%freq(c)*now + CS%phase0(c))
+ amp_cosomegat = m_Z*CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c))
+ amp_sinomegat = m_Z*CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c))
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
eta_tidal(i,j) = eta_tidal(i,j) + (amp_cosomegat*CS%cos_struct(i,j,m) + &
amp_sinomegat*CS%sin_struct(i,j,m))
@@ -527,7 +466,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta)
cosomegat = cos(CS%freq(c)*now)
sinomegat = sin(CS%freq(c)*now)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta_tidal(i,j) = eta_tidal(i,j) + CS%ampsal(i,j,c) * &
+ eta_tidal(i,j) = eta_tidal(i,j) + m_Z*CS%ampsal(i,j,c) * &
(cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c))
enddo ; enddo
enddo ; endif
@@ -536,8 +475,8 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta)
cosomegat = cos(CS%freq(c)*now)
sinomegat = sin(CS%freq(c)*now)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta_tidal(i,j) = eta_tidal(i,j) - CS%SAL_SCALAR*CS%amp_prev(i,j,c) * &
- (cosomegat*CS%cosphase_prev(i,j,c)+sinomegat*CS%sinphase_prev(i,j,c))
+ eta_tidal(i,j) = eta_tidal(i,j) - m_Z*CS%SAL_SCALAR*CS%amp_prev(i,j,c) * &
+ (cosomegat*CS%cosphase_prev(i,j,c) + sinomegat*CS%sinphase_prev(i,j,c))
enddo ; enddo
enddo ; endif
@@ -545,8 +484,10 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta)
end subroutine calc_tidal_forcing
+!> This subroutine deallocates memory associated with the tidal forcing module.
subroutine tidal_forcing_end(CS)
- type(tidal_forcing_CS), pointer :: CS
+ type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a previous call
+ !! to tidal_forcing_init; it is deallocated here.
if (associated(CS%sin_struct)) deallocate(CS%sin_struct)
if (associated(CS%cos_struct)) deallocate(CS%cos_struct)
@@ -563,4 +504,33 @@ subroutine tidal_forcing_end(CS)
end subroutine tidal_forcing_end
+!> \namespace tidal_forcing
+!!
+!! Code by Robert Hallberg, August 2005, based on C-code by Harper
+!! Simmons, February, 2003, in turn based on code by Brian Arbic.
+!!
+!! The main subroutine in this file calculates the total tidal
+!! contribution to the geopotential, including self-attraction and
+!! loading terms and the astronomical contributions. All options
+!! are selected with entries in a file that is parsed at run-time.
+!! Overall tides are enabled with the run-time parameter 'TIDES=True'.
+!! Tidal constituents must be individually enabled with lines like
+!! 'TIDE_M2=True'. This file has default values of amplitude,
+!! frequency, Love number, and phase at time 0 for the Earth's M2,
+!! S2, N2, K2, K1, O1, P1, Q1, MF, and MM tidal constituents, but
+!! the frequency, amplitude and phase ant time 0 for each constituent
+!! can be changed at run time by setting variables like TIDE_M2_FREQ,
+!! TIDE_M2_AMP and TIDE_M2_PHASE_T0 (for M2).
+!!
+!! In addition, the approach to calculating self-attraction and
+!! loading is set at run time. The default is to use the scalar
+!! approximation, with a coefficient TIDE_SAL_SCALAR_VALUE that must
+!! be set in the run-time file (for global runs, 0.094 is typical).
+!! Alternately, TIDAL_SAL_FROM_FILE can be set to read the SAL from
+!! a file containing the results of a previous simulation. To iterate
+!! the SAL to convergence, USE_PREVIOUS_TIDES may be useful (for
+!! details, see Arbic et al., 2004, DSR II). With TIDAL_SAL_FROM_FILE
+!! or USE_PREVIOUS_TIDES,a list of input files must be provided to
+!! describe each constituent's properties from a previous solution.
+
end module MOM_tidal_forcing
diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90
index 1b2dd77928..c842b813c9 100644
--- a/src/parameterizations/vertical/MOM_ALE_sponge.F90
+++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90
@@ -1,11 +1,12 @@
!> This module contains the routines used to apply sponge layers when using
!! the ALE mode.
+!!
!! Applying sponges requires the following:
-!! (1) initialize_ALE_sponge
-!! (2) set_up_ALE_sponge_field (tracers) and set_up_ALE_sponge_vel_field (vel)
-!! (3) apply_ALE_sponge
-!! (4) init_ALE_sponge_diags (not being used for now)
-!! (5) ALE_sponge_end (not being used for now)
+!! 1. initialize_ALE_sponge
+!! 2. set_up_ALE_sponge_field (tracers) and set_up_ALE_sponge_vel_field (vel)
+!! 3. apply_ALE_sponge
+!! 4. init_ALE_sponge_diags (not being used for now)
+!! 5. ALE_sponge_end (not being used for now)
module MOM_ALE_sponge
@@ -17,35 +18,44 @@ module MOM_ALE_sponge
use MOM_error_handler, only : MOM_error, FATAL, NOTE, WARNING, is_root_pe
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
+use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer
use MOM_spatial_means, only : global_i_mean
use MOM_time_manager, only : time_type, init_external_field, get_external_field_size, time_interp_external_init
use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping
-use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer
+use MOM_verticalGrid, only : verticalGrid_type
! GMM - Planned extension: Support for time varying sponge targets.
implicit none ; private
#include
+!> Store the reference profile at h points for a variable
interface set_up_ALE_sponge_field
module procedure set_up_ALE_sponge_field_fixed
module procedure set_up_ALE_sponge_field_varying
end interface
+!> This subroutine stores the reference profile at u and v points for a vector
interface set_up_ALE_sponge_vel_field
module procedure set_up_ALE_sponge_vel_field_fixed
module procedure set_up_ALE_sponge_vel_field_varying
end interface
+!> Ddetermine the number of points which are within sponges in this computational domain.
+!!
+!! Only points that have positive values of Iresttime and which mask2dT indicates are ocean
+!! points are included in the sponges. It also stores the target interface heights.
interface initialize_ALE_sponge
module procedure initialize_ALE_sponge_fixed
module procedure initialize_ALE_sponge_varying
end interface
-!< Publicly available functions
+
+! Publicly available functions
public set_up_ALE_sponge_field, set_up_ALE_sponge_vel_field
public get_ALE_sponge_thicknesses, get_ALE_sponge_nz_data
public initialize_ALE_sponge, apply_ALE_sponge, ALE_sponge_end, init_ALE_sponge_diags
+!> A structure for creating arrays of pointers to 3D arrays with extra gridding information
type :: p3d
integer :: id !< id for FMS external time interpolator
integer :: nz_data !< The number of vertical levels in the input field.
@@ -54,6 +64,8 @@ module MOM_ALE_sponge
real, dimension(:,:,:), pointer :: p => NULL() !< pointer to the data.
real, dimension(:,:,:), pointer :: h => NULL() !< pointer to the data grid.
end type p3d
+
+!> A structure for creating arrays of pointers to 2D arrays with extra gridding information
type :: p2d
integer :: id !< id for FMS external time interpolator
integer :: nz_data !< The number of vertical levels in the input field
@@ -63,39 +75,48 @@ module MOM_ALE_sponge
real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid.
end type p2d
-!> SPONGE control structure
+!> ALE sponge control structure
type, public :: ALE_sponge_CS ; private
- integer :: nz !< The total number of layers.
- integer :: nz_data !< The total number of arbritary layers (used by older code).
- integer :: isc, iec, jsc, jec !< The index ranges of the computational domain at h.
- integer :: iscB, iecB, jscB, jecB !< The index ranges of the computational domain at u/v.
- integer :: isd, ied, jsd, jed !< The index ranges of the data domain.
- integer :: num_col, num_col_u, num_col_v !< The number of sponge points within the
- !! computational domain.
- integer :: fldno = 0 !< The number of fields which have already been
- !! registered by calls to set_up_sponge_field
- logical :: sponge_uv !< Control whether u and v are included in sponge
- integer, pointer :: col_i(:) => NULL() !< Arrays containing the i- and j- indicies
- integer, pointer :: col_j(:) => NULL() !! of each of the columns being damped.
- integer, pointer :: col_i_u(:) => NULL() !< Same as above for u points
- integer, pointer :: col_j_u(:) => NULL()
- integer, pointer :: col_i_v(:) => NULL() !< Same as above for v points
- integer, pointer :: col_j_v(:) => NULL()
-
- real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of
- !! each column.
- real, pointer :: Iresttime_col_u(:) => NULL() !< Same as above for u points
- real, pointer :: Iresttime_col_v(:) => NULL() !< Same as above for v points
+ integer :: nz !< The total number of layers.
+ integer :: nz_data !< The total number of arbritary layers (used by older code).
+ integer :: isc !< The starting i-index of the computational domain at h.
+ integer :: iec !< The ending i-index of the computational domain at h.
+ integer :: jsc !< The starting j-index of the computational domain at h.
+ integer :: jec !< The ending j-index of the computational domain at h.
+ integer :: IscB !< The starting I-index of the computational domain at u/v.
+ integer :: IecB !< The ending I-index of the computational domain at u/v.
+ integer :: JscB !< The starting J-index of the computational domain at u/v.
+ integer :: JecB !< The ending J-index of the computational domain at h.
+ integer :: isd !< The starting i-index of the data domain at h.
+ integer :: ied !< The ending i-index of the data domain at h.
+ integer :: jsd !< The starting j-index of the data domain at h.
+ integer :: jed !< The ending j-index of the data domain at h.
+ integer :: num_col !< The number of sponge tracer points within the computational domain.
+ integer :: num_col_u !< The number of sponge u-points within the computational domain.
+ integer :: num_col_v !< The number of sponge v-points within the computational domain.
+ integer :: fldno = 0 !< The number of fields which have already been
+ !! registered by calls to set_up_sponge_field
+ logical :: sponge_uv !< Control whether u and v are included in sponge
+ integer, pointer :: col_i(:) => NULL() !< Array of the i-indicies of each tracer columns being damped.
+ integer, pointer :: col_j(:) => NULL() !< Array of the j-indicies of each tracer columns being damped.
+ integer, pointer :: col_i_u(:) => NULL() !< Array of the i-indicies of each u-columns being damped.
+ integer, pointer :: col_j_u(:) => NULL() !< Array of the j-indicies of each u-columns being damped.
+ integer, pointer :: col_i_v(:) => NULL() !< Array of the i-indicies of each v-columns being damped.
+ integer, pointer :: col_j_v(:) => NULL() !< Array of the j-indicies of each v-columns being damped.
+
+ real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each tracer column.
+ real, pointer :: Iresttime_col_u(:) => NULL() !< The inverse restoring time of each u-column.
+ real, pointer :: Iresttime_col_v(:) => NULL() !< The inverse restoring time of each v-column.
type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped.
- type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped.
- type(p2d) :: Ref_val_u !< Same as above for u points.
- type(p2d) :: Ref_val_v !< Same as above for v points.
- type(p3d) :: var_u !< Pointers to the u vel. that are being damped.
- type(p3d) :: var_v !< Pointers to the v vel. that are being damped.
+ type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped.
+ type(p2d) :: Ref_val_u !< The values to which the u-velocities are damped.
+ type(p2d) :: Ref_val_v !< The values to which the v-velocities are damped.
+ type(p3d) :: var_u !< Pointer to the u velocities. that are being damped.
+ type(p3d) :: var_v !< Pointer to the v velocities. that are being damped.
type(p2d) :: Ref_h !< Grid on which reference data is provided (older code).
- type(p2d) :: Ref_hu !< Same as above for u points.
- type(p2d) :: Ref_hv !< Same as above for v points.
+ type(p2d) :: Ref_hu !< u-point grid on which reference data is provided (older code).
+ type(p2d) :: Ref_hv !< v-point grid on which reference data is provided (older code).
type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
!! timing of diagnostic output.
@@ -107,11 +128,9 @@ module MOM_ALE_sponge
contains
-!> This subroutine determines the number of points which are within
-! sponges in this computational domain. Only points that have
-! positive values of Iresttime and which mask2dT indicates are ocean
-! points are included in the sponges. It also stores the target interface
-! heights.
+!> This subroutine determines the number of points which are within sponges in this computational
+!! domain. Only points that have positive values of Iresttime and which mask2dT indicates are ocean
+!! points are included in the sponges. It also stores the target interface heights.
subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in).
@@ -121,7 +140,8 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_
!! to parse for model parameter values (in).
type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control
!! structure for this module (in/out).
- real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers.
+ real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge
+ !! input layers, in thickness units (H).
! This include declares and sets the variable "version".
@@ -312,7 +332,7 @@ end function get_ALE_sponge_nz_data
subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in).
real, allocatable, dimension(:,:,:), &
- intent(inout) :: data_h !< The thicknesses of the sponge input layers.
+ intent(inout) :: data_h !< The thicknesses of the sponge input layers, in H.
logical, dimension(SZI_(G),SZJ_(G)), &
intent(out) :: sponge_mask !< A logical mask that is true where
!! sponges are being applied.
@@ -343,11 +363,9 @@ subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS)
end subroutine get_ALE_sponge_thicknesses
-!> This subroutine determines the number of points which are within
-! sponges in this computational domain. Only points that have
-! positive values of Iresttime and which mask2dT indicates are ocean
-! points are included in the sponges. It also stores the target interface
-! heights.
+!> This subroutine determines the number of points which are within sponges in this computational
+!! domain. Only points that have positive values of Iresttime and which mask2dT indicates are ocean
+!! points are included in the sponges.
subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in).
@@ -512,10 +530,11 @@ end subroutine initialize_ALE_sponge_varying
!> Initialize diagnostics for the ALE_sponge module.
! GMM: this routine is not being used for now.
subroutine init_ALE_sponge_diags(Time, G, diag, CS)
- type(time_type), target, intent(in) :: Time
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(diag_ctrl), target, intent(inout) :: diag
- type(ALE_sponge_CS), pointer :: CS
+ type(time_type), target, intent(in) :: Time !< The current model time
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic
+ !! output.
+ type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure
if (.not.associated(CS)) return
@@ -527,7 +546,7 @@ end subroutine init_ALE_sponge_diags
!! whose address is given by f_ptr.
subroutine set_up_ALE_sponge_field_fixed(sp_val, G, f_ptr, CS)
type(ocean_grid_type), intent(in) :: G !< Grid structure
- type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out).
+ type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure (in/out).
real, dimension(SZI_(G),SZJ_(G),CS%nz_data), &
intent(in) :: sp_val !< Field to be used in the sponge, it has arbritary number of layers.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
@@ -561,15 +580,17 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, f_ptr, CS)
end subroutine set_up_ALE_sponge_field_fixed
!> This subroutine stores the reference profile at h points for the variable
-! whose address is given by filename and fieldname.
+!! whose address is given by filename and fieldname.
subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, CS)
- character(len=*), intent(in) :: filename
- character(len=*), intent(in) :: fieldname
- type(time_type), intent(in) :: Time
- type(ocean_grid_type), intent(in) :: G !< Grid structure (in).
+ character(len=*), intent(in) :: filename !< The name of the file with the
+ !! time varying field data
+ character(len=*), intent(in) :: fieldname !< The name of the field in the file
+ !! with the time varying field data
+ type(time_type), intent(in) :: Time !< The current model time
+ type(ocean_grid_type), intent(in) :: G !< Grid structure (in).
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
target, intent(in) :: f_ptr !< Pointer to the field to be damped (in).
- type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out).
+ type(ALE_sponge_CS), pointer :: CS !< Sponge control structure (in/out).
real, allocatable, dimension(:,:,:) :: sp_val !< Field to be used in the sponge
real, allocatable, dimension(:,:,:) :: mask_z !< Field mask for the sponge data
@@ -647,10 +668,10 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr,
zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0; tmpT1d(:) = -99.9
do k=1,nz_data
if (mask_z(CS%col_i(col),CS%col_j(col),k) == 1.0) then
- zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(CS%col_i(col),CS%col_j(col)) )
+ zBottomOfCell = -min( z_edges_in(k+1), G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) )
! tmpT1d(k) = sp_val(CS%col_i(col),CS%col_j(col),k)
elseif (k>1) then
- zBottomOfCell = -G%bathyT(CS%col_i(col),CS%col_j(col))
+ zBottomOfCell = -G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col))
! tmpT1d(k) = tmpT1d(k-1)
! else ! This next block should only ever be reached over land
! tmpT1d(k) = -99.9
@@ -660,7 +681,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr,
zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k
enddo
! In case data is deeper than model
- hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) )
+ hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) )
CS%Ref_val(CS%fldno)%h(1:nz_data,col) = 0.
CS%Ref_val(CS%fldno)%p(1:nz_data,col) = -1.e24
CS%Ref_val(CS%fldno)%h(1:nz_data,col) = hsrc(1:nz_data)
@@ -717,7 +738,8 @@ end subroutine set_up_ALE_sponge_vel_field_fixed
!> This subroutine stores the reference profile at uand v points for the variable
!! whose address is given by u_ptr and v_ptr.
-subroutine set_up_ALE_sponge_vel_field_varying(filename_u,fieldname_u,filename_v,fieldname_v, Time, G, CS, u_ptr, v_ptr)
+subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename_v, fieldname_v, &
+ Time, G, CS, u_ptr, v_ptr)
character(len=*), intent(in) :: filename_u !< File name for u field
character(len=*), intent(in) :: fieldname_u !< Name of u variable in file
character(len=*), intent(in) :: filename_v !< File name for v field
@@ -816,7 +838,7 @@ end subroutine set_up_ALE_sponge_vel_field_varying
subroutine apply_ALE_sponge(h, dt, G, CS, Time)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in).
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: h !< Layer thickness, in m (in)
+ intent(inout) :: h !< Layer thickness, in H (in)
real, intent(in) :: dt !< The amount of time covered by this call, in s (in).
type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure for this module
!! that is set by a previous call to initialize_sponge (in).
@@ -1011,12 +1033,13 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time)
end subroutine apply_ALE_sponge
-!> GMM: I could not find where sponge_end is being called, but I am keeping
+! GMM: I could not find where sponge_end is being called, but I am keeping
! ALE_sponge_end here so we can add that if needed.
+!> This subroutine deallocates any memory associated with the ALE_sponge module.
subroutine ALE_sponge_end(CS)
- type(ALE_sponge_CS), pointer :: CS
-! (in) CS - A pointer to the control structure for this module that is
-! set by a previous call to initialize_sponge.
+ type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure that is
+ !! set by a previous call to initialize_sponge.
+
integer :: m
if (.not.associated(CS)) return
diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90
index 59844ea7ad..dec3187a99 100644
--- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90
@@ -116,8 +116,8 @@ module MOM_CVMix_KPP
!> CVMix parameters
type(CVMix_kpp_params_type), pointer :: KPP_params => NULL()
- ! Diagnostic handles and pointers
- type(diag_ctrl), pointer :: diag => NULL()
+ type(diag_ctrl), pointer :: diag => NULL() !< Pointer to diagnostics control structure
+ !>@{ Diagnostic handles
integer :: id_OBLdepth = -1, id_BulkRi = -1
integer :: id_N = -1, id_N2 = -1
integer :: id_Ws = -1, id_Vt2 = -1
@@ -137,6 +137,7 @@ module MOM_CVMix_KPP
integer :: id_NLT_saln_budget = -1
integer :: id_EnhK = -1, id_EnhW = -1, id_EnhVt2 = -1
integer :: id_OBLdepth_original = -1
+ !!@}
! Diagnostics arrays
real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of OBL (m)
@@ -158,28 +159,25 @@ module MOM_CVMix_KPP
real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer (ppt)
real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer (m/s)
real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer (m/s)
- real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient
- real, allocatable, dimension(:,:,:) :: EnhVt2 !< Enhancement for Vt2
-
-
+ real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient
+ real, allocatable, dimension(:,:,:) :: EnhVt2 !< Enhancement for Vt2
end type KPP_CS
-! Module data used for debugging only
-logical, parameter :: verbose = .False.
#define __DO_SAFETY_CHECKS__
contains
!> Initialize the CVMix KPP module and set up diagnostics
!! Returns True if KPP is to be used, False otherwise.
-logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves)
+logical function KPP_init(paramFile, G, GV, diag, Time, CS, passive, Waves)
! Arguments
type(param_file_type), intent(in) :: paramFile !< File parser
type(ocean_grid_type), intent(in) :: G !< Ocean grid
+ type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure.
type(diag_ctrl), target, intent(in) :: diag !< Diagnostics
- type(time_type), intent(in) :: Time !< Time
+ type(time_type), intent(in) :: Time !< Model time
type(KPP_CS), pointer :: CS !< Control structure
logical, optional, intent(out) :: passive !< Copy of %passiveMode
type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS
@@ -496,7 +494,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves)
CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, &
'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s')
CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, &
- 'Diffusivity passed to KPP', 'm2/s')
+ 'Diffusivity passed to KPP', 'm2/s', conversion=GV%Z_to_m**2)
CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, &
'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s')
CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, &
@@ -536,7 +534,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves)
CS%Vt2(:,:,:) = 0.
if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) )
- allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) );CS%OBLdepthprev(:,:)=0.0
+ allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) ) ; CS%OBLdepthprev(:,:) = 0.0
if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) )
if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0.
if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(G) ) )
@@ -584,12 +582,12 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, &
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H)
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s)
- !< (out) Vertical diffusivity including KPP (m2/s)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s)
- !< (out) Vertical diffusivity including KPP (m2/s)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s)
- !< (out) Vertical viscosity including KPP (m2/s)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (Z2/s)
+ !< (out) Vertical diffusivity including KPP (Z2/s)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (Z2/s)
+ !< (out) Vertical diffusivity including KPP (Z2/s)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (Z2/s)
+ !< (out) Vertical viscosity including KPP (Z2/s)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s)
@@ -615,8 +613,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, &
call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m)
call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0)
call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0)
- call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0)
- call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0)
+ call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=GV%Z_to_m**2)
+ call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=GV%Z_to_m**2)
endif
#endif
@@ -624,9 +622,7 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, &
if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag)
- !$OMP parallel do default(private) firstprivate(nonLocalTrans) &
- !$OMP shared(G,GV,CS,uStar,h,Waves,&
- !$OMP buoyFlux,nonLocalTransHeat,nonLocalTransScalar,Kt,Ks,Kv)
+ !$OMP parallel do default(shared) firstprivate(nonLocalTrans)
! loop over horizontal points on processor
do j = G%jsc, G%jec
do i = G%isc, G%iec
@@ -663,7 +659,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, &
if (CS%SW_METHOD == SW_METHOD_ALL_SW) then
surfBuoyFlux = buoyFlux(i,j,1)
elseif (CS%SW_METHOD == SW_METHOD_MXL_SW) then
- surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1) ! We know the actual buoyancy flux into the OBL
+ ! We know the actual buoyancy flux into the OBL
+ surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1)
elseif (CS%SW_METHOD == SW_METHOD_LV1_SW) then
surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,2)
endif
@@ -673,9 +670,9 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, &
Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s)
Kviscosity(:) = 0. ! Viscosity (m2/s)
else
- Kdiffusivity(:,1) = Kt(i,j,:)
- Kdiffusivity(:,2) = Ks(i,j,:)
- Kviscosity(:)=Kv(i,j,:)
+ Kdiffusivity(:,1) = GV%Z_to_m**2 * Kt(i,j,:)
+ Kdiffusivity(:,2) = GV%Z_to_m**2 * Ks(i,j,:)
+ Kviscosity(:) = GV%Z_to_m**2 * Kv(i,j,:)
endif
call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity (m2/s)
@@ -816,17 +813,17 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, &
if (.not. CS%passiveMode) then
if (CS%KPPisAdditive) then
do k=1, G%ke+1
- Kt(i,j,k) = Kt(i,j,k) + Kdiffusivity(k,1)
- Ks(i,j,k) = Ks(i,j,k) + Kdiffusivity(k,2)
- Kv(i,j,k) = Kv(i,j,k) + Kviscosity(k)
- if (CS%Stokes_Mixing) Waves%KvS(i,j,k)=Kv(i,j,k)
+ Kt(i,j,k) = Kt(i,j,k) + GV%m_to_Z**2 * Kdiffusivity(k,1)
+ Ks(i,j,k) = Ks(i,j,k) + GV%m_to_Z**2 * Kdiffusivity(k,2)
+ Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kviscosity(k)
+ if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k)
enddo
else ! KPP replaces prior diffusivity when former is non-zero
do k=1, G%ke+1
- if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = Kdiffusivity(k,1)
- if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = Kdiffusivity(k,2)
- if (Kviscosity(k) /= 0.) Kv(i,j,k) = Kviscosity(k)
- if (CS%Stokes_Mixing) Waves%KvS(i,j,k)=Kv(i,j,k)
+ if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = GV%m_to_Z**2 * Kdiffusivity(k,1)
+ if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = GV%m_to_Z**2 * Kdiffusivity(k,2)
+ if (Kviscosity(k) /= 0.) Kv(i,j,k) = GV%m_to_Z**2 * Kviscosity(k)
+ if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k)
enddo
endif
endif
@@ -839,8 +836,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, &
#ifdef __DO_SAFETY_CHECKS__
if (CS%debug) then
- call hchksum(Kt, "KPP out: Kt",G%HI,haloshift=0)
- call hchksum(Ks, "KPP out: Ks",G%HI,haloshift=0)
+ call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=GV%Z_to_m**2)
+ call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=GV%Z_to_m**2)
endif
#endif
@@ -867,7 +864,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux,
! Arguments
type(KPP_CS), pointer :: CS !< Control structure
- type(ocean_grid_type), intent(in) :: G !< Ocean grid
+ type(ocean_grid_type), intent(inout) :: G !< Ocean grid
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid
type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H)
@@ -933,12 +930,10 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux,
#endif
! some constants
- GoRho = GV%g_Earth / GV%Rho0
-
-!$OMP parallel do default(private) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, &
-!$OMP Waves,buoyFlux) &
+ GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0
! loop over horizontal points on processor
+ !$OMP parallel do default(shared)
do j = G%jsc, G%jec
do i = G%isc, G%iec
@@ -1313,14 +1308,16 @@ end subroutine KPP_compute_BLD
subroutine KPP_smooth_BLD(CS,G,GV,h)
! Arguments
type(KPP_CS), pointer :: CS !< Control structure
- type(ocean_grid_type), intent(in) :: G !< Ocean grid
+ type(ocean_grid_type), intent(inout) :: G !< Ocean grid
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H)
! local
real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_original ! Original OBL depths computed by CVMix
- real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean)
- real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean)
+ real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m)
+ ! (negative in the ocean)
+ real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m)
+ ! (negative in the ocean)
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)
@@ -1551,7 +1548,7 @@ subroutine KPP_end(CS)
end subroutine KPP_end
-!> \namespace mom_kpp
+!> \namespace mom_cvmix_kpp
!!
!! \section section_KPP The K-Profile Parameterization
!!
diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90
index 638c3f0a2d..851951af3e 100644
--- a/src/parameterizations/vertical/MOM_CVMix_conv.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90
@@ -34,11 +34,13 @@ module MOM_CVMix_conv
logical :: debug !< If true, turn on debugging
! Daignostic handles and pointers
- type(diag_ctrl), pointer :: diag => NULL()
+ type(diag_ctrl), pointer :: diag => NULL() !< Pointer to diagnostics control structure
+ !>@{ Diagnostics handles
integer :: id_N2 = -1, id_kd_conv = -1, id_kv_conv = -1
+ !!@}
! Diagnostics arrays
- real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2)
+ real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2)
real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection (m2/s)
real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection (m2/s)
@@ -57,7 +59,6 @@ logical function CVMix_conv_init(Time, G, GV, param_file, diag, CS)
type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure.
type(CVMix_conv_cs), pointer :: CS !< This module's control structure.
-
! Local variables
real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities.
logical :: useEPBL !< If True, use the ePBL boundary layer scheme.
@@ -131,9 +132,9 @@ logical function CVMix_conv_init(Time, G, GV, param_file, diag, CS)
CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, &
'Square of Brunt-Vaisala frequency used by MOM_CVMix_conv module', '1/s2')
CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, &
- 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s')
+ 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=GV%Z_to_m**2)
CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, &
- 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s')
+ 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=GV%Z_to_m**2)
call CVMix_init_conv(convect_diff=CS%kd_conv_const, &
convect_visc=CS%kv_conv_const, &
@@ -153,20 +154,21 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl)
type(CVMix_conv_cs), pointer :: CS !< The control structure returned
!! by a previous call to CVMix_conv_init.
real, dimension(:,:), optional, pointer :: hbl!< Depth of ocean boundary layer (m)
-
! local variables
real, dimension(SZK_(G)) :: rho_lwr !< Adiabatic Water Density, this is a dummy
!! variable since here convection is always
!! computed based on Brunt Vaisala.
real, dimension(SZK_(G)) :: rho_1d !< water density in a column, this is also
!! a dummy variable, same reason as above.
+ real, dimension(SZK_(G)+1) :: kv_col !< Viscosities at interfaces in the column (m2 s-1)
+ real, dimension(SZK_(G)+1) :: kd_col !< Diffusivities at interfaces in the column (m2 s-1)
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 :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr
integer :: i, j, k
- g_o_rho0 = GV%g_Earth / GV%Rho0
+ g_o_rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0
! initialize dummy variables
rho_lwr(:) = 0.0; rho_1d(:) = 0.0
@@ -215,8 +217,9 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl)
! gets index of the level and interface above hbl
kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j))
- call CVMix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), &
- Tdiff_out=CS%kd_conv(i,j,:), &
+ kv_col(:) = 0.0 ; kd_col(:) = 0.0
+ call CVMix_coeffs_conv(Mdiff_out=kv_col(:), &
+ Tdiff_out=kd_col(:), &
Nsqr=CS%N2(i,j,:), &
dens=rho_1d(:), &
dens_lwr=rho_lwr(:), &
@@ -224,11 +227,15 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl)
max_nlev=G%ke, &
OBL_ind=kOBL)
- ! Do not apply mixing due to convection within the boundary layer
- do k=1,kOBL
- CS%kv_conv(i,j,k) = 0.0
- CS%kd_conv(i,j,k) = 0.0
- enddo
+ do K=1,G%ke+1
+ CS%kv_conv(i,j,K) = GV%m_to_Z**2 * kv_col(K)
+ CS%kd_conv(i,j,K) = GV%m_to_Z**2 * kd_col(K)
+ enddo
+ ! Do not apply mixing due to convection within the boundary layer
+ do k=1,kOBL
+ CS%kv_conv(i,j,k) = 0.0
+ CS%kd_conv(i,j,k) = 0.0
+ enddo
enddo
enddo
@@ -258,7 +265,8 @@ end function CVMix_conv_is_used
!> Clear pointers and dealocate memory
subroutine CVMix_conv_end(CS)
- type(CVMix_conv_cs), pointer :: CS ! Control structure
+ type(CVMix_conv_cs), pointer :: CS !< Control structure for this module that
+ !! will be deallocated in this subroutine
if (.not. associated(CS)) return
@@ -269,5 +277,4 @@ subroutine CVMix_conv_end(CS)
end subroutine CVMix_conv_end
-
end module MOM_CVMix_conv
diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90
index 7137aabfa6..eabce5056b 100644
--- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90
@@ -40,13 +40,15 @@ module MOM_CVMix_ddiff
logical :: debug !< If true, turn on debugging
! Daignostic handles and pointers
- type(diag_ctrl), pointer :: diag => NULL()
+ type(diag_ctrl), pointer :: diag => NULL() !< Pointer to diagnostics control structure
+ !>@{ Diagnostics handles
integer :: id_KT_extra = -1, id_KS_extra = -1, id_R_rho = -1
+ !!@}
! Diagnostics arrays
- real, allocatable, dimension(:,:,:) :: KT_extra !< double diffusion diffusivity for temp (m2/s)
- real, allocatable, dimension(:,:,:) :: KS_extra !< double diffusion diffusivity for salt (m2/s)
- real, allocatable, dimension(:,:,:) :: R_rho !< double-diffusion density ratio (nondim)
+! real, allocatable, dimension(:,:,:) :: KT_extra !< Double diffusion diffusivity for temp (Z2/s)
+! real, allocatable, dimension(:,:,:) :: KS_extra !< Double diffusion diffusivity for salt (Z2/s)
+ real, allocatable, dimension(:,:,:) :: R_rho !< Double-diffusion density ratio (nondim)
end type CVMix_ddiff_cs
@@ -134,10 +136,10 @@ logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS)
CS%diag => diag
CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, &
- 'Double-diffusive diffusivity for temperature', 'm2 s-1')
+ 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2)
CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, &
- 'Double-diffusive diffusivity for salinity', 'm2 s-1')
+ 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2)
CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, &
'Double-diffusion density ratio', 'nondim')
@@ -165,15 +167,13 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2.
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal
- !! diffusivity for temp (m2/sec).
+ !! diffusivity for temp (Z2/sec).
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal
- !! diffusivity for salt (m2/sec).
+ !! diffusivity for salt (Z2/sec).
type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned
!! by a previous call to CVMix_ddiff_init.
integer, intent(in) :: j !< Meridional grid indice.
-! real, dimension(:,:), optional, pointer :: hbl !< Depth of ocean boundary layer (m)
-
- ! local variables
+ ! 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)
@@ -185,6 +185,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS)
beta_dS, & !< beta*dS across interfaces
dT, & !< temp. difference between adjacent layers (degC)
dS !< salt difference between adjacent layers
+ real, dimension(SZK_(G)+1) :: &
+ Kd1_T, & !< Diapycanal diffusivity of temperature, in m2 s-1.
+ Kd1_S !< Diapycanal diffusivity of salinity, in m2 s-1.
real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m)
integer :: kOBL !< level of OBL extent
@@ -196,8 +199,6 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS)
alpha_dT(:) = 0.0; beta_dS(:) = 0.0; dRho_dT(:) = 0.0
dRho_dS(:) = 0.0; dT(:) = 0.0; dS(:) = 0.0
- ! set Kd_T and Kd_S to zero to avoid passing values from previous call
- Kd_T(:,j,:) = 0.0; Kd_S(:,j,:) = 0.0
! GMM, I am leaving some code commented below. We need to pass BLD to
! this soubroutine to avoid adding diffusivity above that. This needs
@@ -229,7 +230,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, 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(:), 1, &
+ G%ke, 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"
@@ -262,12 +264,17 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS)
! gets index of the level and interface above hbl
!kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j))
- call CVMix_coeffs_ddiff(Tdiff_out=Kd_T(i,j,:), &
- Sdiff_out=Kd_S(i,j,:), &
+ Kd1_T(:) = 0.0 ; Kd1_S(:) = 0.0
+ call CVMix_coeffs_ddiff(Tdiff_out=Kd1_T(:), &
+ Sdiff_out=Kd1_S(:), &
strat_param_num=alpha_dT(:), &
strat_param_denom=beta_dS(:), &
nlev=G%ke, &
max_nlev=G%ke)
+ do K=1,G%ke+1
+ Kd_T(i,j,K) = GV%m_to_Z**2 * Kd1_T(K)
+ Kd_S(i,j,K) = GV%m_to_Z**2 * Kd1_S(K)
+ enddo
! Do not apply mixing due to convection within the boundary layer
!do k=1,kOBL
@@ -291,11 +298,11 @@ end function CVMix_ddiff_is_used
!> Clear pointers and dealocate memory
subroutine CVMix_ddiff_end(CS)
- type(CVMix_ddiff_cs), pointer :: CS ! Control structure
+ type(CVMix_ddiff_cs), pointer :: CS !< Control structure for this module that
+ !! will be deallocated in this subroutine
deallocate(CS)
end subroutine CVMix_ddiff_end
-
end module MOM_CVMix_ddiff
diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90
index 49b1e5c326..d80ccf1114 100644
--- a/src/parameterizations/vertical/MOM_CVMix_shear.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90
@@ -3,13 +3,7 @@ module MOM_CVMix_shear
! This file is part of MOM6. See LICENSE.md for the license.
-!---------------------------------------------------
-! module MOM_CVMix_shear
-! Author: Brandon Reichl
-! Date: Aug 31, 2016
-! Purpose: Interface to CVMix interior shear schemes
-! Further information to be added at a later time.
-!---------------------------------------------------
+!> \author Brandon Reichl
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
use MOM_diag_mediator, only : diag_ctrl, time_type
@@ -28,8 +22,9 @@ module MOM_CVMix_shear
public calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_is_used, CVMix_shear_end
!> Control structure including parameters for CVMix interior shear schemes.
-type, public :: CVMix_shear_cs
- logical :: use_LMD94, use_PP81 !< Flags for various schemes
+type, public :: CVMix_shear_cs ! TODO: private
+ logical :: use_LMD94 !< Flags to use the LMD94 scheme
+ logical :: use_PP81 !< Flags to use Pacanowski and Philander (JPO 1981)
logical :: smooth_ri !< If true, smooth Ri using a 1-2-1 filter
real :: Ri_zero !< LMD94 critical Richardson number
real :: Nu_zero !< LMD94 maximum interior diffusivity
@@ -41,10 +36,12 @@ module MOM_CVMix_shear
real, allocatable, dimension(:,:,:) :: ri_grad_smooth !< Gradient Richardson number
!! after smoothing
character(10) :: Mix_Scheme !< Mixing scheme name (string)
- ! Daignostic handles and pointers
- type(diag_ctrl), pointer :: diag => NULL()
+
+ type(diag_ctrl), pointer :: diag => NULL() !< Pointer to the diagnostics control structure
+ !>@{ Diagnostic handles
integer :: id_N2 = -1, id_S2 = -1, id_ri_grad = -1, id_kv = -1, id_kd = -1
integer :: id_ri_grad_smooth = -1
+ !!@}
end type CVMix_shear_cs
@@ -53,8 +50,7 @@ module MOM_CVMix_shear
contains
!> Subroutine for calculating (internal) vertical diffusivities/viscosities
-subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, &
- kv, G, GV, CS )
+subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, CS )
type(ocean_grid_type), intent(in) :: G !< Grid structure.
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1.
@@ -62,9 +58,9 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, &
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2.
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface
- !! (not layer!) in m2 s-1.
+ !! (not layer!) in Z2 s-1.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface
- !! (not layer!) in m2 s-1.
+ !! (not layer!) in Z2 s-1.
type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to
!! CVMix_shear_init.
! Local variables
@@ -72,11 +68,13 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, &
real :: GoRho
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, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number
+ real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces (m2/s)
+ real, dimension(G%ke+1) :: Kdiff !< Diapycnal diffusivity at interfaces (m2/s)
real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers
! some constants
- GoRho = GV%g_Earth / GV%Rho0
+ GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0
do j = G%jsc, G%jec
do i = G%isc, G%iec
@@ -150,23 +148,31 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, &
if (CS%id_ri_grad_smooth > 0) CS%ri_grad_smooth(i,j,:) = Ri_Grad(:)
endif
+ do K=1,G%ke+1
+ Kvisc(K) = GV%Z_to_m**2 * kv(i,j,K)
+ Kdiff(K) = GV%Z_to_m**2 * kd(i,j,K)
+ enddo
! Call to CVMix wrapper for computing interior mixing coefficients.
- call CVMix_coeffs_shear(Mdiff_out=kv(i,j,:), &
- Tdiff_out=kd(i,j,:), &
+ call CVMix_coeffs_shear(Mdiff_out=Kvisc(:), &
+ Tdiff_out=Kdiff(:), &
RICH=Ri_Grad(:), &
nlev=G%ke, &
max_nlev=G%ke)
+ do K=1,G%ke+1
+ kv(i,j,K) = GV%m_to_Z**2 * Kvisc(K)
+ kd(i,j,K) = GV%m_to_Z**2 * Kdiff(K)
+ enddo
enddo
enddo
! write diagnostics
- if (CS%id_kd > 0) call post_data(CS%id_kd,kd, CS%diag)
- if (CS%id_kv > 0) call post_data(CS%id_kv,kv, CS%diag)
- if (CS%id_N2 > 0) call post_data(CS%id_N2,CS%N2, CS%diag)
- if (CS%id_S2 > 0) call post_data(CS%id_S2,CS%S2, CS%diag)
- if (CS%id_ri_grad > 0) call post_data(CS%id_ri_grad,CS%ri_grad, CS%diag)
- if (CS%id_ri_grad_smooth > 0) call post_data(CS%id_ri_grad_smooth,CS%ri_grad_smooth, CS%diag)
+ if (CS%id_kd > 0) call post_data(CS%id_kd, kd, CS%diag)
+ if (CS%id_kv > 0) call post_data(CS%id_kv, kv, CS%diag)
+ if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag)
+ if (CS%id_S2 > 0) call post_data(CS%id_S2, CS%S2, CS%diag)
+ if (CS%id_ri_grad > 0) call post_data(CS%id_ri_grad, CS%ri_grad, CS%diag)
+ if (CS%id_ri_grad_smooth > 0) call post_data(CS%id_ri_grad_smooth ,CS%ri_grad_smooth, CS%diag)
end subroutine calculate_CVMix_shear
@@ -251,29 +257,33 @@ logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS)
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')
- if (CS%id_N2 > 0) &
- allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%N2(:,:,:) = 0.
+ 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')
- if (CS%id_S2 > 0) &
- allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%S2(:,:,:) = 0.
+ if (CS%id_S2 > 0) then
+ allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%S2(:,:,:) = 0.
+ endif
CS%id_ri_grad = register_diag_field('ocean_model', 'ri_grad_shear', diag%axesTi, Time, &
'Gradient Richarson number used by MOM_CVMix_shear module','nondim')
- if (CS%id_ri_grad > 0) & !Initialize w/ large Richardson value
- allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad(:,:,:) = 1.e8
+ if (CS%id_ri_grad > 0) then !Initialize w/ large Richardson value
+ allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 )) ; CS%ri_grad(:,:,:) = 1.e8
+ endif
CS%id_ri_grad_smooth = register_diag_field('ocean_model', 'ri_grad_shear_smooth', &
diag%axesTi, Time, &
'Smoothed gradient Richarson number used by MOM_CVMix_shear module','nondim')
- if (CS%id_ri_grad_smooth > 0) & !Initialize w/ large Richardson value
- allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad_smooth(:,:,:) = 1.e8
+ if (CS%id_ri_grad_smooth > 0) then !Initialize w/ large Richardson value
+ allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(G)+1 )) ; CS%ri_grad_smooth(:,:,:) = 1.e8
+ endif
CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, &
- 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s')
+ 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2)
CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, &
- 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s')
+ 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2)
end function CVMix_shear_init
@@ -293,7 +303,8 @@ end function CVMix_shear_is_used
!> Clear pointers and dealocate memory
subroutine CVMix_shear_end(CS)
- type(CVMix_shear_cs), pointer :: CS ! Control structure
+ type(CVMix_shear_cs), pointer :: CS !< Control structure for this module that
+ !! will be deallocated in this subroutine
if (.not. associated(CS)) return
diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90
index bb1e0b11c1..19181b1bf9 100644
--- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90
+++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90
@@ -10,8 +10,7 @@ module MOM_bkgnd_mixing
use MOM_EOS, only : calculate_density, calculate_density_derivs
use MOM_variables, only : thermo_var_ptrs
use MOM_forcing_type, only : forcing
-use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE
-use MOM_error_handler, only : is_root_pe
+use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE
use MOM_file_parser, only : openParameterBlock, closeParameterBlock
use MOM_debugging, only : hchksum
use MOM_grid, only : ocean_grid_type
@@ -31,7 +30,7 @@ module MOM_bkgnd_mixing
public sfc_bkgnd_mixing
!> Control structure including parameters for this module.
-type, public :: bkgnd_mixing_cs
+type, public :: bkgnd_mixing_cs ! TODO: private
! Parameters
real :: Bryan_Lewis_c1 !< The vertical diffusivity values for Bryan-Lewis profile
@@ -42,8 +41,16 @@ module MOM_bkgnd_mixing
!! Bryan-Lewis diffusivity profile (1/m)
real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the
!! Bryan-Lewis profile (m)
- real :: Kd_min !< minimum diapycnal diffusivity (m2/s)
- real :: Kd !< interior diapycnal diffusivity (m2/s)
+ real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when
+ !! horiz_varying_background=.true.
+ real :: bckgrnd_vdc_eq !! Equatorial diffusivity (Gregg) when
+ !! horiz_varying_background=.true.
+ real :: bckgrnd_vdc_psim !< Max. PSI induced diffusivity (MacKinnon) when
+ !! horiz_varying_background=.true.
+ real :: bckgrnd_vdc_ban !< Banda Sea diffusivity (Gordon) when
+ !! horiz_varying_background=.true.
+ real :: Kd_min !< minimum diapycnal diffusivity (Z2/s)
+ real :: Kd !< interior diapycnal diffusivity (Z2/s)
real :: N0_2Omega !< ratio of the typical Buoyancy frequency to
!! twice the Earth's rotation period, used with the
!! Henyey scaling from the mixing
@@ -52,16 +59,17 @@ module MOM_bkgnd_mixing
real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of
!! diffusivities with Kd_tanh_lat_fn. Valid values
!! are in the range of -2 to 2; 0.4 reproduces CM2M.
- real :: Kdml !< mixed layer diapycnal diffusivity (m2/s)
+ real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s)
!! when bulkmixedlayer==.false.
- real :: Hmix !< mixed layer thickness (meter) when
- !! bulkmixedlayer==.false.
+ real :: Hmix !< mixed layer thickness (Z) when bulkmixedlayer==.false.
logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on
!! latitude, like GFDL CM2.1/CM2M. There is no
!! physical justification for this form, and it can
!! not be used with Henyey_IGW_background.
logical :: Bryan_Lewis_diffusivity!< If true, background vertical diffusivity
!! uses Bryan-Lewis (1979) like tanh profile.
+ logical :: horiz_varying_background !< If true, apply vertically uniform, latitude-dependent
+ !! background diffusivity, as described in Danabasoglu et al., 2012
logical :: Henyey_IGW_background !< If true, use a simplified variant of the
!! Henyey et al, JGR (1986) latitudinal scaling for the background diapycnal diffusivity,
!! which gives a marked decrease in the diffusivity near the equator. The simplification
@@ -83,13 +91,16 @@ module MOM_bkgnd_mixing
logical :: bulkmixedlayer !< If true, a refined bulk mixed layer scheme is used
logical :: debug !< If true, turn on debugging in this module
! Daignostic handles and pointers
- type(diag_ctrl), pointer :: diag => NULL()
- integer :: id_kd_bkgnd = -1, id_kv_bkgnd = -1
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that regulates diagnostic output
+ integer :: id_kd_bkgnd = -1 !< Diagnotic IDs
+ integer :: id_kv_bkgnd = -1 !< Diagnostic IDs
- real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (m2/s)
+ real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (Z2/s)
! Diagnostics arrays
- real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (m2/s)
- real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (m2/s)
+ real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (Z2/s)
+ real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (Z2/s)
+
+ character(len=40) :: bkgnd_scheme_str = "none" !< Background scheme identifier
end type bkgnd_mixing_cs
@@ -105,9 +116,12 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS)
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure.
type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure.
- type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure.
+ type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure.
! Local variables
+ real :: Kv ! The interior vertical viscosity (m2/s) - read to set prandtl
+ ! number unless it is provided as a parameter
+ real :: prandtl_bkgnd_comp ! Kv/CS%Kd. Gets compared with user-specified prandtl_bkgnd.
! This include declares and sets the variable "version".
#include "version_variable.h"
@@ -126,11 +140,16 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS)
call get_param(param_file, mdl, "KD", CS%Kd, &
"The background diapycnal diffusivity of density in the \n"//&
"interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//&
- "may be used.", units="m2 s-1", fail_if_missing=.true.)
+ "may be used.", units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.)
+
+ call get_param(param_file, mdl, "KV", Kv, &
+ "The background kinematic viscosity in the interior. \n"//&
+ "The molecular value, ~1e-6 m2 s-1, may be used.", &
+ units="m2 s-1", fail_if_missing=.true.)
call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, &
"The minimum diapycnal diffusivity.", &
- units="m2 s-1", default=0.01*CS%Kd)
+ units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2)
! The following is needed to set one of the choices of vertical background mixing
@@ -150,20 +169,15 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS)
"If BULKMIXEDLAYER is false, KDML is the elevated \n"//&
"diapycnal diffusivity in the topmost HMIX of fluid. \n"//&
"KDML is only used if BULKMIXEDLAYER is false.", &
- units="m2 s-1", default=CS%Kd)
+ units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2)
call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, &
"The prescribed depth over which the near-surface \n"//&
"viscosity and diffusivity are elevated when the bulk \n"//&
- "mixed layer is not used.", units="m", fail_if_missing=.true.)
+ "mixed layer is not used.", units="m", scale=GV%m_to_Z, fail_if_missing=.true.)
endif
call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.)
- call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, &
- "Turbulent Prandtl number used to convert vertical \n"//&
- "background diffusivities into viscosities.", &
- units="nondim", default=1.0)
-
! call openParameterBlock(param_file,'MOM_BACKGROUND_MIXING')
call get_param(param_file, mdl, "BRYAN_LEWIS_DIFFUSIVITY", &
@@ -173,6 +187,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS)
"This is done via CVMix.", default=.false.)
if (CS%Bryan_Lewis_diffusivity) then
+ call check_bkgnd_scheme(CS, "BRYAN_LEWIS_DIFFUSIVITY")
call get_param(param_file, mdl, "BRYAN_LEWIS_C1", &
CS%Bryan_Lewis_c1, &
@@ -196,21 +211,74 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS)
endif ! CS%Bryan_Lewis_diffusivity
+ call get_param(param_file, mdl, "HORIZ_VARYING_BACKGROUND", &
+ CS%horiz_varying_background, &
+ "If true, apply vertically uniform, latitude-dependent background\n"//&
+ "diffusivity, as described in Danabasoglu et al., 2012", &
+ default=.false.)
+
+ if (CS%horiz_varying_background) then
+ call check_bkgnd_scheme(CS, "HORIZ_VARYING_BACKGROUND")
+
+ call get_param(param_file, mdl, "BCKGRND_VDC1", &
+ CS%bckgrnd_vdc1, &
+ "Background diffusivity (Ledwell) when HORIZ_VARYING_BACKGROUND=True", &
+ units="m2 s-1",default = 0.16e-04, scale=GV%m_to_Z**2)
+
+ call get_param(param_file, mdl, "BCKGRND_VDC_EQ", &
+ CS%bckgrnd_vdc_eq, &
+ "Equatorial diffusivity (Gregg) when HORIZ_VARYING_BACKGROUND=True", &
+ units="m2 s-1",default = 0.01e-04, scale=GV%m_to_Z**2)
+
+ call get_param(param_file, mdl, "BCKGRND_VDC_PSIM", &
+ CS%bckgrnd_vdc_psim, &
+ "Max. PSI induced diffusivity (MacKinnon) when HORIZ_VARYING_BACKGROUND=True", &
+ units="m2 s-1",default = 0.13e-4, scale=GV%m_to_Z**2)
+
+ call get_param(param_file, mdl, "BCKGRND_VDC_BAN", &
+ CS%bckgrnd_vdc_ban, &
+ "Banda Sea diffusivity (Gordon) when HORIZ_VARYING_BACKGROUND=True", &
+ units="m2 s-1",default = 1.0e-4, scale=GV%m_to_Z**2)
+ endif
+
+ call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, &
+ "Turbulent Prandtl number used to convert vertical \n"//&
+ "background diffusivities into viscosities.", &
+ units="nondim", default=1.0)
+
+ if (CS%Bryan_Lewis_diffusivity .or. CS%horiz_varying_background) then
+
+ prandtl_bkgnd_comp = CS%prandtl_bkgnd
+ if (CS%Kd /= 0.0) prandtl_bkgnd_comp = Kv/CS%Kd
+
+ if ( abs(CS%prandtl_bkgnd - prandtl_bkgnd_comp)>1.e-14) then
+ call MOM_error(FATAL,"set_diffusivity_init: The provided KD, KV,"//&
+ "and PRANDTL_BKGND values are incompatible. The following "//&
+ "must hold: KD*PRANDTL_BKGND==KV")
+ endif
+
+ endif
+
call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND", &
CS%Henyey_IGW_background, &
"If true, use a latitude-dependent scaling for the near \n"//&
"surface background diffusivity, as described in \n"//&
"Harrison & Hallberg, JPO 2008.", default=.false.)
+ if (CS%Henyey_IGW_background) call check_bkgnd_scheme(CS, "HENYEY_IGW_BACKGROUND")
+
call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND_NEW", &
CS%Henyey_IGW_background_new, &
"If true, use a better latitude-dependent scaling for the\n"//&
"background diffusivity, as described in \n"//&
"Harrison & Hallberg, JPO 2008.", default=.false.)
+ if (CS%Henyey_IGW_background_new) call check_bkgnd_scheme(CS, "HENYEY_IGW_BACKGROUND_NEW")
- if (CS%Henyey_IGW_background .and. CS%Henyey_IGW_background_new) &
- call MOM_error(FATAL, "set_diffusivity_init: HENYEY_IGW_BACKGROUND and \n"//&
- "HENYEY_IGW_BACKGROUND_NEW are mutually exclusive. Set only one or none.")
+ if (CS%Kd>0.0 .and. (trim(CS%bkgnd_scheme_str)=="BRYAN_LEWIS_DIFFUSIVITY" .or.&
+ trim(CS%bkgnd_scheme_str)=="HORIZ_VARYING_BACKGROUND" )) then
+ call MOM_error(WARNING, "set_diffusivity_init: a nonzero constant background "//&
+ "diffusivity (KD) is specified along with "//trim(CS%bkgnd_scheme_str))
+ endif
if (CS%Henyey_IGW_background) &
call get_param(param_file, mdl, "HENYEY_N0_2OMEGA", CS%N0_2Omega, &
@@ -245,18 +313,19 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS)
! Register diagnostics
CS%diag => diag
CS%id_kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, &
- 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s')
+ 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%Z_to_m**2)
CS%id_kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, &
- 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s')
+ 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%Z_to_m**2)
end subroutine bkgnd_mixing_init
!> Get surface vertical background diffusivities/viscosities.
-subroutine sfc_bkgnd_mixing(G, CS)
+subroutine sfc_bkgnd_mixing(G, GV, CS)
- type(ocean_grid_type), intent(in) :: G !< Grid structure.
- type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by
- !! a previous call to bkgnd_mixing_init.
+ type(ocean_grid_type), intent(in) :: G !< Grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure.
+ type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by
+ !! a previous call to bkgnd_mixing_init.
! local variables
real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg)))
real :: deg_to_rad !< factor converting degrees to radians, pi/180.
@@ -271,7 +340,7 @@ subroutine sfc_bkgnd_mixing(G, CS)
epsilon = 1.e-10
- if (.not. CS%Bryan_Lewis_diffusivity) then
+ if (.not. (CS%Bryan_Lewis_diffusivity .or. CS%horiz_varying_background)) then
!$OMP parallel do default(none) shared(is,ie,js,je,CS)
do j=js,je ; do i=is,ie
CS%Kd_sfc(i,j) = CS%Kd
@@ -299,33 +368,34 @@ subroutine sfc_bkgnd_mixing(G, CS)
enddo ; enddo
endif
- if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0)
+ if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=GV%Z_to_m**2)
end subroutine sfc_bkgnd_mixing
!> Calculates the vertical background diffusivities/viscosities
-subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS)
+subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS)
- type(ocean_grid_type), intent(in) :: G !< Grid structure.
- type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2.
- type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure.
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay!< squared buoyancy frequency associated
+ type(ocean_grid_type), intent(in) :: G !< Grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2.
+ type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure.
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated
!! with layers (1/s2)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay!< Diapycnal diffusivity of each layer m2 s-1.
- real, dimension(:,:,:), pointer :: kv !< The "slow" vertical viscosity at each interface
- !! (not layer!) in m2 s-1.
- integer, intent(in) :: j !< Meridional grid indice.
- type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer Z2 s-1.
+ real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface
+ !! (not layer!) in Z2 s-1
+ integer, intent(in) :: j !< Meridional grid index
+ type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by
!! a previous call to bkgnd_mixing_init.
! local variables
- real, dimension(SZI_(G), SZK_(G)+1) :: depth_2d !< distance from surface of an interface (m)
- real, dimension(SZI_(G)) :: &
- depth !< distance from surface of an interface (meter)
- real :: depth_c !< depth of the center of a layer (meter)
- real :: I_Hmix !< inverse of fixed mixed layer thickness (1/m)
+ real, dimension(SZK_(G)+1) :: depth_int !< distance from surface of the interfaces (m)
+ real, dimension(SZK_(G)+1) :: Kd_col !< Diffusivities at the interfaces (m2 s-1)
+ real, dimension(SZK_(G)+1) :: Kv_col !< Viscosities at the interfaces (m2 s-1)
+ real, dimension(SZI_(G)) :: depth !< distance from surface of an interface (Z)
+ real :: depth_c !< depth of the center of a layer (Z)
+ real :: I_Hmix !< inverse of fixed mixed layer thickness (1/Z)
real :: I_2Omega !< 1/(2 Omega) (sec)
real :: N_2Omega
real :: N02_N2
@@ -333,6 +403,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS)
real :: deg_to_rad !< factor converting degrees to radians, pi/180.
real :: abs_sin !< absolute value of sine of latitude (nondim)
real :: epsilon
+ real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere
+ real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere
integer :: i, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
@@ -341,88 +413,133 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS)
deg_to_rad = atan(1.0)/45.0 ! = PI/180
epsilon = 1.e-10
- depth_2d(:,:) = 0.0
! Set up the background diffusivity.
if (CS%Bryan_Lewis_diffusivity) then
do i=is,ie
+ depth_int(1) = 0.0
do k=2,nz+1
- depth_2d(i,k) = depth_2d(i,k-1) + GV%H_to_m*h(i,j,k-1)
+ depth_int(k) = depth_int(k-1) + GV%H_to_m*h(i,j,k-1)
enddo
- ! if (is_root_pe()) write(*,*)'depth_3d(i,j,:)',depth_3d(i,j,:)
call CVMix_init_bkgnd(max_nlev=nz, &
- zw = depth_2d(i,:), & !< interface depth, must bepositive.
+ zw = depth_int(:), & !< interface depths relative to the surface in m, must be positive.
bl1 = CS%Bryan_Lewis_c1, &
bl2 = CS%Bryan_Lewis_c2, &
bl3 = CS%Bryan_Lewis_c3, &
bl4 = CS%Bryan_Lewis_c4, &
prandtl = CS%prandtl_bkgnd)
- call CVMix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), &
- Tdiff_out=CS%kd_bkgnd(i,j,:), &
- nlev=nz, &
- max_nlev=nz)
+ Kd_col(:) = 0.0 ; Kv_col(:) = 0.0 ! Is this line necessary?
+ call CVMix_coeffs_bkgnd(Mdiff_out=Kv_col, Tdiff_out=Kd_col, nlev=nz, max_nlev=nz)
- ! Update Kd
+ ! Update Kd and Kv.
+ do K=1,nz+1
+ CS%Kv_bkgnd(i,j,K) = GV%m_to_Z**2*Kv_col(K)
+ CS%Kd_bkgnd(i,j,K) = GV%m_to_Z**2*Kd_col(K)
+ enddo
do k=1,nz
- kd_lay(i,j,k) = kd_lay(i,j,k) + 0.5*(CS%kd_bkgnd(i,j,K) + CS%kd_bkgnd(i,j,K+1))
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_col(K) + Kd_col(K+1))
enddo
enddo ! i loop
elseif ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. &
- (CS%Kd/= CS%Kdml)) then
+ (.not. CS%horiz_varying_background) .and. (CS%Kd /= CS%Kdml)) then
I_Hmix = 1.0 / CS%Hmix
do i=is,ie ; depth(i) = 0.0 ; enddo
do k=1,nz ; do i=is,ie
- depth_c = depth(i) + 0.5*GV%H_to_m*h(i,j,k)
- if (depth_c <= CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kdml
- elseif (depth_c >= 2.0*CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j)
+ depth_c = depth(i) + 0.5*GV%H_to_Z*h(i,j,k)
+ if (depth_c <= CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kdml
+ elseif (depth_c >= 2.0*CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j)
else
- kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + &
- (2.0*CS%Kdml - CS%Kd_sfc(i,j))
+ Kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + &
+ (2.0*CS%Kdml - CS%Kd_sfc(i,j))
endif
- depth(i) = depth(i) + GV%H_to_m*h(i,j,k)
+ depth(i) = depth(i) + GV%H_to_Z*h(i,j,k)
enddo ; enddo
+ elseif (CS%horiz_varying_background) then
+ do i=is,ie
+ bckgrnd_vdc_psis= CS%bckgrnd_vdc_psim*exp(-(0.4*(G%geoLatT(i,j)+28.9))**2.0)
+ bckgrnd_vdc_psin= CS%bckgrnd_vdc_psim*exp(-(0.4*(G%geoLatT(i,j)-28.9))**2.0)
+ CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_eq + bckgrnd_vdc_psin + bckgrnd_vdc_psis
+
+ if (G%geoLatT(i,j) < -10.0) then
+ CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1
+ elseif (G%geoLatT(i,j) <= 10.0) then
+ CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 * (G%geoLatT(i,j)/10.0)**2.0
+ else
+ CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1
+ endif
+
+ ! North Banda Sea
+ if ( (G%geoLatT(i,j) < -1.0) .and. (G%geoLatT(i,j) > -4.0) .and. &
+ ( mod(G%geoLonT(i,j)+360.0,360.0) > 103.0) .and. &
+ ( mod(G%geoLonT(i,j)+360.0,360.0) < 134.0) ) then
+ CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban
+ endif
+
+ ! Middle Banda Sea
+ if ( (G%geoLatT(i,j) <= -4.0) .and. (G%geoLatT(i,j) > -7.0) .and. &
+ ( mod(G%geoLonT(i,j)+360.0,360.0) > 106.0) .and. &
+ ( mod(G%geoLonT(i,j)+360.0,360.0) < 140.0) ) then
+ CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban
+ endif
+
+ ! South Banda Sea
+ if ( (G%geoLatT(i,j) <= -7.0) .and. (G%geoLatT(i,j) > -8.3) .and. &
+ ( mod(G%geoLonT(i,j)+360.0,360.0) > 111.0) .and. &
+ ( mod(G%geoLonT(i,j)+360.0,360.0) < 142.0) ) then
+ CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban
+ endif
+
+ ! Compute kv_bkgnd
+ CS%kv_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) * CS%prandtl_bkgnd
+
+ ! Update Kd (uniform profile; no interpolation needed)
+ kd_lay(i,j,:) = CS%kd_bkgnd(i,j,1)
+
+ enddo
+
elseif (CS%Henyey_IGW_background_new) then
I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg.
do k=1,nz ; do i=is,ie
abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad)))
N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega)
N02_N2 = (CS%N0_2Omega/N_2Omega)**2
- kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * &
+ Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * &
((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2)
enddo ; enddo
else
do k=1,nz ; do i=is,ie
- kd_lay(i,j,k) = CS%Kd_sfc(i,j)
+ Kd_lay(i,j,k) = CS%Kd_sfc(i,j)
enddo ; enddo
endif
! Update CS%kd_bkgnd and CS%kv_bkgnd for diagnostic purposes
- if (.not. CS%Bryan_Lewis_diffusivity) then
+ if (.not. (CS%Bryan_Lewis_diffusivity .or. CS%horiz_varying_background)) then
do i=is,ie
CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0
CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0
do k=2,nz
- CS%kd_bkgnd(i,j,k) = 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K))
- CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd
+ CS%Kd_bkgnd(i,j,k) = 0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K))
+ CS%Kv_bkgnd(i,j,k) = CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd
enddo
enddo
endif
- ! Update kv
+ ! Update Kv
if (associated(kv)) then
- do i=is,ie
- do k=1,nz+1
- kv(i,j,k) = kv(i,j,k) + CS%kv_bkgnd(i,j,k)
- enddo
- enddo
+ do k=1,nz+1 ; do i=is,ie
+ Kv(i,j,k) = Kv(i,j,k) + CS%Kv_bkgnd(i,j,k)
+ enddo ; enddo
endif
+ ! TODO: In both CS%Bryan_Lewis_diffusivity and CS%horiz_varying_background, KV and KD at surface
+ ! and bottom interfaces are set to be nonzero. Make sure this is not problematic.
+
end subroutine calculate_bkgnd_mixing
!> Reads the parameter "USE_CVMix_BACKGROUND" and returns state.
@@ -435,9 +552,28 @@ logical function CVMix_bkgnd_is_used(param_file)
end function CVMix_bkgnd_is_used
+!> Sets CS%bkgnd_scheme_str to check whether multiple background diffusivity schemes are activated.
+!! The string is also for error/log messages.
+subroutine check_bkgnd_scheme(CS,str)
+ type(bkgnd_mixing_cs), pointer :: CS !< Control structure
+ character(len=*), intent(in) :: str !< Background scheme identifier deducted from MOM_input
+ !! parameters
+
+ if (trim(CS%bkgnd_scheme_str)=="none") then
+ CS%bkgnd_scheme_str = str
+ else
+ call MOM_error(FATAL, "set_diffusivity_init: Cannot activate both "//trim(str)//" and "//&
+ trim(CS%bkgnd_scheme_str)//".")
+ endif
+
+end subroutine
+
!> Clear pointers and dealocate memory
subroutine bkgnd_mixing_end(CS)
- type(bkgnd_mixing_cs), pointer :: CS ! Control structure
+ type(bkgnd_mixing_cs), pointer :: CS !< Control structure for this module that
+ !! will be deallocated in this subroutine
+
+ if (.not. associated(CS)) return
deallocate(CS%kd_bkgnd)
deallocate(CS%kv_bkgnd)
diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90
index 7eafb011bd..eb7dae1590 100644
--- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90
+++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90
@@ -1,41 +1,8 @@
+!> Build mixed layer parameterization
module MOM_bulk_mixed_layer
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, 1997 - 2005. *
-!* *
-!* This file contains the subroutine (bulkmixedlayer) that *
-!* implements a Kraus-Turner-like bulk mixed layer, based on the work *
-!* of various people, as described in the review paper by Niiler and *
-!* Kraus (1979), with particular attention to the form proposed by *
-!* Oberhuber (JPO, 1993, 808-829), with an extension to a refied bulk *
-!* mixed layer as described in Hallberg (Aha Huliko'a, 2003). The *
-!* physical processes portrayed in this subroutine include convective *
-!* adjustment and mixed layer entrainment and detrainment. *
-!* Penetrating shortwave radiation and an exponential decay of TKE *
-!* fluxes are also supported by this subroutine. Several constants *
-!* can alternately be set to give a traditional Kraus-Turner mixed *
-!* layer scheme, although that is not the preferred option. The *
-!* physical processes and arguments are described in detail below. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, buoy, T, S, eaml, ebml, etc. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc
use MOM_diag_mediator, only : time_type, diag_ctrl, diag_update_remap_grids
@@ -55,123 +22,119 @@ module MOM_bulk_mixed_layer
public bulkmixedlayer, bulkmixedlayer_init
+!> The control structure with parameters for the MOM_bulk_mixed_layer module
type, public :: bulkmixedlayer_CS ; private
- integer :: nkml ! The number of layers in the mixed layer.
- integer :: nkbl ! The number of buffer layers.
- integer :: nsw ! The number of bands of penetrating shortwave radiation.
- real :: mstar ! The ratio of the friction velocity cubed to the
- ! TKE input to the mixed layer, nondimensional.
- real :: nstar ! The fraction of the TKE input to the mixed layer
- ! available to drive entrainment, nondim.
- real :: nstar2 ! The fraction of potential energy released by
- ! convective adjustment that drives entrainment, ND.
- logical :: absorb_all_SW ! If true, all shortwave radiation is absorbed by the
- ! ocean, instead of passing through to the bottom mud.
- real :: TKE_decay ! The ratio of the natural Ekman depth to the TKE
- ! decay scale, nondimensional.
- real :: bulk_Ri_ML ! The efficiency with which mean kinetic energy
- ! released by mechanically forced entrainment of
- ! the mixed layer is converted to TKE, nondim.
- real :: bulk_Ri_convective ! The efficiency with which convectively
- ! released mean kinetic energy becomes TKE, nondim.
- real :: Hmix_min ! The minimum mixed layer thickness in m.
- real :: H_limit_fluxes ! When the total ocean depth is less than this
- ! value, in m, scale away all surface forcing to
- ! avoid boiling the ocean.
- real :: ustar_min ! A minimum value of ustar to avoid numerical
- ! problems, in m s-1. If the value is small enough,
- ! this should not affect the solution.
- real :: omega ! The Earth's rotation rate, in s-1.
- real :: dT_dS_wt ! When forced to extrapolate T & S to match the
- ! layer densities, this factor (in deg C / PSU) is
- ! combined with the derivatives of density with T & S
- ! to determines what direction is orthogonal to
- ! density contours. It should be a typical value of
- ! (dR/dS) / (dR/dT) in oceanic profiles.
- ! 6 K psu-1 might be reasonable.
- real :: BL_extrap_lim ! A limit on the density range over which
- ! extrapolation can occur when detraining from the
- ! buffer layers, relative to the density range
- ! within the mixed and buffer layers, when the
- ! detrainment is going into the lightest interior
- ! layer, nondimensional.
- logical :: ML_resort ! If true, resort the layers by density, rather than
- ! doing convective adjustment.
- integer :: ML_presort_nz_conv_adj ! If ML_resort is true, do convective
- ! adjustment on this many layers (starting from the
- ! top) before sorting the remaining layers.
- real :: omega_frac ! When setting the decay scale for turbulence, use
- ! this fraction of the absolute rotation rate blended
- ! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).
- logical :: correct_absorption ! If true, the depth at which penetrating
- ! shortwave radiation is absorbed is corrected by
- ! moving some of the heating upward in the water
- ! column. The default is false.
- logical :: Resolve_Ekman ! If true, the nkml layers in the mixed layer are
- ! chosen to optimally represent the impact of the
- ! Ekman transport on the mixed layer TKE budget.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- logical :: TKE_diagnostics = .false.
- logical :: do_rivermix = .false. ! Provide additional TKE to mix river runoff
- ! at the river mouths to "rivermix_depth" meters
- real :: rivermix_depth = 0.0 ! Used if "do_rivermix" = T
- logical :: limit_det ! If true, limit the extent of buffer layer
- ! detrainment to be consistent with neighbors.
- real :: lim_det_dH_sfc ! The fractional limit in the change between grid
- ! points of the surface region (mixed & buffer
- ! layer) thickness, nondim. 0.5 by default.
- real :: lim_det_dH_bathy ! The fraction of the total depth by which the
- ! thickness of the surface region (mixed & buffer
- ! layer) is allowed to change between grid points.
- ! Nondimensional, 0.2 by default.
- logical :: use_river_heat_content ! If true, use the fluxes%runoff_Hflx field
- ! to set the heat carried by runoff, instead of
- ! using SST for temperature of liq_runoff
- logical :: use_calving_heat_content ! Use SST for temperature of froz_runoff
- logical :: salt_reject_below_ML ! It true, add salt below mixed layer (layer mode only)
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- real :: Allowed_T_chg ! The amount by which temperature is allowed
- ! to exceed previous values during detrainment, K.
- real :: Allowed_S_chg ! The amount by which salinity is allowed
- ! to exceed previous values during detrainment, PSU.
-
-! These are terms in the mixed layer TKE budget, all in m3 s-2.
+ integer :: nkml !< The number of layers in the mixed layer.
+ integer :: nkbl !< The number of buffer layers.
+ integer :: nsw !< The number of bands of penetrating shortwave radiation.
+ real :: mstar !< The ratio of the friction velocity cubed to the
+ !! TKE input to the mixed layer, nondimensional.
+ real :: nstar !< The fraction of the TKE input to the mixed layer
+ !! available to drive entrainment, nondim.
+ real :: nstar2 !< The fraction of potential energy released by
+ !! convective adjustment that drives entrainment, ND.
+ logical :: absorb_all_SW !< If true, all shortwave radiation is absorbed by the
+ !! ocean, instead of passing through to the bottom mud.
+ real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE
+ !! decay scale, nondimensional.
+ real :: bulk_Ri_ML !< The efficiency with which mean kinetic energy
+ !! released by mechanically forced entrainment of
+ !! the mixed layer is converted to TKE, nondim.
+ real :: bulk_Ri_convective !< The efficiency with which convectively
+ !! released mean kinetic energy becomes TKE, nondim.
+ real :: Hmix_min !< The minimum mixed layer thickness in H.
+ real :: H_limit_fluxes !< When the total ocean depth is less than this
+ !! value, in H, scale away all surface forcing to
+ !! avoid boiling the ocean.
+ real :: ustar_min !< A minimum value of ustar to avoid numerical problems,
+ !! in Z s-1. If the value is small enough, this should
+ !! not affect the solution.
+ real :: omega !< The Earth's rotation rate, in s-1.
+ real :: dT_dS_wt !< When forced to extrapolate T & S to match the
+ !! layer densities, this factor (in deg C / PSU) is
+ !! combined with the derivatives of density with T & S
+ !! to determines what direction is orthogonal to
+ !! density contours. It should be a typical value of
+ !! (dR/dS) / (dR/dT) in oceanic profiles.
+ !! 6 K psu-1 might be reasonable.
+ real :: BL_extrap_lim !< A limit on the density range over which
+ !! extrapolation can occur when detraining from the
+ !! buffer layers, relative to the density range
+ !! within the mixed and buffer layers, when the
+ !! detrainment is going into the lightest interior
+ !! layer, nondimensional.
+ logical :: ML_resort !< If true, resort the layers by density, rather than
+ !! doing convective adjustment.
+ integer :: ML_presort_nz_conv_adj !< If ML_resort is true, do convective
+ !! adjustment on this many layers (starting from the
+ !! top) before sorting the remaining layers.
+ real :: omega_frac !< When setting the decay scale for turbulence, use
+ !! this fraction of the absolute rotation rate blended
+ !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).
+ logical :: correct_absorption !< If true, the depth at which penetrating
+ !! shortwave radiation is absorbed is corrected by
+ !! moving some of the heating upward in the water
+ !! column. The default is false.
+ logical :: Resolve_Ekman !< If true, the nkml layers in the mixed layer are
+ !! chosen to optimally represent the impact of the
+ !! Ekman transport on the mixed layer TKE budget.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ logical :: TKE_diagnostics = .false. !< If true, calculate extensive diagnostics of the TKE budget
+ logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff
+ !! at the river mouths to rivermix_depth
+ real :: rivermix_depth = 0.0 !< The depth of mixing if do_rivermix is true, in Z.
+ logical :: limit_det !< If true, limit the extent of buffer layer
+ !! detrainment to be consistent with neighbors.
+ real :: lim_det_dH_sfc !< The fractional limit in the change between grid
+ !! points of the surface region (mixed & buffer
+ !! layer) thickness, nondim. 0.5 by default.
+ real :: lim_det_dH_bathy !< The fraction of the total depth by which the
+ !! thickness of the surface region (mixed & buffer
+ !! layer) is allowed to change between grid points.
+ !! Nondimensional, 0.2 by default.
+ logical :: use_river_heat_content !< If true, use the fluxes%runoff_Hflx field
+ !! to set the heat carried by runoff, instead of
+ !! using SST for temperature of liq_runoff
+ logical :: use_calving_heat_content !< Use SST for temperature of froz_runoff
+ logical :: salt_reject_below_ML !< It true, add salt below mixed layer (layer mode only)
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the
+ !! timing of diagnostic output.
+ real :: Allowed_T_chg !< The amount by which temperature is allowed
+ !! to exceed previous values during detrainment, K.
+ real :: Allowed_S_chg !< The amount by which salinity is allowed
+ !! to exceed previous values during detrainment, PSU.
+
+ ! These are terms in the mixed layer TKE budget, all in Z m2 s-3.
real, allocatable, dimension(:,:) :: &
- ML_depth, & ! The mixed layer depth in m.
- diag_TKE_wind, & ! The wind source of TKE.
- diag_TKE_RiBulk, & ! The resolved KE source of TKE.
- diag_TKE_conv, & ! The convective source of TKE.
- diag_TKE_pen_SW, & ! The TKE sink required to mix
- ! penetrating shortwave heating.
- diag_TKE_mech_decay, & ! The decay of mechanical TKE.
- diag_TKE_conv_decay, & ! The decay of convective TKE.
- diag_TKE_mixing, & ! The work done by TKE to deepen
- ! the mixed layer.
- diag_TKE_conv_s2, &! The convective source of TKE due to
- ! to mixing in sigma2.
- diag_PE_detrain, & ! The spurious source of potential
- ! energy due to mixed layer
- ! detrainment, W m-2.
- diag_PE_detrain2 ! The spurious source of potential
- ! energy due to mixed layer only
- ! detrainment, W m-2.
- logical :: allow_clocks_in_omp_loops ! If true, clocks can be called
- ! from inside loops that can be threaded.
- ! To run with multiple threads, set to False.
- type(group_pass_type) :: pass_h_sum_hmbl_prev ! For group halo pass
+ ML_depth, & !< The mixed layer depth in H.
+ diag_TKE_wind, & !< The wind source of TKE.
+ diag_TKE_RiBulk, & !< The resolved KE source of TKE.
+ diag_TKE_conv, & !< The convective source of TKE.
+ diag_TKE_pen_SW, & !< The TKE sink required to mix penetrating shortwave heating.
+ diag_TKE_mech_decay, & !< The decay of mechanical TKE.
+ diag_TKE_conv_decay, & !< The decay of convective TKE.
+ diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer.
+ diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2.
+ diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W Z m-3.
+ diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W Z m-3.
+ logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can
+ !! be threaded. To run with multiple threads, set to False.
+ type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass
+
+ !>@{ Diagnostic IDs
integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1
integer :: id_TKE_RiBulk = -1, id_TKE_conv = -1, id_TKE_pen_SW = -1
integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1, id_TKE_conv_s2 = -1
integer :: id_PE_detrain = -1, id_PE_detrain2 = -1, id_h_mismatch = -1
integer :: id_Hsfc_used = -1, id_Hsfc_max = -1, id_Hsfc_min = -1
+ !!@}
end type bulkmixedlayer_CS
+!>@{ CPU clock IDs
integer :: id_clock_detrain=0, id_clock_mech=0, id_clock_conv=0, id_clock_adjustment=0
integer :: id_clock_EOS=0, id_clock_resort=0, id_clock_pass=0
-
-integer :: num_msg = 0, max_msg = 2
+!!@}
contains
@@ -241,12 +204,15 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
type(optics_type), pointer :: optics !< The structure containing the inverse of the
!! vertical absorption decay scale for
!! penetrating shortwave radiation, in m-1.
- real, dimension(:,:), pointer :: Hml !< active mixed layer depth
- logical, intent(in) :: aggregate_FW_forcing
- real, optional, intent(in) :: dt_diag !< The diagnostic time step,
+ real, dimension(:,:), pointer :: Hml !< Active mixed layer depth, in m.
+ logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and
+ !! outgoing surface freshwater fluxes are
+ !! combined before being applied, instead of
+ !! being applied separately.
+ real, optional, intent(in) :: dt_diag !< The diagnostic time step,
!! which may be less than dt if there are
!! two callse to mixedlayer, in s.
- logical, optional, intent(in) :: last_call !< if true, this is the last call
+ logical, optional, intent(in) :: last_call !< if true, this is the last call
!! to mixedlayer in the current time step, so
!! diagnostics will be written. The default is
!! .true.
@@ -320,7 +286,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
! new, sorted index space. Here layer 0 is an initially massless layer that
! will be used to hold the new mixed layer properties.
real, dimension(SZI_(G),SZK0_(GV)) :: &
- h, & ! The layer thickness, in m or kg m-2.
+ h, & ! The layer thickness, in H (often m or kg m-2).
T, & ! The layer temperatures, in deg C.
S, & ! The layer salinities, in psu.
R0, & ! The potential density referenced to the surface, in kg m-3.
@@ -328,7 +294,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
real, dimension(SZI_(G),SZK_(GV)) :: &
u, & ! The zonal velocity, in m s-1.
v, & ! The meridional velocity, in m s-1.
- h_orig, & ! The original thickness in m or kg m-2.
+ h_orig, & ! The original thickness in H (often m or kg m-2).
d_eb, & ! The downward increase across a layer in the entrainment from
! below, in H. The sign convention is that positive values of
! d_eb correspond to a gain in mass by a layer by upward motion.
@@ -339,12 +305,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
integer, dimension(SZI_(G),SZK_(GV)) :: &
ksort ! The sorted k-index that each original layer goes to.
real, dimension(SZI_(G),SZJ_(G)) :: &
- h_miss ! The summed absolute mismatch, in m.
+ h_miss ! The summed absolute mismatch, in Z.
real, dimension(SZI_(G)) :: &
TKE, & ! The turbulent kinetic energy available for mixing over a
- ! time step, in m3 s-2.
+ ! time step, in Z m2 s-2.
Conv_En, & ! The turbulent kinetic energy source due to mixing down to
- ! the depth of free convection, in m3 s-2.
+ ! the depth of free convection, in Z m2 s-2.
htot, & ! The total depth of the layers being considered for
! entrainment, in H.
R0_tot, & ! The integrated potential density referenced to the surface
@@ -361,7 +327,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if
! Boussinesq - i.e. the fresh water flux (P+R-E)) into the
! ocean over a time step, in H.
- NetMassOut, & ! The mass flux (if non-Boussinsq) or volume flux (if
+ NetMassOut, & ! The mass flux (if non-Boussinesq) or volume flux (if
! Boussinesq) over a time step from evaporating fresh water (H)
Net_heat, & ! The net heating at the surface over a time step in K H. Any
! penetrating shortwave radiation is not included in Net_heat.
@@ -380,7 +346,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
dRcv_dS, & ! Partial derivative of the coordinate variable potential
! density in the mixed layer with salinity, in kg m-3 psu-1.
TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a
- ! time step, in m3 s-2.
+ ! time step, in Z m2 s-2.
real, dimension(max(CS%nsw,1),SZI_(G)) :: &
Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated
@@ -388,7 +354,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
real, dimension(max(CS%nsw,1),SZI_(G),SZK_(GV)) :: &
opacity_band ! The opacity in each band, in H-1. The indicies are band, i, k.
- real :: cMKE(2,SZI_(G)) ! Coefficients of HpE and HpE^2 in calculating the
+ real :: cMKE(2,SZI_(G)) ! Coefficients of HpE and HpE^2 used in calculating the
! denominator of MKE_rate, in m-1 and m-2.
real :: Irho0 ! 1.0 / rho_0
real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1)
@@ -399,21 +365,21 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
real, dimension(SZI_(G)) :: &
dKE_FC, & ! The change in mean kinetic energy due to free convection,
- ! in m3 s-2.
+ ! in Z m2 s-2.
h_CA ! The depth to which convective adjustment has gone in H.
real, dimension(SZI_(G),SZK_(GV)) :: &
dKE_CA, & ! The change in mean kinetic energy due to convective
- ! adjustment, in m3 s-2.
+ ! adjustment, in Z m2 s-2.
cTKE ! The turbulent kinetic energy source due to convective
- ! adjustment, m3 s-2.
+ ! adjustment, Z m2 s-2.
real, dimension(SZI_(G),SZJ_(G)) :: &
Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers)
- ! after entrainment but before any buffer layer detrainment, m.
+ ! after entrainment but before any buffer layer detrainment, in Z.
Hsfc_used, & ! The thickness of the surface region after buffer layer
- ! detrainment, in units of m.
+ ! detrainment, in units of Z.
Hsfc_min, & ! The minimum thickness of the surface region based on the
! new mixed layer depth and the previous thickness of the
- ! neighboring water columns, in m.
+ ! neighboring water columns, in Z.
h_sum, & ! The total thickness of the water column, in H.
hmbl_prev ! The previous thickness of the mixed and buffer layers, in H.
real, dimension(SZI_(G)) :: &
@@ -425,16 +391,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
real :: H_nbr ! A minimum thickness based on neighboring thicknesses, in H.
real :: absf_x_H ! The absolute value of f times the mixed layer thickness,
- ! in units of m s-1.
- real :: kU_star ! Ustar times the Von Karmen constant, in m s-1.
+ ! in units of Z s-1.
+ real :: kU_star ! Ustar times the Von Karmen constant, in Z s-1.
real :: dt__diag ! A copy of dt_diag (if present) or dt, in s.
logical :: write_diags ! If true, write out diagnostics with this step.
logical :: reset_diags ! If true, zero out the accumulated diagnostics.
integer :: i, j, k, is, ie, js, je, nz, nkmb, n
integer :: nsw ! The number of bands of penetrating shortwave radiation.
- real :: H_limit_fluxes ! CS%H_limit fluxes converted to units of H.
-
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixed_layer: "//&
@@ -456,19 +420,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
Idt = 1.0 / dt
Idt_diag = 1.0 / dt__diag
write_diags = .true. ; if (present(last_call)) write_diags = last_call
- H_limit_fluxes = CS%H_limit_fluxes * GV%m_to_H
p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref
nsw = CS%nsw
if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then
-!$OMP parallel default(none) shared(is,ie,js,je,nkmb,h_sum,hmbl_prev,h_3d,nz)
-!$OMP do
+ !$OMP parallel do default(shared)
do j=js-1,je+1 ; do i=is-1,ie+1
h_sum(i,j) = 0.0 ; hmbl_prev(i,j) = 0.0
enddo ; enddo
-!$OMP do
+ !$OMP parallel do default(shared)
do j=js-1,je+1
do k=1,nkmb ; do i=is-1,ie+1
h_sum(i,j) = h_sum(i,j) + h_3d(i,j,k)
@@ -478,7 +440,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
h_sum(i,j) = h_sum(i,j) + h_3d(i,j,k)
enddo ; enddo
enddo
-!$OMP end parallel
call cpu_clock_begin(id_clock_pass)
call create_group_pass(CS%pass_h_sum_hmbl_prev, h_sum,G%Domain)
@@ -493,9 +454,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
reset_diags = .false. ! This is the second call to mixedlayer.
if (reset_diags) then
-!$OMP parallel default(none) shared(is,ie,js,je,CS)
if (CS%TKE_diagnostics) then
-!$OMP do
+ !$OMP parallel do default(shared)
do j=js,je ; do i=is,ie
CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_RiBulk(i,j) = 0.0
CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_pen_SW(i,j) = 0.0
@@ -504,18 +464,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
enddo ; enddo
endif
if (allocated(CS%diag_PE_detrain)) then
-!$OMP do
+ !$OMP parallel do default(shared)
do j=js,je ; do i=is,ie
CS%diag_PE_detrain(i,j) = 0.0
enddo ; enddo
endif
if (allocated(CS%diag_PE_detrain2)) then
-!$OMP do
+ !$OMP parallel do default(shared)
do j=js,je ; do i=is,ie
CS%diag_PE_detrain2(i,j) = 0.0
enddo ; enddo
endif
-!$OMP end parallel
endif
if (CS%ML_resort) then
@@ -537,7 +496,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
do k=1,nz ; do i=is,ie
h(i,k) = h_3d(i,j,k) ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k)
h_orig(i,k) = h_3d(i,j,k)
- eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom
+ eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom_H
T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k)
do n=1,nsw
opacity_band(n,i,k) = GV%H_to_m*optics%opacity_band(n,i,j,k)
@@ -601,7 +560,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
! rivermix_depth = The prescribed depth over which to mix river inflow
! drho_ds = The gradient of density wrt salt at the ambient surface salinity.
! Sriver = 0 (i.e. rivers are assumed to be pure freshwater)
- RmixConst = 0.5*CS%rivermix_depth*GV%g_Earth*Irho0**2
+ RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*GV%m_to_Z) * Irho0**2
do i=is,ie
TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* &
(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1))
@@ -621,7 +580,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
! net_salt = salt ( g(salt)/m2 for non-Bouss and ppt*m/s for Bouss ) via surface fluxes
! Pen_SW_bnd = components to penetrative shortwave radiation
call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, &
- H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, &
+ CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, &
h(:,1:), T(:,1:), netMassInOut, netMassOut, Net_heat, Net_salt, Pen_SW_bnd,&
tv, aggregate_FW_forcing)
@@ -655,7 +614,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, &
Idecay_len_TKE, j, ksort, G, GV, CS)
- call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, H_limit_fluxes, &
+ call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, CS%H_limit_fluxes, &
CS%correct_absorption, CS%absorb_all_SW, &
T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot)
@@ -675,10 +634,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
h(i,0) = htot(i)
endif ; enddo
if (write_diags .and. allocated(CS%ML_depth)) then ; do i=is,ie
- CS%ML_depth(i,j) = h(i,0) * GV%H_to_m
+ CS%ML_depth(i,j) = h(i,0) * GV%H_to_m ! Rescale the diagnostic.
enddo ; endif
if (associated(Hml)) then ; do i=is,ie
- Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_m)
+ Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_m) ! Rescale the diagnostic for output.
enddo ; endif
! At this point, return water to the original layers, but constrained to
@@ -712,14 +671,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
hmbl_prev(i,j-1) - dHD*min(h_sum(i,j),h_sum(i,j-1)), &
hmbl_prev(i,j+1) - dHD*min(h_sum(i,j),h_sum(i,j+1))) )
- Hsfc_min(i,j) = GV%H_to_m*max(h(i,0), min(Hsfc(i), H_nbr))
+ Hsfc_min(i,j) = GV%H_to_Z * max(h(i,0), min(Hsfc(i), H_nbr))
if (CS%limit_det) max_BL_det(i) = max(0.0, Hsfc(i)-H_nbr)
enddo
endif
if (CS%id_Hsfc_max > 0) then ; do i=is,ie
- Hsfc_max(i,j) = Hsfc(i)*GV%H_to_m
+ Hsfc_max(i,j) = GV%H_to_Z * Hsfc(i)
enddo ; endif
endif
@@ -743,9 +702,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
if (CS%id_Hsfc_used > 0) then
- do i=is,ie ; Hsfc_used(i,j) = h(i,0)*GV%H_to_m ; enddo
+ do i=is,ie ; Hsfc_used(i,j) = GV%H_to_Z * h(i,0) ; enddo
do k=CS%nkml+1,nkmb ; do i=is,ie
- Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_m
+ Hsfc_used(i,j) = Hsfc_used(i,j) + GV%H_to_Z * h(i,k)
enddo ; enddo
endif
@@ -760,20 +719,20 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
! as the third piece will then optimally describe mixed layer
! restratification. For nkml>=4 the whole strategy should be revisited.
do i=is,ie
- kU_Star = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*?
+ kU_Star = 0.41*GV%m_to_Z*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*?
if (associated(fluxes%ustar_shelf) .and. &
associated(fluxes%frac_shelf_h)) then
if (fluxes%frac_shelf_h(i,j) > 0.0) &
kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + &
- fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j))
+ fluxes%frac_shelf_h(i,j) * (0.41*GV%m_to_Z*fluxes%ustar_shelf(i,j))
endif
- absf_x_H = 0.25 * h(i,0) * &
+ absf_x_H = 0.25 * GV%m_to_Z * h(i,0) * & !### I think this should be H_to_Z -RWH
((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + &
(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J))))
! If the mixed layer vertical viscosity specification is changed in
! MOM_vert_friction.F90, this line will have to be modified accordingly.
h_3d(i,j,1) = h(i,0) / (3.0 + sqrt(absf_x_H*(absf_x_H + 2.0*kU_star) / &
- (kU_star**2)) )
+ (kU_star**2)) )
do k=2,CS%nkml
! The other layers are evenly distributed through the mixed layer.
h_3d(i,j,k) = (h(i,0)-h_3d(i,j,1)) * Inkmlm1
@@ -829,28 +788,27 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, &
if (CS%id_h_mismatch > 0) then
do i=is,ie
- h_miss(i,j) = abs(h_3d(i,j,1) - (h_orig(i,1) + &
+ h_miss(i,j) = GV%H_to_Z * abs(h_3d(i,j,1) - (h_orig(i,1) + &
(eaml(i,1) + (ebml(i,1) - eaml(i,1+1)))))
enddo
do k=2,nz-1 ; do i=is,ie
- h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,k) - (h_orig(i,k) + &
+ h_miss(i,j) = h_miss(i,j) + GV%H_to_Z * abs(h_3d(i,j,k) - (h_orig(i,k) + &
((eaml(i,k) - ebml(i,k-1)) + (ebml(i,k) - eaml(i,k+1)))))
enddo ; enddo
do i=is,ie
- h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,nz) - (h_orig(i,nz) + &
+ h_miss(i,j) = h_miss(i,j) + GV%H_to_Z * abs(h_3d(i,j,nz) - (h_orig(i,nz) + &
((eaml(i,nz) - ebml(i,nz-1)) + ebml(i,nz))))
- h_miss(i,j) = GV%H_to_m * h_miss(i,j)
enddo
endif
enddo ! j loop
+ !$OMP end parallel
! Whenever thickness changes let the diag manager know, target grids
! for vertical remapping may need to be regenerated.
! This needs to happen after the H update and before the next post_data.
call diag_update_remap_grids(CS%diag)
-!$OMP end parallel
if (write_diags) then
if (CS%id_ML_depth > 0) &
@@ -894,15 +852,14 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
dKE_CA, cTKE, j, G, GV, CS, nz_conv)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
- real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2.
- !! (Intent in/out) The units of h are
- !! referred to as H below.
+ real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in H (often m or kg m-2).
+ !! The units of h are referred to as H below.
real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocities interpolated to h
!! points, m s-1.
real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h
!! points, m s-1.
real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer temperatures, in deg C.
- real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S
+ real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities, in psu.
real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: R0 !< Potential density referenced to
!! surface pressure, in kg m-3.
real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Rcv !< The coordinate defining potential
@@ -911,13 +868,14 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
!! in the entrainment from below, in H.
!! Positive values go with mass gain by
!! a layer.
- real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps
+ real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The negligibly small amount of water
+ !! that will be left in each layer, in H.
real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in
!! kinetic energy due to convective
- !! adjustment, in m3 s-2.
+ !! adjustment, in Z m2 s-2.
real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy
!! source due to convective adjustment,
- !! in m3 s-2.
+ !! in Z m2 s-2.
integer, intent(in) :: j !< The j-index to work on.
type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module.
integer, optional, intent(in) :: nz_conv !< If present, the number of layers
@@ -928,27 +886,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
! layers and mixed layers to remove hydrostatic instabilities. Any water that
! is lighter than currently in the mixed- or buffer- layer is entrained.
-! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units
-! of h are referred to as H below.
-! (in/out) u - Zonal velocities interpolated to h points, m s-1.
-! (in/out) v - Zonal velocities interpolated to h points, m s-1.
-! (in/out) R0 - Potential density referenced to surface pressure, in kg m-3.
-! (in/out) Rcv - The coordinate defining potential density, in kg m-3.
-! (in/out) T - Layer temperatures, in deg C.
-! (in/out) S - Layer salinities, in psu.
-! (in/out) d_eb - The downward increase across a layer in the entrainment from
-! below, in H. Positive values go with mass gain by a layer.
-! (out) dKE_CA - The vertically integrated change in kinetic energy due
-! to convective adjustment, in m3 s-2.
-! (out) cTKE - The buoyant turbulent kinetic energy source due to
-! convective adjustment, in m3 s-2.
-! (in) j - The j-index to work on.
-! (in) ksort - The density-sorted k-indicies.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure for this module.
-! (in,opt) nz_conv - If present, the number of layers over which to do
-! convective adjustment (perhaps CS%nkml).
+ ! Local variables
real, dimension(SZI_(G)) :: &
htot, & ! The total depth of the layers being considered for
! entrainment, in H.
@@ -967,13 +905,13 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
h_orig_k1 ! The depth of layer k1 before convective adjustment, in H.
real :: h_ent ! The thickness from a layer that is entrained, in H.
real :: Ih ! The inverse of a thickness, in H-1.
- real :: g_H2_2Rho0 ! Half the gravitational acceleration times the
- ! square of the conversion from H to m divided
- ! by the mean density, in m6 s-2 H-2 kg-1.
+ real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of
+ ! the conversion from H to Z divided by the mean density,
+ ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS
integer :: is, ie, nz, i, k, k1, nzc, nkmb
is = G%isc ; ie = G%iec ; nz = GV%ke
- g_H2_2Rho0 = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0)
+ g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0)
nzc = nz ; if (present(nz_conv)) nzc = nz_conv
nkmb = CS%nkml+CS%nkbl
@@ -995,8 +933,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
do i=is,ie
if ((h(i,k) > eps(i,k)) .and. (R0_tot(i) > h(i,k1)*R0(i,k))) then
h_ent = h(i,k)-eps(i,k)
- cTKE(i,k1) = cTKE(i,k1) + (h_ent * g_H2_2Rho0 * &
- (R0_tot(i) - h(i,k1)*R0(i,k)) * CS%nstar2)
+ cTKE(i,k1) = cTKE(i,k1) + h_ent * g_H2_2Rho0 * &
+ (R0_tot(i) - h(i,k1)*R0(i,k)) * CS%nstar2
if (k < nkmb) then
cTKE(i,k1) = cTKE(i,k1) + cTKE(i,k)
dKE_CA(i,k1) = dKE_CA(i,k1) + dKE_CA(i,k)
@@ -1023,7 +961,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
Ih = 1.0 / h(i,k1)
R0(i,k1) = R0_tot(i) * Ih
u(i,k1) = uhtot(i) * Ih ; v(i,k1) = vhtot(i) * Ih
- dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_m * (CS%bulk_Ri_convective * &
+ dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * (CS%bulk_Ri_convective * &
(KE_orig(i) - 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2)))
Rcv(i,k1) = Rcv_tot(i) * Ih
T(i,k1) = Ttot(i) * Ih ; S(i,k1) = Stot(i) * Ih
@@ -1048,88 +986,98 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
nsw, Pen_SW_bnd, opacity_band, Conv_en, &
dKE_FC, j, ksort, G, GV, CS, tv, fluxes, dt, &
aggregate_FW_forcing)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid
- !! structure.
- real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2.
- !! (Intent in/out) The units of h are
- !! referred to as H below.
- real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a
- !! layer in the entrainment from below
- !! , in H. Positive values go with
- !! mass gain by a layer.
- real, dimension(SZI_(G)), intent(out) :: htot !< The accumulated mixed layer
- !! thickness, in H.
- real, dimension(SZI_(G)), intent(out) :: Ttot !< The depth integrated mixed layer
- !! temperature, in deg C H.
- real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer
- !! salinity, in psu H.
- real, dimension(SZI_(G)), intent(out) :: uhtot !< The depth integrated mixed layer
- !! zonal velocity, H m s-1.
- real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer
- !! meridional velocity, H m s-1.
- real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer
- !! potential density referenced to 0
- !! pressure, in kg m-2.
- real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer
- !! coordinate variable potential
- !! density, in kg m-2.
- real, dimension(SZI_(G),SZK_(GV)), intent(in) :: u, v, T, S, R0, Rcv, eps
- real, dimension(SZI_(G)), intent(in) :: dR0_dT, dRcv_dT, dR0_dS, dRcv_dS
- real, dimension(SZI_(G)), intent(in) :: netMassInOut, netMassOut
- real, dimension(SZI_(G)), intent(in) :: Net_heat, Net_salt
- integer, intent(in) :: nsw !< The number of bands of penetrating
- !! shortwave radiation.
- real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave
- !! heating at the sea surface in each
- !! penetrating band, in K H,
- !! size nsw x SZI_(G).
- real, dimension(:,:,:), intent(in) :: opacity_band
- real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic
- !! energy source due to free
- !! convection, in m3 s-2.
- real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change
- !! in kinetic energy due to free
- !! convection, in m3 s-2.
- integer, intent(in) :: j !< The j-index to work on.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(inout) :: h !< Layer thickness, in H (often m or kg m-2).
+ !! The units of h are referred to as H below.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(inout) :: d_eb !< The downward increase across a layer in the
+ !! layer in the entrainment from below, in H.
+ !! Positive values go with mass gain by a layer.
+ real, dimension(SZI_(G)), intent(out) :: htot !< The accumulated mixed layer thickness, in H.
+ real, dimension(SZI_(G)), intent(out) :: Ttot !< The depth integrated mixed layer temperature,
+ !! in deg C H.
+ real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer salinity,
+ !! in psu H.
+ real, dimension(SZI_(G)), intent(out) :: uhtot !< The depth integrated mixed layer zonal
+ !! velocity, H m s-1.
+ real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer meridional
+ !! velocity, H m s-1.
+ real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer potential
+ !! density referenced to 0 pressure, in H kg m-2.
+ real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer coordinate
+ !! variable potential density, in H kg m-2.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: u !< Zonal velocities interpolated to h points, m s-1.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: v !< Zonal velocities interpolated to h points, m s-1.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: T !< Layer temperatures, in deg C.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: S !< Layer salinities, in psu.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: R0 !< Potential density referenced to
+ !! surface pressure, in kg m-3.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: Rcv !< The coordinate defining potential
+ !! density, in kg m-3.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: eps !< The negligibly small amount of water
+ !! that will be left in each layer, in H.
+ real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to
+ !! temperature, in kg m-3 degC-1.
+ real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to
+ !! temperature, in kg m-3 degC-1.
+ real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of R0 with respect to
+ !! salinity, in kg m-3 psu-1.
+ real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of Rcv with respect to
+ !! salinity, in kg m-3 psu-1.
+ real, dimension(SZI_(G)), intent(in) :: netMassInOut !< The net mass flux (if non-Boussinesq)
+ !! or volume flux (if Boussinesq) into the ocean
+ !! within a time step in H. (I.e. P+R-E.)
+ real, dimension(SZI_(G)), intent(in) :: netMassOut !< The mass or volume flux out of the ocean
+ !! within a time step in H.
+ real, dimension(SZI_(G)), intent(in) :: Net_heat !< The net heating at the surface over a
+ !! time step in K H. Any penetrating shortwave
+ !! radiation is not included in Net_heat.
+ real, dimension(SZI_(G)), intent(in) :: Net_salt !< The net surface salt flux into the ocean
+ !! over a time step in psu H.
+ integer, intent(in) :: nsw !< The number of bands of penetrating
+ !! shortwave radiation.
+ real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave
+ !! heating at the sea surface in each
+ !! penetrating band, in K H,
+ !! size nsw x SZI_(G).
+ real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating
+ !! shortwave radiation, in H-1.
+ !! The indicies of opacity_band are band, i, k.
+ real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source
+ !! due to free convection, in Z m2 s-2.
+ real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic
+ !! energy due to free convection, in Z m2 s-2.
+ integer, intent(in) :: j !< The j-index to work on.
integer, dimension(SZI_(G),SZK_(GV)), &
- intent(in) :: ksort !< The density-sorted k-indices.
- type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this
- !! module.
- type(thermo_var_ptrs), intent(inout) :: tv
- type(forcing), intent(inout) :: fluxes
- real, intent(in) :: dt
- logical, intent(in) :: aggregate_FW_forcing
+ intent(in) :: ksort !< The density-sorted k-indices.
+ type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this
+ !! module.
+ type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any
+ !! available thermodynamic fields. Absent
+ !! fields have NULL ptrs.
+ type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any
+ !! possible forcing fields. Unused fields
+ !! have NULL ptrs.
+ real, intent(in) :: dt !< Time increment, in s.
+ logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and
+ !! outgoing surface freshwater fluxes are
+ !! combined before being applied, instead of
+ !! being applied separately.
! This subroutine causes the mixed layer to entrain to the depth of free
! convection. The depth of free convection is the shallowest depth at which the
! fluid is denser than the average of the fluid above.
-! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units
-! of h are referred to as H below.
-! (in/out) d_eb - The downward increase across a layer in the entrainment from
-! below, in H. Positive values go with mass gain by a layer.
-! (out) htot - The accumulated mixed layer thickness, in H.
-! (out) Ttot - The depth integrated mixed layer temperature, in deg C H.
-! (out) Stot - The depth integrated mixed layer salinity, in psu H.
-! (out) uhtot - The depth integrated mixed layer zonal velocity, H m s-1.
-! (out) vhtot - The integrated mixed layer meridional velocity, H m s-1.
-! (out) R0_tot - The integrated mixed layer potential density referenced
-! to 0 pressure, in kg m-2.
-! (out) Rcv_tot - The integrated mixed layer coordinate variable
-! potential density, in kg m-2.
-! (in) nsw - The number of bands of penetrating shortwave radiation.
-! (out) Pen_SW_bnd - The penetrating shortwave heating at the sea surface
-! in each penetrating band, in K H, size nsw x SZI_(G).
-! (out) Conv_en - The buoyant turbulent kinetic energy source due to
-! free convection, in m3 s-2.
-! (out) dKE_FC - The vertically integrated change in kinetic energy due
-! to free convection, in m3 s-2.
-! (in) j - The j-index to work on.
-! (in) ksort - The density-sorted k-indices.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure for this module.
+ ! Local variables
real, dimension(SZI_(G)) :: &
massOutRem, & ! Evaporation that remains to be supplied, in H.
netMassIn ! mass entering through ocean surface (H)
@@ -1151,9 +1099,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
real :: h_evap ! The thickness that is evaporated, in H.
real :: dh_Newt ! The Newton's method estimate of the change in
! h_ent between iterations, in H.
- real :: g_H2_2Rho0 ! Half the gravitational acceleration times the
- ! square of the conversion from H to m divided
- ! by the mean density, in m6 s-2 H-2 kg-1.
+ real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of
+ ! the conversion from H to Z divided by the mean density,
+ ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS
real :: Angstrom ! The minimum layer thickness, in H.
real :: opacity ! The opacity converted to units of H-1.
real :: sum_Pen_En ! The potential energy change due to penetrating
@@ -1166,9 +1114,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
C2, & ! Temporary variable with units of kg m-3 H-1.
r_SW_top ! Temporary variables with units of H kg m-3.
- Angstrom = GV%Angstrom
+ Angstrom = GV%Angstrom_H
C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0
- g_H2_2Rho0 = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0)
+ g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0)
Idt = 1.0/dt
is = G%isc ; ie = G%iec ; nz = GV%ke
@@ -1385,7 +1333,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
if (h_ent > 0.0) then
if (htot(i) > 0.0) &
dKE_FC(i) = dKE_FC(i) + CS%bulk_Ri_convective * 0.5 * &
- ((GV%H_to_m*h_ent) / (htot(i)*(h_ent+htot(i)))) * &
+ ((GV%H_to_Z*h_ent) / (htot(i)*(h_ent+htot(i)))) * &
((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2)
htot(i) = htot(i) + h_ent
@@ -1408,37 +1356,39 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
j, ksort, G, GV, 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.
- real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in m
- !! or kg m-2. (Intent in).
+ real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in H
+ !! (often m or kg m-2).
real, dimension(SZI_(G)), intent(in) :: h_CA !< The mixed layer depth after convective
!! adjustment, in H.
type(forcing), intent(in) :: fluxes !< A structure containing pointers to any
!! possible forcing fields. Unused fields
!! have NULL ptrs.
- real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy
- !! source due to free convection,
- !! in m3 s-2.
+ real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source
+ !! due to free convection, in Z m2 s-2.
real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in
!! kinetic energy due to free convection,
- !! in m3 s-2.
+ !! in Z m2 s-2.
real, dimension(SZI_(G),SZK_(GV)), &
intent(in) :: cTKE !< The buoyant turbulent kinetic energy
!! source due to convective adjustment,
- !! in m3 s-2.
+ !! in Z m2 s-2.
real, dimension(SZI_(G),SZK_(GV)), &
intent(in) :: dKE_CA !< The vertically integrated change in
!! kinetic energy due to convective
- !! adjustment, in m3 s-2.
+ !! adjustment, in Z m2 s-2.
real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for
- !! mixing over a time step, in m3 s-2.
+ !! mixing over a time step, in Z m2 s-2.
real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay
!! scale for TKE, in H-1.
- real, dimension(SZI_(G)), intent(in) :: TKE_river
+ real, dimension(SZI_(G)), intent(in) :: TKE_river !< The turbulent kinetic energy available
+ !! for driving mixing at river mouths
+ !! integrated over a time step, in Z m2 s-2.
real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in
!! calculating the denominator of MKE_rate,
!! in H-1 and H-2.
real, intent(in) :: dt !< The time step in s.
- real, intent(in) :: Idt_diag
+ real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic
+ !! time interval, in s-1.
integer, intent(in) :: j !< The j-index to work on.
integer, dimension(SZI_(G),SZK_(GV)), &
intent(in) :: ksort !< The density-sorted k-indicies.
@@ -1447,48 +1397,23 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
! This subroutine determines the TKE available at the depth of free
! convection to drive mechanical entrainment.
-! Arguments: htot - The accumlated mixed layer thickness, in m or kg m-2. (Intent in)
-! The units of htot are referred to as H below.
-! (in) h_CA - The mixed layer depth after convective adjustment, in H.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) Conv_en - The buoyant turbulent kinetic energy source due to
-! free convection, in m3 s-2.
-! (in) cTKE - The buoyant turbulent kinetic energy source due to
-! convective adjustment, in m3 s-2.
-! (in) dKE_FC - The vertically integrated change in kinetic energy due
-! to free convection, in m3 s-2.
-! (in) dKE_CA - The vertically integrated change in kinetic energy due
-! to convective adjustment, in m3 s-2.
-! (out) TKE - The turbulent kinetic energy available for mixing over a
-! time step, in m3 s-2.
-! (out) Idecay_len_TKE - The inverse of the vertical decay scale for
-! TKE, in H-1.
-! (out) cMKE - Coefficients of HpE and HpE^2 in calculating the
-! denominator of MKE_rate, in H-1 and H-2.
-! (in) dt - The time step in s.
-! (in) j - The j-index to work on.
-! (in) ksort - The density-sorted k-indicies.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure for this module.
- real :: dKE_conv ! The change in mean kinetic energy due
- ! to all convection, in m3 s-2.
+ ! Local variables
+ real :: dKE_conv ! The change in mean kinetic energy due to all convection, in Z m2 s-2.
real :: nstar_FC ! The effective efficiency with which the energy released by
! free convection is converted to TKE, often ~0.2, ND.
real :: nstar_CA ! The effective efficiency with which the energy released by
! convective adjustment is converted to TKE, often ~0.2, ND.
real :: TKE_CA ! The potential energy released by convective adjustment if
- ! that release is positive, in m3 s2.
+ ! that release is positive, in Z m2 s2.
real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1.
real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1.
- real :: totEn ! The total potential energy released by convection, m3 s-2.
+ real :: totEn_Z ! The total potential energy released by convection, Z3 s-2.
real :: Ih ! The inverse of a thickness, in H-1.
real :: exp_kh ! The nondimensional decay of TKE across a layer, ND.
real :: absf ! The absolute value of f averaged to thickness points, s-1.
- real :: U_star ! The friction velocity in m s-1.
- real :: absf_Ustar ! The absolute value of f divided by U_star, in m-1.
- real :: wind_TKE_src ! The surface wind source of TKE, in m3 s-3.
+ real :: U_star ! The friction velocity in Z s-1.
+ real :: absf_Ustar ! The absolute value of f divided by U_star, in Z-1.
+ real :: wind_TKE_src ! The surface wind source of TKE, in Z m2 s-3.
real :: diag_wt ! The ratio of the current timestep to the diagnostic
! timestep (which may include 2 calls), ND.
integer :: is, ie, nz, i
@@ -1498,11 +1423,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega
do i=is,ie
- U_Star = fluxes%ustar(i,j)
+ U_Star = GV%m_to_Z * fluxes%ustar(i,j)
if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then
if (fluxes%frac_shelf_h(i,j) > 0.0) &
U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + &
- fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j)
+ fluxes%frac_shelf_h(i,j) * GV%m_to_Z * fluxes%ustar_shelf(i,j)
endif
if (U_Star < CS%ustar_min) U_Star = CS%ustar_min
@@ -1513,7 +1438,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2)
endif
absf_Ustar = absf / U_Star
- Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_m
+ Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_Z
! The first number in the denominator could be anywhere up to 16. The
! value of 3 was chosen to minimize the time-step dependence of the amount
@@ -1525,8 +1450,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
! scales contribute to mixed layer deepening at similar rates, even though
! small scales are dissipated more rapidly (implying they are less efficient).
! Ih = 1.0/(16.0*0.41*U_star*dt)
- Ih = GV%H_to_m/(3.0*0.41*U_star*dt)
- cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_m) * Ih
+ Ih = GV%H_to_Z/(3.0*0.41*U_star*dt)
+ cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_Z) * Ih
if (Idecay_len_TKE(i) > 0.0) then
exp_kh = exp(-htot(i)*Idecay_len_TKE(i))
@@ -1540,11 +1465,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
if (Conv_En(i) < 0.0) Conv_En(i) = 0.0
if (cTKE(i,1) > 0.0) then ; TKE_CA = cTKE(i,1) ; else ; TKE_CA = 0.0 ; endif
if ((htot(i) >= h_CA(i)) .or. (TKE_CA == 0.0)) then
- totEn = Conv_En(i) + TKE_CA
+ totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA)
- if (totEn > 0.0) then
- nstar_FC = CS%nstar * totEn / (totEn + 0.2 * &
- sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_m))**3 * totEn))
+ if (totEn_Z > 0.0) then
+ nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * &
+ sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z))
else
nstar_FC = CS%nstar
endif
@@ -1552,17 +1477,17 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
else
! This reconstructs the Buoyancy flux within the topmost htot of water.
if (Conv_En(i) > 0.0) then
- totEn = Conv_En(i) + TKE_CA * (htot(i) / h_CA(i))
- nstar_FC = CS%nstar * totEn / (totEn + 0.2 * &
- sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_m))**3 * totEn))
+ totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) )
+ nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * &
+ sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z))
else
nstar_FC = CS%nstar
endif
- totEn = Conv_En(i) + TKE_CA
+ totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA)
if (TKE_CA > 0.0) then
- nstar_CA = CS%nstar * totEn / (totEn + 0.2 * &
- sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_m))**3 * totEn))
+ nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * &
+ sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z))
else
nstar_CA = CS%nstar
endif
@@ -1584,27 +1509,26 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
dKE_conv = dKE_CA(i,1) * MKE_rate_CA + dKE_FC(i) * MKE_rate_FC
! At this point, it is assumed that cTKE is positive and stored in TKE_CA!
! Note: Removed factor of 2 in u*^3 terms.
- TKE(i) = (dt*CS%mstar)*((U_Star*U_Star*U_Star)*exp_kh) + &
- (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA*TKE_CA)
-! Add additional TKE at river mouths
+ TKE(i) = (dt*CS%mstar)*((GV%Z_to_m**2*(U_Star*U_Star*U_Star))*exp_kh) + &
+ (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA)
- if (CS%do_rivermix) then
+ if (CS%do_rivermix) then ! Add additional TKE at river mouths
TKE(i) = TKE(i) + TKE_river(i)*dt*exp_kh
endif
if (CS%TKE_diagnostics) then
- wind_TKE_src = CS%mstar*(U_Star*U_Star*U_Star) * diag_wt
+ wind_TKE_src = CS%mstar*(GV%Z_to_m**2*U_Star*U_Star*U_Star) * diag_wt
CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + &
- wind_TKE_src + TKE_river(i) * diag_wt
+ ( wind_TKE_src + TKE_river(i) * diag_wt )
CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + dKE_conv*Idt_diag
CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + &
(exp_kh-1.0)*(wind_TKE_src + dKE_conv*Idt_diag)
CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + &
- Idt_diag*(nstar_FC*Conv_En(i) + nstar_CA*TKE_CA)
+ Idt_diag * (nstar_FC*Conv_En(i) + nstar_CA*TKE_CA)
CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + &
- Idt_diag*((CS%nstar-nstar_FC)*Conv_En(i) + (CS%nstar-nstar_CA)*TKE_CA)
+ Idt_diag * ((CS%nstar-nstar_FC)*Conv_En(i) + (CS%nstar-nstar_CA)*TKE_CA)
CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + &
- Idt_diag*(cTKE(i,1)-TKE_CA)
+ Idt_diag * (cTKE(i,1)-TKE_CA)
endif
enddo
@@ -1616,78 +1540,74 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
dR0_dT, dRcv_dT, cMKE, Idt_diag, nsw, &
Pen_SW_bnd, opacity_band, TKE, &
Idecay_len_TKE, j, ksort, G, GV, 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.
- real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2.
- !! (Intent in/out) The units of h are
- !! referred to as H below.
- real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a
- !! layer in the entrainment from
- !! below, in H. Positive values go
- !! with mass gain by a layer.
- real, dimension(SZI_(G)), intent(inout) :: htot !< The accumlated mixed layer
- !! thickness, in H.
- real, dimension(SZI_(G)), intent(inout) :: Ttot !< The depth integrated mixed layer
- !! temperature, in deg C H.
- real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer
- !! salinity, in psu H.
- real, dimension(SZI_(G)), intent(inout) :: uhtot !< The depth integrated mixed layer
- !! zonal velocity, H m s-1.
- real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer
- !! meridional velocity, H m s-1.
- real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer
- !! potential density referenced to 0
- !! pressure, in H kg m-3.
- real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer
- !! coordinate variable potential
- !! density, in H kg m-3.
- real, dimension(SZI_(G),SZK_(GV)), intent(in) :: u, v, T, S, R0, Rcv, eps
- real, dimension(SZI_(G)), intent(in) :: dR0_dT, dRcv_dT
- real, dimension(2,SZI_(G)), intent(in) :: cMKE
- real, intent(in) :: Idt_diag
- integer, intent(in) :: nsw !< The number of bands of penetrating
- !! shortwave radiation.
- real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave
- !! heating at the sea surface in each
- !! penetrating band, in K H,
- !! size nsw x SZI_(G).
- real, dimension(:,:,:), intent(in) :: opacity_band
- real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy
- !! available for mixing over a time
- !! step, in m3 s-2.
- real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE
- integer, intent(in) :: j !< The j-index to work on.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(inout) :: h !< Layer thickness, in m or kg m-2.
+ !! The units of h are referred to as H below.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(inout) :: d_eb !< The downward increase across a layer in the
+ !! layer in the entrainment from below, in H.
+ !! Positive values go with mass gain by a layer.
+ real, dimension(SZI_(G)), intent(inout) :: htot !< The accumlated mixed layer thickness, in H.
+ real, dimension(SZI_(G)), intent(inout) :: Ttot !< The depth integrated mixed layer temperature,
+ !! in deg C H.
+ real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity,
+ !! in psu H.
+ real, dimension(SZI_(G)), intent(inout) :: uhtot !< The depth integrated mixed layer zonal
+ !! velocity, H m s-1.
+ real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer meridional
+ !! velocity, H m s-1.
+ real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer potential
+ !! density referenced to 0 pressure, in H kg m-3.
+ real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer coordinate
+ !! variable potential density, in H kg m-3.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: u !< Zonal velocities interpolated to h points, m s-1.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: v !< Zonal velocities interpolated to h points, m s-1.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: T !< Layer temperatures, in deg C.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: S !< Layer salinities, in psu.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: R0 !< Potential density referenced to
+ !! surface pressure, in kg m-3.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: Rcv !< The coordinate defining potential
+ !! density, in kg m-3.
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: eps !< The negligibly small amount of water
+ !! that will be left in each layer, in H.
+ real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to
+ !! temperature, in kg m-3 degC-1.
+ real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to
+ !! temperature, in kg m-3 degC-1.
+ real, dimension(2,SZI_(G)), intent(in) :: cMKE !< Coefficients of HpE and HpE^2 used in calculating
+ !! the denominator of MKE_rate, in m-1 and m-2.
+ real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic
+ !! time interval, in s-1.
+ integer, intent(in) :: nsw !< The number of bands of penetrating
+ !! shortwave radiation.
+ real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave
+ !! heating at the sea surface in each
+ !! penetrating band, in K H,
+ !! size nsw x SZI_(G).
+ real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating
+ !! shortwave radiation, in H-1.
+ !! The indicies of opacity_band are band, i, k.
+ real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy
+ !! available for mixing over a time
+ !! step, in Z m2 s-2.
+ real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate, in H-1.
+ integer, intent(in) :: j !< The j-index to work on.
integer, dimension(SZI_(G),SZK_(GV)), &
- intent(in) :: ksort !< The density-sorted k-indicies.
- type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this
- !! module.
+ intent(in) :: ksort !< The density-sorted k-indicies.
+ type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module.
! This subroutine calculates mechanically driven entrainment.
-! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units
-! of h are referred to as H below.
-! (in/out) d_eb - The downward increase across a layer in the entrainment from
-! below, in H. Positive values go with mass gain by a layer.
-! (in/out) htot - The accumlated mixed layer thickness, in H.
-! (in/out) Ttot - The depth integrated mixed layer temperature, in deg C H.
-! (in/out) Stot - The depth integrated mixed layer salinity, in psu H.
-! (in/out) uhtot - The depth integrated mixed layer zonal velocity, H m s-1.
-! (in/out) vhtot - The integrated mixed layer meridional velocity, H m s-1.
-! (in/out) R0_tot - The integrated mixed layer potential density referenced
-! to 0 pressure, in H kg m-3.
-! (in/out) Rcv_tot - The integrated mixed layer coordinate variable
-! potential density, in H kg m-3.
-! (in) nsw - The number of bands of penetrating shortwave radiation.
-! (in/out) Pen_SW_bnd - The penetrating shortwave heating at the sea surface
-! in each penetrating band, in K H, size nsw x SZI_(G).
-! (in/out) TKE - The turbulent kinetic energy available for mixing over a
-! time step, in m3 s-2.
-! (in) j - The j-index to work on.
-! (in) ksort - The density-sorted k-indicies.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure for this module.
+ ! Local variables
real :: SW_trans ! The fraction of shortwave radiation that is not
! absorbed in a layer, nondimensional.
real :: Pen_absorbed ! The amount of penetrative shortwave radiation
@@ -1705,18 +1625,18 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
! conversion from H to m divided by the mean density,
! in m5 s-2 H-1 kg-1.
real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained,
- ! in units of m3 s-2.
+ ! in units of Z m2 s-2.
real :: dRL ! Work required to mix water from the next layer
! across the mixed layer, in m2 s-2.
real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in
! TKE, divided by layer thickness in m, in m2 s-2.
real :: C1 ! A temporary variable in units of m2 s-2.
real :: dMKE ! A temporary variable related to the release of mean
- ! kinetic energy, with units of H m3 s-2.
- real :: TKE_ent ! The TKE that remains if h_ent were entrained, in m3 s-2.
+ ! kinetic energy, with units of H Z m2 s-2.
+ real :: TKE_ent ! The TKE that remains if h_ent were entrained, in Z m2 s-2.
real :: TKE_ent1 ! The TKE that would remain, without considering the
- ! release of mean kinetic energy, in m3 s2.
- real :: dTKE_dh ! The partial derivative of TKE with h_ent, in m3 s-2 H-1.
+ ! release of mean kinetic energy, in Z m2 s2.
+ real :: dTKE_dh ! The partial derivative of TKE with h_ent, in Z m2 s-2 H-1.
real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to
! dTKE_dh, in m2 s-2.
real :: EF4_val ! The result of EF4() (see later), in H-1.
@@ -1724,7 +1644,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
! in roundoff and can be neglected, in H.
real :: dEF4_dh ! The partial derivative of EF4 with h, in H-2.
real :: Pen_En1 ! A nondimensional temporary variable.
- real :: kh, exp_kh ! Nondimensional temporary variables related to the.
+ real :: kh, exp_kh ! Nondimensional temporary variables related to the
real :: f1_kh ! fractional decay of TKE across a layer.
real :: x1, e_x1 ! Nondimensional temporary variables related to
real :: f1_x1, f2_x1 ! the relative decay of TKE and SW radiation across
@@ -1732,15 +1652,13 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
real :: E_HxHpE ! Entrainment divided by the product of the new and old
! thicknesses, in H-1.
real :: Hmix_min ! The minimum mixed layer depth in H.
- real :: H_to_m ! Local copies of unit conversion factors.
real :: opacity
real :: C1_3, C1_6, C1_24 ! 1/3, 1/6, and 1/24.
integer :: is, ie, nz, i, k, ks, itt, n
C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0
- H_to_m = GV%H_to_m
- g_H_2Rho0 = (GV%g_Earth * H_to_m) / (2.0 * GV%Rho0)
- Hmix_min = CS%Hmix_min * GV%m_to_H
+ g_H_2Rho0 = (GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0)
+ Hmix_min = CS%Hmix_min
h_neglect = GV%H_subroundoff
is = G%isc ; ie = G%iec ; nz = GV%ke
@@ -1752,7 +1670,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
h_avail = h(i,k) - eps(i,k)
if ((h_avail > 0.) .and. ((TKE(i) > 0.) .or. (htot(i) < Hmix_min))) then
dRL = g_H_2Rho0 * (R0(i,k)*htot(i) - R0_tot(i) )
- dMKE = (H_to_m * CS%bulk_Ri_ML) * 0.5 * &
+ dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * &
((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2)
! Find the TKE that would remain if the entire layer were entrained.
@@ -1798,7 +1716,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
HpE = htot(i)+h_avail
MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2))
EF4_val = EF4(htot(i)+h_neglect,h_avail,Idecay_len_TKE(i))
- TKE_full_ent = (exp_kh*TKE(i) - (h_avail*H_to_m)*(dRL*f1_kh + Pen_En_Contrib)) + &
+ TKE_full_ent = (exp_kh*TKE(i) - (h_avail*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib)) + &
MKE_rate*dMKE*EF4_val
if ((TKE_full_ent >= 0.0) .or. (h_avail+htot(i) <= Hmix_min)) then
! The layer will be fully entrained.
@@ -1808,18 +1726,18 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
E_HxHpE = h_ent / ((htot(i)+h_neglect)*(htot(i)+h_ent+h_neglect))
CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + &
Idt_diag * ((exp_kh-1.0)*TKE(i) + &
- (h_ent*H_to_m)*dRL*(1.0-f1_kh) + &
+ (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + &
MKE_rate*dMKE*(EF4_val-E_HxHpE))
CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - &
- Idt_diag*(H_to_m*h_ent)*dRL
+ Idt_diag*(GV%H_to_Z*h_ent)*dRL
CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - &
- Idt_diag*(H_to_m*h_ent)*Pen_En_Contrib
+ Idt_diag*(GV%H_to_Z*h_ent)*Pen_En_Contrib
CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + &
Idt_diag*MKE_rate*dMKE*E_HxHpE
endif
TKE(i) = TKE_full_ent
- if (TKE(i) <= 0.0) TKE(i) = 1.0e-150
+ if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*GV%m_to_Z
else
! The layer is only partially entrained. The amount that will be
! entrained is determined iteratively. No further layers will be
@@ -1878,16 +1796,16 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
C1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans)
endif ; enddo ! (Pen_SW_bnd(n,i) > 0.0)
- TKE_ent1 = exp_kh*TKE(i) - (h_ent*H_to_m)*(dRL*f1_kh + Pen_En_Contrib)
+ TKE_ent1 = exp_kh*TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib)
EF4_val = EF4(htot(i)+h_neglect,h_ent,Idecay_len_TKE(i),dEF4_dh)
HpE = htot(i)+h_ent
MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2))
TKE_ent = TKE_ent1 + dMKE*EF4_val*MKE_rate
! TKE_ent is the TKE that would remain if h_ent were entrained.
- dTKE_dh = ((-Idecay_len_TKE(i)*TKE_ent1 - dRL*H_to_m) + &
- Pen_dTKE_dh_Contrib*H_to_m) + dMKE * MKE_rate* &
- (dEF4_dh - EF4_val*MKE_rate*(cMKE(1,i)+2.0*cMKE(2,i)*HpE))
+ dTKE_dh = ((-Idecay_len_TKE(i)*TKE_ent1 - dRL*GV%H_to_Z) + &
+ Pen_dTKE_dh_Contrib*GV%H_to_Z) + dMKE * MKE_rate* &
+ (dEF4_dh - EF4_val*MKE_rate*(cMKE(1,i)+2.0*cMKE(2,i)*HpE))
! dh_Newt = -TKE_ent / dTKE_dh
! Bisect if the Newton's method prediction is outside of the bounded range.
if (TKE_ent > 0.0) then
@@ -1907,7 +1825,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
endif
h_ent = h_ent + dh_Newt
- if (ABS(dh_Newt) < 0.2*GV%Angstrom) exit
+ if (ABS(dh_Newt) < 0.2*GV%Angstrom_H) exit
enddo
endif
@@ -1921,12 +1839,12 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
E_HxHpE = h_ent / ((htot(i)+h_neglect)*(HpE+h_neglect))
CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + &
Idt_diag * ((exp_kh-1.0)*TKE(i) + &
- (h_ent*H_to_m)*dRL*(1.0-f1_kh) + &
+ (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + &
dMKE*MKE_rate*(EF4_val-E_HxHpE))
CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - &
- Idt_diag*(h_ent*H_to_m)*dRL
+ Idt_diag*(h_ent*GV%H_to_Z)*dRL
CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - &
- Idt_diag*(h_ent*H_to_m)*Pen_En_Contrib
+ Idt_diag*(h_ent*GV%H_to_Z)*Pen_En_Contrib
CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + &
Idt_diag*dMKE*MKE_rate*E_HxHpE
endif
@@ -2498,7 +2416,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
! rho_0*g, in units of H2.
real :: dPE_det, dPE_merge ! The energy required to mix the detrained water
! into the buffer layer or the merge the two
- ! buffer layers, both in units of J H2 m-4.
+ ! buffer layers, both in units of J H2 Z m-5.
real :: h_from_ml ! The amount of additional water that must be
! drawn from the mixed layer, in H.
@@ -2540,11 +2458,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
! K psu-1 and psu K-1.
real :: I_denom ! A work variable with units of psu2 m6 kg-2.
- real :: G_2 ! 1/2 G_Earth, in m s-2.
- real :: Rho0xG ! Rho0 times G_Earth, in kg m-2 s-2.
+ real :: G_2 ! 1/2 G_Earth, in m2 Z-1 s-2.
+ real :: Rho0xG ! Rho0 times G_Earth, in kg m-1 Z-1 s-2.
real :: I2Rho0 ! 1 / (2 Rho0), in m3 kg-1.
real :: Idt_H2 ! The square of the conversion from thickness
- ! to m divided by the time step in m2 H-2 s-1.
+ ! to Z divided by the time step in Z2 H-2 s-1.
logical :: stable_Rcv ! If true, the buffer layers are stable with
! respect to the coordinate potential density.
real :: h_neglect ! A thickness that is so small it is usually lost
@@ -2571,15 +2489,15 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
h_neglect = GV%H_subroundoff
G_2 = 0.5*GV%g_Earth
Rho0xG = GV%Rho0 * GV%g_Earth
- Idt_H2 = GV%H_to_m**2 / dt_diag
+ Idt_H2 = GV%H_to_Z**2 / dt_diag
I2Rho0 = 0.5 / GV%Rho0
- Angstrom = GV%Angstrom
+ Angstrom = GV%Angstrom_H
! This is hard coding of arbitrary and dimensional numbers.
- h_min_bl_thick = 5.0 * GV%m_to_H
+ h_min_bl_thick = 5.0 * GV%m_to_H !### DIMENSIONAL CONSTANT
dT_dS_gauge = CS%dT_dS_wt ; dS_dT_gauge = 1.0 /dT_dS_gauge
num_events = 10.0
- detrainment_timescale = 4.0*3600.0
+ detrainment_timescale = 4.0*3600.0 !### DIMENSIONAL CONSTANT
if (CS%nkbl /= 2) call MOM_error(FATAL, "MOM_mixed_layer"// &
"CS%nkbl must be 2 in mixedlayer_detrain_2.")
@@ -3218,7 +3136,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
if (allocated(CS%diag_PE_detrain)) &
CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_merge
if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = &
- CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det+Rho0xG*dPE_extrap)
+ CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap)
else ! Not mergeable_bl.
! There is no further detrainment from the buffer layers, and the
! upper buffer layer water is distributed optimally between the
@@ -3294,7 +3212,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
if (allocated(CS%diag_PE_detrain)) &
CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_det
if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = &
- CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det+Rho0xG*dPE_extrap)
+ CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap)
endif
endif ! End of detrainment...
@@ -3322,7 +3240,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each
!! layer, in kg m-3.
real, intent(in) :: dt !< Time increment, in s.
- real, intent(in) :: dt_diag
+ real, intent(in) :: dt_diag !< The accumulated time interval for
+ !! diagnostics, in s.
real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in
!! the entrainment from above, in m or
!! kg m-2 (H). Positive d_ea goes with
@@ -3384,12 +3303,12 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
real :: I_denom ! A work variable with units of psu2 m6 kg-2.
real :: Sdown, Tdown
real :: dt_Time, Timescale = 86400.0*30.0! *365.0/12.0
- real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the
- ! square of the conversion from H to m divided
- ! by the mean density times the time step, in m6 s-3 H-2 kg-1.
+ real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of
+ ! the conversion from H to m divided by the mean
+ ! density times the time step, in m7 s-3 Z-1 H-2 kg-1. !### CHECK UNITS
real :: g_H2_2dt ! Half the gravitational acceleration times the
! square of the conversion from H to m divided
- ! by the diagnostic time step, in m3 H-2 s-3.
+ ! by the diagnostic time step, in m4 Z-1 H-2 s-3.
logical :: splittable_BL(SZI_(G)), orthogonal_extrap
real :: x1
@@ -3401,17 +3320,16 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
"CS%nkbl must be 1 in mixedlayer_detrain_1.")
Idt = 1.0/dt
dt_Time = dt/Timescale
- g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0 * dt_diag)
- g_H2_2dt = (GV%g_Earth * GV%H_to_m**2) / (2.0 * dt_diag)
+ g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag)
+ g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag)
! Move detrained water into the buffer layer.
do k=1,CS%nkml
do i=is,ie ; if (h(i,k) > 0.0) then
Ih = 1.0 / (h(i,nkmb) + h(i,k))
if (CS%TKE_diagnostics) &
- CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + &
- g_H2_2Rho0dt * h(i,k) * h(i,nkmb) * &
- (R0(i,nkmb) - R0(i,k))
+ CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + &
+ g_H2_2Rho0dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k))
if (allocated(CS%diag_PE_detrain)) &
CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + &
g_H2_2dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k))
@@ -3507,10 +3425,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
! temperature and salinity. If none is available a pseudo-orthogonal
! extrapolation is used. The 10.0 and 0.9 in the following are
! arbitrary but probably about right.
- if ((h(i,k+1) < 10.0*GV%Angstrom) .or. &
+ if ((h(i,k+1) < 10.0*GV%Angstrom_H) .or. &
((RcvTgt(k+1)-Rcv(i,nkmb)) >= 0.9*(Rcv(i,k1) - Rcv(i,0)))) then
if (k>=nz-1) then ; orthogonal_extrap = .true.
- elseif ((h(i,k+2) <= 10.0*GV%Angstrom) .and. &
+ elseif ((h(i,k+2) <= 10.0*GV%Angstrom_H) .and. &
((RcvTgt(k+1)-Rcv(i,nkmb)) < 0.9*(Rcv(i,k+2)-Rcv(i,0)))) then
k1 = k+2
else ; orthogonal_extrap = .true. ; endif
@@ -3620,9 +3538,9 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
end subroutine mixedlayer_detrain_1
-! #@# This subroutine needs a doxygen description.
+!> This subroutine initializes the MOM bulk mixed layer module.
subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS)
- type(time_type), target, intent(in) :: Time
+ type(time_type), target, intent(in) :: Time !< The model's clock with the current time.
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(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
@@ -3642,7 +3560,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS)
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name.
- real :: omega_frac_dflt, ustar_min_dflt
+ real :: omega_frac_dflt, ustar_min_dflt, Hmix_min_m
integer :: isd, ied, jsd, jed
logical :: use_temperature, use_omega
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -3702,7 +3620,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS)
units="nondim", default=CS%bulk_Ri_ML)
call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, &
"The minimum mixed layer depth if the mixed layer depth \n"//&
- "is determined dynamically.", units="m", default=0.0)
+ "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H, &
+ unscaled=Hmix_min_m)
call get_param(param_file, mdl, "LIMIT_BUFFER_DETRAIN", CS%limit_det, &
"If true, limit the detrainment from the buffer layers \n"//&
@@ -3730,7 +3649,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS)
call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, &
"The surface fluxes are scaled away when the total ocean \n"//&
"depth is less than DEPTH_LIMIT_FLUXES.", &
- units="m", default=0.1*CS%Hmix_min)
+ units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H)
call get_param(param_file, mdl, "OMEGA",CS%omega, &
"The rotation rate of the earth.", units="s-1", &
default=7.2921e-5)
@@ -3757,12 +3676,12 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS)
"layers before sorting when ML_RESORT is true.", &
units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA.
! This gives a minimum decay scale that is typically much less than Angstrom.
- ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff)
+ ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff)
call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, &
"The minimum value of ustar that should be used by the \n"//&
"bulk mixed layer model in setting vertical TKE decay \n"//&
"scales. This must be greater than 0.", units="m s-1", &
- default=ustar_min_dflt)
+ default=ustar_min_dflt, scale=GV%m_to_Z)
if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.")
call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, &
@@ -3783,7 +3702,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS)
if (CS%do_rivermix) &
call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, &
"The depth to which rivers are mixed if DO_RIVERMIX is \n"//&
- "defined.", units="m", default=0.0)
+ "defined.", units="m", default=0.0, scale=GV%m_to_Z)
call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, &
"If true, use the fluxes%runoff_Hflx field to set the \n"//&
"heat carried by runoff, instead of using SST*CP*liq_runoff.", &
@@ -3802,33 +3721,36 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS)
CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, &
Time, 'Surface mixed layer depth', 'm')
CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, &
- Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3')
+ Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m)
CS%id_TKE_RiBulk = register_diag_field('ocean_model', 'TKE_RiBulk', diag%axesT1, &
- Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3')
+ Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m)
CS%id_TKE_conv = register_diag_field('ocean_model', 'TKE_conv', diag%axesT1, &
- Time, 'Convective source of mixed layer TKE', 'm3 s-3')
+ Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m)
CS%id_TKE_pen_SW = register_diag_field('ocean_model', 'TKE_pen_SW', diag%axesT1, &
- Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', 'm3 s-3')
+ Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', &
+ 'm3 s-3', conversion=GV%Z_to_m)
CS%id_TKE_mixing = register_diag_field('ocean_model', 'TKE_mixing', diag%axesT1, &
- Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3')
+ Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=GV%Z_to_m)
CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'TKE_mech_decay', diag%axesT1, &
- Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3')
+ Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m)
CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'TKE_conv_decay', diag%axesT1, &
- Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3')
+ Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m)
CS%id_TKE_conv_s2 = register_diag_field('ocean_model', 'TKE_conv_s2', diag%axesT1, &
- Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3')
+ Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=GV%Z_to_m)
CS%id_PE_detrain = register_diag_field('ocean_model', 'PE_detrain', diag%axesT1, &
- Time, 'Spurious source of potential energy from mixed layer detrainment', 'W m-2')
+ Time, 'Spurious source of potential energy from mixed layer detrainment', &
+ 'W m-2', conversion=GV%Z_to_m)
CS%id_PE_detrain2 = register_diag_field('ocean_model', 'PE_detrain2', diag%axesT1, &
- Time, 'Spurious source of potential energy from mixed layer only detrainment', 'W m-2')
+ Time, 'Spurious source of potential energy from mixed layer only detrainment', &
+ 'W m-2', conversion=GV%Z_to_m)
CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, &
- Time, 'Summed absolute mismatch in entrainment terms', 'm')
+ Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=GV%Z_to_m)
CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, &
- Time, 'Surface region thickness that is used', 'm')
+ Time, 'Surface region thickness that is used', 'm', conversion=GV%Z_to_m)
CS%id_Hsfc_max = register_diag_field('ocean_model', 'Hs_max', diag%axesT1, &
- Time, 'Maximum surface region thickness', 'm')
+ Time, 'Maximum surface region thickness', 'm', conversion=GV%Z_to_m)
CS%id_Hsfc_min = register_diag_field('ocean_model', 'Hs_min', diag%axesT1, &
- Time, 'Minimum surface region thickness', 'm')
+ Time, 'Minimum surface region thickness', 'm', conversion=GV%Z_to_m)
!CS%lim_det_dH_sfc = 0.5 ; CS%lim_det_dH_bathy = 0.2 ! Technically these should not get used if limit_det is false?
if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then
call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, &
@@ -3850,9 +3772,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS)
endif
- if (max(CS%id_TKE_wind, CS%id_TKE_RiBulk, CS%id_TKE_conv, &
- CS%id_TKE_mixing, CS%id_TKE_pen_SW, CS%id_TKE_mech_decay, &
- CS%id_TKE_conv_decay) > 0) then
+ if (max(CS%id_TKE_wind, CS%id_TKE_RiBulk, CS%id_TKE_conv, CS%id_TKE_mixing, &
+ CS%id_TKE_pen_SW, CS%id_TKE_mech_decay, CS%id_TKE_conv_decay) > 0) then
call safe_alloc_alloc(CS%diag_TKE_wind, isd, ied, jsd, jed)
call safe_alloc_alloc(CS%diag_TKE_RiBulk, isd, ied, jsd, jed)
call safe_alloc_alloc(CS%diag_TKE_conv, isd, ied, jsd, jed)
@@ -3926,4 +3847,22 @@ function EF4(H, E, L, dR_de)
end function EF4
+!> \namespace mom_bulk_mixed_layer
+!!
+!! By Robert Hallberg, 1997 - 2005.
+!!
+!! This file contains the subroutine (bulkmixedlayer) that
+!! implements a Kraus-Turner-like bulk mixed layer, based on the work
+!! of various people, as described in the review paper by Niiler and
+!! Kraus (1979), with particular attention to the form proposed by
+!! Oberhuber (JPO, 1993, 808-829), with an extension to a refied bulk
+!! mixed layer as described in Hallberg (Aha Huliko'a, 2003). The
+!! physical processes portrayed in this subroutine include convective
+!! adjustment and mixed layer entrainment and detrainment.
+!! Penetrating shortwave radiation and an exponential decay of TKE
+!! fluxes are also supported by this subroutine. Several constants
+!! can alternately be set to give a traditional Kraus-Turner mixed
+!! layer scheme, although that is not the preferred option. The
+!! physical processes and arguments are described in detail below.
+
end module MOM_bulk_mixed_layer
diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90
index 528dc33135..119e3dbb30 100644
--- a/src/parameterizations/vertical/MOM_diabatic_aux.F90
+++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90
@@ -1,3 +1,5 @@
+!> Provides functions for some diabatic processes such as fraxil, brine rejection,
+!! tendency due to surface flux divergence.
module MOM_diabatic_aux
! This file is part of MOM6. See LICENSE.md for the license.
@@ -13,7 +15,6 @@ module MOM_diabatic_aux
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_forcing_type, only : forcing, extractFluxes1d, forcing_SinglePointPrint
use MOM_grid, only : ocean_grid_type
-use MOM_io, only : vardesc
use MOM_shortwave_abs, only : absorbRemainingSW, optics_type, sumSWoverBands
use MOM_variables, only : thermo_var_ptrs, vertvisc_type! , accel_diag_ptrs
use MOM_verticalGrid, only : verticalGrid_type
@@ -25,12 +26,12 @@ module MOM_diabatic_aux
public diabatic_aux_init, diabatic_aux_end
public make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS
public find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut
+
!> Control structure for diabatic_aux
type, public :: diabatic_aux_CS ; private
- logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff
- !! at the river mouths to "rivermix_depth" meters
- real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if
- !! do_rivermix = T, in m.
+ logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff at the
+ !! river mouths to a depth of "rivermix_depth"
+ real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in Z.
logical :: reclaim_frazil !< If true, try to use any frazil heat deficit to
!! to cool the topmost layer down to the freezing
!! point. The default is false.
@@ -52,11 +53,11 @@ module MOM_diabatic_aux
type(diag_ctrl), pointer :: diag !< Structure used to regulate timing of diagnostic output
! Diagnostic handles
- integer :: id_createdH = -1
- integer :: id_brine_lay = -1
- integer :: id_penSW_diag = -1 !< Penetrative shortwave heating (flux convergence) diagnostic
- integer :: id_penSWflux_diag = -1 !< Penetrative shortwave flux diagnostic
- integer :: id_nonpenSW_diag = -1 !< Non-penetrative shortwave heating diagnostic
+ integer :: id_createdH = -1 !< Diagnostic ID of mass added to avoid grounding
+ integer :: id_brine_lay = -1 !< Diagnostic ID of which layer receives the brine
+ integer :: id_penSW_diag = -1 !< Diagnostic ID of Penetrative shortwave heating (flux convergence)
+ integer :: id_penSWflux_diag = -1 !< Diagnostic ID of Penetrative shortwave flux
+ integer :: id_nonpenSW_diag = -1 !< Diagnostic ID of Non-penetrative shortwave heating
! Optional diagnostic arrays
real, allocatable, dimension(:,:) :: createdH !< The amount of volume added in order to avoid grounding (m/s)
@@ -66,17 +67,28 @@ module MOM_diabatic_aux
end type diabatic_aux_CS
+!>@{ CPU time clock IDs
integer :: id_clock_uv_at_h, id_clock_frazil
+!!@}
contains
-subroutine make_frazil(h, tv, G, GV, CS, p_surf)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(thermo_var_ptrs), intent(inout) :: tv
- type(diabatic_aux_CS), intent(in) :: CS
- real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: p_surf
+!> Frazil formation keeps the temperature above the freezing point.
+!! This subroutine warms any water that is colder than the (currently
+!! surface) freezing point up to the freezing point and accumulates
+!! the required heat (in J m-2) in tv%frazil.
+subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any available
+ !! thermodynamic fields.
+ 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, in Pa.
+ integer, optional, intent(in) :: halo !< Halo width over which to calculate frazil
! Frazil formation keeps the temperature above the freezing point.
! This subroutine warms any water that is colder than the (currently
@@ -102,7 +114,11 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf)
logical :: T_fr_set ! True if the freezing point has been calculated for a
! row of points.
integer :: i, j, k, is, ie, js, je, nz
+
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
+ if (present(halo)) then
+ is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo
+ endif
call cpu_clock_begin(id_clock_frazil)
@@ -166,7 +182,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf)
endif
hc = (tv%C_p*GV%H_to_kg_m2) * h(i,j,k)
- if (h(i,j,k) <= 10.0*GV%Angstrom) then
+ if (h(i,j,k) <= 10.0*GV%Angstrom_H) then
! Very thin layers should not be cooled by the frazil flux.
if (tv%T(i,j,k) < T_freeze(i)) then
fraz_col(i) = fraz_col(i) + hc * (T_freeze(i) - tv%T(i,j,k))
@@ -192,38 +208,39 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf)
end subroutine make_frazil
-!> Applies double diffusion to T & S, assuming no diapycal mass
+!> This subroutine applies double diffusion to T & S, assuming no diapycal mass
!! fluxes, using a simple triadiagonal solver.
subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(thermo_var_ptrs), intent(inout) :: tv !< pointers to any available modynamic fields.
- !! Absent fields have NULL ptrs.
- type(vertvisc_type), intent(in) :: visc !< structure containing vertical viscosities,
- !! layer properies, and related fields.
- real, intent(in) :: dt !< Time increment, in s.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any
+ !! available thermodynamic fields.
+ type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom
+ !! boundary layer properies, and related fields.
+ real, intent(in) :: dt !< Time increment, in s.
! local variables
real, dimension(SZI_(G)) :: &
b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H.
d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim.
real, dimension(SZI_(G),SZK_(G)) :: &
- c1_T, c1_S ! Variables used by the tridiagonal solvers, in m or kg m-2.
+ c1_T, c1_S ! Variables used by the tridiagonal solvers, in H.
real, dimension(SZI_(G),SZK_(G)+1) :: &
- mix_T, mix_S ! Mixing distances in both directions across each
- ! interface, in m or kg m-2.
+ mix_T, mix_S ! Mixing distances in both directions across each interface, in H.
real :: h_tr ! h_tr is h at tracer points with a tiny thickness
- ! added to ensure positive definiteness, in m or kg m-2.
+ ! added to ensure positive definiteness, in H.
real :: h_neglect ! A thickness that is so small it is usually lost
- ! in roundoff and can be neglected, in m or kg m-2.
+ ! in roundoff and can be neglected, in H.
real :: I_h_int ! The inverse of the thickness associated with an
- ! interface, in m-1 or m2 kg-1.
+ ! interface, in H-1.
real :: b_denom_T ! The first term in the denominators for the expressions
- real :: b_denom_S ! for b1_T and b1_S, both in m or kg m-2.
-
+ real :: b_denom_S ! for b1_T and b1_S, both in H.
+ real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL()
+ real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities in Z2 s-1.
integer :: i, j, k, is, ie, js, je, nz
- real, pointer :: T(:,:,:), S(:,:,:), Kd_T(:,:,:), Kd_S(:,:,:)
+
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
h_neglect = GV%H_subroundoff
@@ -244,8 +261,8 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV)
do j=js,je
do i=is,ie
I_h_int = 1.0 / (0.5 * (h(i,j,1) + h(i,j,2)) + h_neglect)
- mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%m_to_H**2) * I_h_int
- mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%m_to_H**2) * I_h_int
+ mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%Z_to_H**2) * I_h_int
+ mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%Z_to_H**2) * I_h_int
h_tr = h(i,j,1) + h_neglect
b1_T(i) = 1.0 / (h_tr + mix_T(i,2))
@@ -258,8 +275,8 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV)
do k=2,nz-1 ; do i=is,ie
! Calculate the mixing across the interface below this layer.
I_h_int = 1.0 / (0.5 * (h(i,j,k) + h(i,j,k+1)) + h_neglect)
- mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%m_to_H**2) * I_h_int
- mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%m_to_H**2) * I_h_int
+ mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%Z_to_H**2) * I_h_int
+ mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%Z_to_H**2) * I_h_int
c1_T(i,k) = mix_T(i,K) * b1_T(i)
c1_S(i,k) = mix_S(i,K) * b1_S(i)
@@ -293,18 +310,19 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV)
enddo
end subroutine differential_diffuse_T_S
-!> Keep salinity from falling below a small but positive threshold
-!! This occurs when the ice model attempts to extract more salt then
-!! is actually available to it from the ocean.
-subroutine adjust_salt(h, tv, G, GV, 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
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m
- !! or kg m-2)
- type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to any
- !! available thermodynamic fields.
- type(diabatic_aux_CS), intent(in) :: CS !< control structure returned by
- !! a previous call to diabatic_driver_init.
+!> This subroutine keeps salinity from falling below a small but positive threshold.
+!! This usually occurs when the ice model attempts to extract more salt then
+!! is actually available to it from the ocean.
+subroutine adjust_salt(h, tv, G, GV, CS, halo)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any
+ !! available thermodynamic fields.
+ type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous
+ !! call to diabatic_aux_init.
+ integer, optional, intent(in) :: halo !< Halo width over which to work
! local variables
real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement
@@ -312,9 +330,13 @@ subroutine adjust_salt(h, tv, G, GV, CS)
real :: mc !< A layer's mass kg m-2 .
integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
+ if (present(halo)) then
+ is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo
+ endif
! call cpu_clock_begin(id_clock_adjust_salt)
+!### MAKE THIS A RUN_TIME PARAMETER. COULD IT BE 0?
S_min = 0.01
salt_add_col(:,:) = 0.0
@@ -326,7 +348,7 @@ subroutine adjust_salt(h, tv, G, GV, CS)
if ((G%mask2dT(i,j) > 0.0) .and. &
((tv%S(i,j,k) < S_min) .or. (salt_add_col(i,j) > 0.0))) then
mc = GV%H_to_kg_m2 * h(i,j,k)
- if (h(i,j,k) <= 10.0*GV%Angstrom) then
+ if (h(i,j,k) <= 10.0*GV%Angstrom_H) then
! Very thin layers should not be adjusted by the salt flux
if (tv%S(i,j,k) < S_min) then
salt_add_col(i,j) = salt_add_col(i,j) + mc * (S_min - tv%S(i,j,k))
@@ -351,27 +373,23 @@ subroutine adjust_salt(h, tv, G, GV, CS)
end subroutine adjust_salt
-!> Insert salt from brine rejection into the first layer below
-!! the mixed layer which both contains mass and in which the
-!! change in layer density remains stable after the addition
-!! of salt via brine rejection.
+!> Insert salt from brine rejection into the first layer below the mixed layer
+!! which both contains mass and in which the change in layer density remains
+!! stable after the addition of salt via brine rejection.
subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m
- !! or kg m-2)
- type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to
- !! any available hermodynamic fields.
- type(forcing), intent(in) :: fluxes !< tructure containing pointers
- !! any possible forcing fields
- integer, intent(in) :: nkmb !< number of layers in the mixed and
- !! buffer layers
- type(diabatic_aux_CS), intent(in) :: CS !< control structure returned by a
- !! previous call to diabatic_driver_init.
- real, intent(in) :: dt !< time step between calls to this
- !! function (s) ??
- integer, intent(in) :: id_brine_lay
-
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any
+ !! available thermodynamic fields
+ type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes
+ integer, intent(in) :: nkmb !< The number of layers in the mixed and buffer layers
+ type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous
+ !! call to diabatic_aux_init
+ real, intent(in) :: dt !< The thermodyanmic time step, in s.
+ integer, intent(in) :: id_brine_lay !< The handle for a diagnostic
+ !! which layer receivees the brine.
! local variables
real :: salt(SZI_(G)) ! The amount of salt rejected from
@@ -397,7 +415,7 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay)
p_ref_cv(:) = tv%P_ref
- inject_layer = nz
+ inject_layer(:,:) = nz
do j=js,je
@@ -411,7 +429,7 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay)
do i=is,ie
T(i,k)=tv%T(i,j,k); S(i,k)=tv%S(i,j,k)
! avoid very small thickness
- h_2d(i,k)=MAX(h(i,j,k), GV%Angstrom)
+ 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, &
@@ -472,25 +490,34 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay)
enddo
- if (CS%id_brine_lay > 0) call post_data(CS%id_brine_lay,inject_layer,CS%diag)
+ if (CS%id_brine_lay > 0) call post_data(CS%id_brine_lay, inject_layer, CS%diag)
end subroutine insert_brine
-!> Simple tri-diagnonal solver for T and S.
+!> This is a simple tri-diagonal solver for T and S.
!! "Simple" means it only uses arrays hold, ea and eb.
subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- integer, intent(in) :: is, ie, js, je
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hold, ea, eb
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: T, S
+ integer, intent(in) :: is !< The start i-index to work on.
+ integer, intent(in) :: ie !< The end i-index to work on.
+ integer, intent(in) :: js !< The start j-index to work on.
+ integer, intent(in) :: je !< The end j-index to work on.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hold !< The layer thicknesses before entrainment, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: ea !< The amount of fluid entrained from the layer
+ !! above within this time step, in units of H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< The amount of fluid entrained from the layer
+ !! below within this time step, in units of H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: T !< Layer potential temperatures, in degC.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: S !< Layer salinities, in PSU.
+
! Local variables
real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the
real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver.
real :: h_tr, b_denom_1
integer :: i, j, k
-!$OMP parallel do default(none) shared(is,ie,js,je,G,GV,hold,eb,T,S,ea) &
-!$OMP private(h_tr,b1,d1,c1,b_denom_1)
+
+ !$OMP parallel do default(shared) private(h_tr,b1,d1,c1,b_denom_1)
do j=js,je
do i=is,ie
h_tr = hold(i,j,1) + GV%H_subroundoff
@@ -515,20 +542,29 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S)
enddo
end subroutine triDiagTS
-!> Calculates u_h and v_h (velocities at thickness points),
-!! optionally using the entrainments (in m) passed in as arguments.
+!> This subroutine calculates u_h and v_h (velocities at thickness
+!! points), optionally using the entrainment amounts passed in as arguments.
subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: u_h, v_h !< zonal and meridional velocity at thickness
- !! points entrainment, in m s-1.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in), optional :: ea, eb !< The amount of fluid entrained
- !! from the layer above within this time step
- !! , in units of m or kg m-2. Omitting ea is the
- !! same as setting it to 0.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: u !< The zonal velocity, in m s-1
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: v !< The meridional velocity, in m s-1
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(out) :: u_h !< Zonal velocity interpolated to h points, in m s-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(out) :: v_h !< Meridional velocity interpolated to h points, in m s-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ optional, intent(in) :: ea !< The amount of fluid entrained from the layer
+ !! above within this time step, in units of H.
+ !! Omitting ea is the same as setting it to 0.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ optional, intent(in) :: eb !< The amount of fluid entrained from the layer
+ !! below within this time step, in units of H.
+ !! Omitting eb is the same as setting it to 0.
! local variables
real :: b_denom_1 ! The first term in the denominator of b1 in m or kg m-2.
@@ -610,36 +646,45 @@ end subroutine find_uv_at_h
!> Diagnose a mixed layer depth (MLD) determined by a given density difference with the surface.
!> This routine is appropriate in MOM_diabatic_driver due to its position within the time stepping.
subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, diagPtr, id_N2subML, id_MLDsq)
- type(ocean_grid_type), intent(in) :: G !< Grid type
- type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
- integer, intent(in) :: id_MLD !< Handle (ID) of MLD diagnostic
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness
- type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics type
- real, intent(in) :: densityDiff !< Density difference to determine MLD (kg/m3)
- type(diag_ctrl), pointer :: diagPtr !< Diagnostics structure
- integer, optional, intent(in) :: id_N2subML !< Optional handle (ID) of subML stratification
- integer, optional, intent(in) :: id_MLDsq !< Optional handle (ID) of squared MLD
+ type(ocean_grid_type), intent(in) :: G !< Grid type
+ type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
+ integer, intent(in) :: id_MLD !< Handle (ID) of MLD diagnostic
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thickness, in H (usually m or kg m-3)
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any
+ !! available thermodynamic fields.
+ real, intent(in) :: densityDiff !< Density difference to determine MLD (kg/m3)
+ type(diag_ctrl), pointer :: diagPtr !< Diagnostics structure
+ integer, optional, intent(in) :: id_N2subML !< Optional handle (ID) of subML stratification
+ integer, optional, intent(in) :: id_MLDsq !< Optional handle (ID) of squared MLD
! Local variables
- real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK, dK, dKm1, pRef_MLD
- real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2
- real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth
- real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML
- real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2
- real, parameter :: dz_subML = 50. ! Depth below ML over which to diagnose stratification (m)
+ real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences, in kg m-3.
+ real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures in Pa.
+ real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths in Z.
+ real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2, in kg m-3.
+ real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in Z.
+ real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML, in s-2.
+ real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in Z2.
+ real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit
+ ! conversion factor, in kg m-1 Z-1 s-2.
+ real :: gE_Rho0 ! The gravitational acceleration divided by a mean density, in m4 s-2 kg-1.
+ real :: dz_subML ! Depth below ML over which to diagnose stratification, in Z.
integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ
real :: aFac, ddRho
- id_N2 = -1
- if (PRESENT(id_N2subML)) id_N2 = id_N2subML
+ id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML
- id_SQ = -1
- if (PRESENT(id_N2subML)) id_SQ = id_MLDsq
+ id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq
+
+ Rho_x_gE = GV%g_Earth * GV%Rho0
+ gE_rho0 = GV%m_to_Z**2 * GV%g_Earth / GV%Rho0
+ dz_subML = 50.*GV%m_to_Z
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
pRef_MLD(:) = 0. ; pRef_N2(:) = 0.
do j=js,je
- do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_m ; enddo ! Depth of center of surface layer
+ 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)
do i=is,ie
deltaRhoAtK(i) = 0.
@@ -648,21 +693,21 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia
subMLN2(i,j) = 0.
rho1(i) = 0.
d1(i) = 0.
- pRef_N2(i) = GV%g_Earth * GV%Rho0 * h(i,j,1) * GV%H_to_m ! Boussinesq approximation!!!! ?????
- !### This should be: pRef_N2(i) = GV%g_Earth * GV%H_to_kg_m2 * h(i,j,1) ! This might change answers at roundoff.
+ pRef_N2(i) = Rho_x_gE * h(i,j,1) * GV%H_to_Z ! Boussinesq approximation!!!! ?????
+ !### This should be: pRef_N2(i) = GV%H_to_Pa * h(i,j,1) ! This might change answers at roundoff.
endif
enddo
do k=2,nz
do i=is,ie
dKm1(i) = dK(i) ! Depth of center of layer K-1
- dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_m ! Depth of center of layer K
+ dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_Z ! Depth of center of layer K
enddo
! Stratification, N2, immediately below the mixed layer, averaged over at least 50 m.
if (id_N2>0) then
do i=is,ie
- pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ?????
- !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k)
+ pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ?????
+ !### This should be: pRef_N2(i) = pRev_N2(i) + GV%H_to_Pa * h(i,j,k)
!### This might change answers at roundoff.
enddo
call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_N2, rhoAtK, is, ie-is+1, tv%eqn_of_state)
@@ -673,12 +718,12 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia
d1(i) = dK(i)
!### It looks to me like there is bad logic here. - RWH
! Use pressure at the bottom of the upper layer used in calculating d/dz rho
- pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ?????
- !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k)
+ pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ?????
+ !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%H_to_Pa * h(i,j,k)
!### This might change answers at roundoff.
endif
if (d1(i)>0. .and. dK(i)-d1(i)>=dz_subML) then
- subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i))
+ subMLN2(i,j) = gE_rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i))
endif
endif
enddo ! i-loop
@@ -702,7 +747,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia
if ((MLD(i,j)==0.) .and. (deltaRhoAtK(i)0 .and. subMLN2(i,j)==0. .and. d1(i)>0. .and. dK(i)-d1(i)>0.) then
! ! Use what ever stratification we can, measured over what ever distance is available
- ! subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i))
+ ! subMLN2(i,j) = gE_rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i))
! endif
enddo
enddo ! j-loop
@@ -720,28 +765,32 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, &
aggregate_FW_forcing, evap_CFL_limit, &
minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, &
SkinBuoyFlux )
- type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux
- type(ocean_grid_type), intent(in) :: G !< Grid structure
- type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
- real, intent(in) :: dt !< Time-step over which forcing is applied (s)
- type(forcing), intent(inout) :: fluxes !< Surface fluxes container
- type(optics_type), pointer :: optics !< Optical properties container
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units
- type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics container
- !> If False, treat in/out fluxes separately.
- logical, intent(in) :: aggregate_FW_forcing
- !> The largest fraction of a layer that can be evaporated in one time-step (non-dim).
- real, intent(in) :: evap_CFL_limit
- !> The smallest depth over which heat and freshwater fluxes is applied, in m.
- real, intent(in) :: minimum_forcing_depth
- !> Turbulent kinetic energy requirement to mix forcing through each layer, in W m-2
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: cTKE
- !> Partial derivative of specific volume with potential temperature, in m3 kg-1 K-1.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: dSV_dT
- !> Partial derivative of specific a volume with potential salinity, in m3 kg-1 / (g kg-1).
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: dSV_dS
- !> Buoyancy flux at surface in m2 s-3
- real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: SkinBuoyFlux
+ type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux
+ type(ocean_grid_type), intent(in) :: G !< Grid structure
+ type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
+ real, intent(in) :: dt !< Time-step over which forcing is applied (s)
+ type(forcing), intent(inout) :: fluxes !< Surface fluxes container
+ type(optics_type), pointer :: optics !< Optical properties container
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: h !< Layer thickness in H units
+ type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any
+ !! available thermodynamic fields.
+ logical, intent(in) :: aggregate_FW_forcing !< If False, treat in/out fluxes separately.
+ real, intent(in) :: evap_CFL_limit !< The largest fraction of a layer that
+ !! can be evaporated in one time-step (non-dim).
+ real, intent(in) :: minimum_forcing_depth !< The smallest depth over which
+ !! heat and freshwater fluxes is applied, in m.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ optional, intent(out) :: cTKE !< Turbulent kinetic energy requirement to mix
+ !! forcing through each layer, in W m-2
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ optional, intent(out) :: dSV_dT !< Partial derivative of specific volume with
+ !! potential temperature, in m3 kg-1 K-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with
+ !! salinity, in m3 kg-1 / (g kg-1).
+ real, dimension(SZI_(G),SZJ_(G)), &
+ optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface in Z2 s-3
! Local variables
integer, parameter :: maxGroundings = 5
@@ -775,8 +824,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, &
real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand
real :: hGrounding(maxGroundings)
real :: Temp_in, Salin_in
- real :: I_G_Earth, g_Hconv2
- real :: GoRho
+! real :: I_G_Earth
+ real :: g_Hconv2
+ real :: GoRho ! g_Earth times a unit conversion factor divided by density, in Z m3 s-2 kg-1
logical :: calculate_energetics
logical :: calculate_buoyancy
integer :: i, j, is, ie, js, je, k, nz, n, nsw
@@ -795,8 +845,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, &
calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS))
calculate_buoyancy = present(SkinBuoyFlux)
if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0
- I_G_Earth = 1.0 / GV%g_Earth
- g_Hconv2 = GV%g_Earth * GV%H_to_kg_m2**2
+! I_G_Earth = 1.0 / GV%g_Earth
+ g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2
if (present(cTKE)) cTKE(:,:,:) = 0.0
if (calculate_buoyancy) then
@@ -811,7 +861,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, &
! To accommodate vanishing upper layers, we need to allow for an instantaneous
! distribution of forcing over some finite vertical extent. The bulk mixed layer
! code handles this issue properly.
- H_limit_fluxes = max(GV%Angstrom, 1.E-30*GV%m_to_H)
+ H_limit_fluxes = max(GV%Angstrom_H, 1.E-30*GV%m_to_H)
! diagnostic to see if need to create mass to avoid grounding
if (CS%id_createdH>0) CS%createdH(:,:) = 0.
@@ -854,7 +904,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, &
do i=is,ie ; pres(i) = 0.0 ; enddo ! Add surface pressure?
do k=1,nz
do i=is,ie
- d_pres(i) = GV%g_Earth * GV%H_to_kg_m2 * h2d(i,k)
+ d_pres(i) = GV%H_to_Pa * h2d(i,k)
p_lay(i) = pres(i) + 0.5*d_pres(i)
pres(i) = pres(i) + d_pres(i)
enddo
@@ -862,8 +912,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, &
dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state)
do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo
! do i=is,ie
-! dT_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dT(i,j,k)
-! dS_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dS(i,j,k)
+! dT_to_dPE(i,k) = I_G_Earth * GV%Z_to_m * d_pres(i) * p_lay(i) * dSV_dT(i,j,k)
+! dS_to_dPE(i,k) = I_G_Earth * GV%Z_to_m * d_pres(i) * p_lay(i) * dSV_dS(i,j,k)
! enddo
enddo
pen_TKE_2d(:,:) = 0.0
@@ -989,7 +1039,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, &
! rivermix_depth = The prescribed depth over which to mix river inflow
! drho_ds = The gradient of density wrt salt at the ambient surface salinity.
! Sriver = 0 (i.e. rivers are assumed to be pure freshwater)
- RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%m_to_H*GV%H_to_Pa
+ RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%Z_to_H*GV%H_to_Pa
cTKE(i,j,k) = cTKE(i,j,k) + max(0.0, RivermixConst*dSV_dS(i,j,1) * &
(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * tv%S(i,j,1))
@@ -1056,7 +1106,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, &
tv%T(i,j,k) * min(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt
if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + &
tv%T(i,j,k) * dThickness * GV%H_to_kg_m2
-!NOTE tv%T should be T2d
+!### NOTE: tv%T should be T2d in the expressions above.
! Update state by the appropriate increment.
hOld = h2d(i,k) ! Keep original thickness in hand
@@ -1206,7 +1256,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, &
! 3. Convert to a buoyancy flux, excluding penetrating SW heating
! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL.
do i=is,ie
- SkinBuoyFlux(i,j) = - GoRho * GV%H_to_m * ( &
+ SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * GV%m_to_Z**2 * ( &
dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + &
dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3
enddo
@@ -1239,25 +1289,24 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, &
end subroutine applyBoundaryFluxesInOut
-!> Initializes this module.
+!> This subroutine initializes the parameters and control structure of the diabatic_aux module.
subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, use_ePBL)
- type(time_type), intent(in) :: Time
+ type(time_type), intent(in) :: Time !< The current model time
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- type(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output
- type(diabatic_aux_CS), pointer :: CS !< pointer set to point to the ontrol structure for
- !! this module
- logical, intent(in) :: useALEalgorithm !< If True, uses ALE.
- logical, intent(in) :: use_ePBL !< If true, use the implicit energetics
- !! planetary boundary layer scheme to determine the
- !! diffusivity in the surface boundary layer.
- ! local variables
- type(vardesc) :: vd
+ type(diag_ctrl), target, intent(inout) :: diag !< A structure used to regulate diagnostic output
+ type(diabatic_aux_CS), pointer :: CS !< A pointer to the control structure for the
+ !! diabatic_aux module, which is initialized here.
+ logical, intent(in) :: useALEalgorithm !< If true, use the ALE algorithm rather
+ !! than layered mode.
+ logical, intent(in) :: use_ePBL !< If true, use the implicit energetics planetary
+ !! boundary layer scheme to determine the diffusivity
+ !! in the surface boundary layer.
! This "include" declares and sets the variable "version".
#include "version_variable.h"
- character(len=40) :: mod = "MOM_diabatic_aux" ! This module's name.
+ character(len=40) :: mdl = "MOM_diabatic_aux" ! This module's name.
character(len=48) :: thickness_units
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke
@@ -1274,15 +1323,15 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm,
CS%diag => diag
! Set default, read and log parameters
- call log_version(param_file, mod, version, &
+ call log_version(param_file, mdl, version, &
"The following parameters are used for auxiliary diabatic processes.")
- call get_param(param_file, mod, "RECLAIM_FRAZIL", CS%reclaim_frazil, &
+ call get_param(param_file, mdl, "RECLAIM_FRAZIL", CS%reclaim_frazil, &
"If true, try to use any frazil heat deficit to cool any\n"//&
"overlying layers down to the freezing point, thereby \n"//&
"avoiding the creation of thin ice when the SST is above \n"//&
"the freezing point.", default=.true.)
- call get_param(param_file, mod, "PRESSURE_DEPENDENT_FRAZIL", &
+ call get_param(param_file, mdl, "PRESSURE_DEPENDENT_FRAZIL", &
CS%pressure_dependent_frazil, &
"If true, use a pressure dependent freezing temperature \n"//&
"when making frazil. The default is false, which will be \n"//&
@@ -1290,27 +1339,27 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm,
default=.false.)
if (use_ePBL) then
- call get_param(param_file, mod, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,&
+ call get_param(param_file, mdl, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,&
"If true, the model does not check if fluxes are being applied\n"//&
"over land points. This is needed when the ocean is coupled \n"//&
"with ice shelves and sea ice, since the sea ice mask needs to \n"//&
"be different than the ocean mask to avoid sea ice formation \n"//&
"under ice shelves. This flag only works when use_ePBL = True.", default=.false.)
- call get_param(param_file, mod, "DO_RIVERMIX", CS%do_rivermix, &
+ call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, &
"If true, apply additional mixing whereever there is \n"//&
"runoff, so that it is mixed down to RIVERMIX_DEPTH \n"//&
"if the ocean is that deep.", default=.false.)
if (CS%do_rivermix) &
- call get_param(param_file, mod, "RIVERMIX_DEPTH", CS%rivermix_depth, &
+ call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, &
"The depth to which rivers are mixed if DO_RIVERMIX is \n"//&
- "defined.", units="m", default=0.0)
+ "defined.", units="m", default=0.0, scale=GV%m_to_Z)
else ; CS%do_rivermix = .false. ; CS%rivermix_depth = 0.0 ; endif
if (GV%nkml == 0) then
- call get_param(param_file, mod, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, &
+ call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, &
"If true, use the fluxes%runoff_Hflx field to set the \n"//&
"heat carried by runoff, instead of using SST*CP*liq_runoff.", &
default=.false.)
- call get_param(param_file, mod, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, &
+ call get_param(param_file, mdl, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, &
"If true, use the fluxes%calving_Hflx field to set the \n"//&
"heat carried by runoff, instead of using SST*CP*froz_runoff.", &
default=.false.)
@@ -1360,9 +1409,11 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm,
end subroutine diabatic_aux_init
-
+!> This subroutine initializes the control structure and any related memory
+!! for the diabatic_aux module.
subroutine diabatic_aux_end(CS)
- type(diabatic_aux_CS), pointer :: CS
+ type(diabatic_aux_CS), pointer :: CS !< The control structure returned by a previous
+ !! call to diabatic_aux_init; it is deallocated here.
if (.not.associated(CS)) return
@@ -1375,48 +1426,34 @@ subroutine diabatic_aux_end(CS)
end subroutine diabatic_aux_end
-!> \namespace MOM_diabatic_aux
+!> \namespace mom_diabatic_aux
+!!
+!! This module contains the subroutines that, along with the
+!! subroutines that it calls, implements diapycnal mass and momentum
+!! fluxes and a bulk mixed layer. The diapycnal diffusion can be
+!! used without the bulk mixed layer.
+!!
+!! diabatic first determines the (diffusive) diapycnal mass fluxes
+!! based on the convergence of the buoyancy fluxes within each layer.
+!! The dual-stream entrainment scheme of MacDougall and Dewar (JPO,
+!! 1997) is used for combined diapycnal advection and diffusion,
+!! calculated implicitly and potentially with the Richardson number
+!! dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal
+!! advection is fundamentally the residual of diapycnal diffusion,
+!! so the fully implicit upwind differencing scheme that is used is
+!! entirely appropriate. The downward buoyancy flux in each layer
+!! is determined from an implicit calculation based on the previously
+!! calculated flux of the layer above and an estimated flux in the
+!! layer below. This flux is subject to the following conditions:
+!! (1) the flux in the top and bottom layers are set by the boundary
+!! conditions, and (2) no layer may be driven below an Angstrom thick-
+!! ness. If there is a bulk mixed layer, the buffer layer is treat-
+!! ed as a fixed density layer with vanishingly small diffusivity.
!!
-!! This module contains the subroutines that, along with the *
-!! subroutines that it calls, implements diapycnal mass and momentum *
-!! fluxes and a bulk mixed layer. The diapycnal diffusion can be *
-!! used without the bulk mixed layer. *
-!! *
-!! diabatic first determines the (diffusive) diapycnal mass fluxes *
-!! based on the convergence of the buoyancy fluxes within each layer. *
-!! The dual-stream entrainment scheme of MacDougall and Dewar (JPO, *
-!! 1997) is used for combined diapycnal advection and diffusion, *
-!! calculated implicitly and potentially with the Richardson number *
-!! dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal *
-!! advection is fundamentally the residual of diapycnal diffusion, *
-!! so the fully implicit upwind differencing scheme that is used is *
-!! entirely appropriate. The downward buoyancy flux in each layer *
-!! is determined from an implicit calculation based on the previously *
-!! calculated flux of the layer above and an estimated flux in the *
-!! layer below. This flux is subject to the following conditions: *
-!! (1) the flux in the top and bottom layers are set by the boundary *
-!! conditions, and (2) no layer may be driven below an Angstrom thick-*
-!! ness. If there is a bulk mixed layer, the buffer layer is treat- *
-!! ed as a fixed density layer with vanishingly small diffusivity. *
-!! *
-!! diabatic takes 5 arguments: the two velocities (u and v), the *
-!! thicknesses (h), a structure containing the forcing fields, and *
-!! the length of time over which to act (dt). The velocities and *
-!! thickness are taken as inputs and modified within the subroutine. *
-!! There is no limit on the time step. *
-!! *
-!! A small fragment of the grid is shown below: *
-!! *
-!! j+1 x ^ x ^ x At x: q *
-!! j+1 > o > o > At ^: v *
-!! j x ^ x ^ x At >: u *
-!! j > o > o > At o: h, T, S, buoy, ustar, ea, eb, etc. *
-!! j-1 x ^ x ^ x *
-!! i-1 i i+1 At x & ^: *
-!! i i+1 At > & o: *
-!! *
-!! The boundaries always run through q grid points (x). *
-!! *
-!!********+*********+*********+*********+*********+*********+*********+**
+!! diabatic takes 5 arguments: the two velocities (u and v), the
+!! thicknesses (h), a structure containing the forcing fields, and
+!! the length of time over which to act (dt). The velocities and
+!! thickness are taken as inputs and modified within the subroutine.
+!! There is no limit on the time step.
end module MOM_diabatic_aux
diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90
index f253687821..2e4ee0835b 100644
--- a/src/parameterizations/vertical/MOM_diabatic_driver.F90
+++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90
@@ -61,8 +61,7 @@ module MOM_diabatic_driver
use MOM_shortwave_abs, only : absorbRemainingSW, optics_type
use MOM_sponge, only : apply_sponge, sponge_CS
use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS
-use MOM_time_manager, only : operator(-), set_time
-use MOM_time_manager, only : operator(<=), time_type ! for testing itides (BDM)
+use MOM_time_manager, only : time_type, real_to_time, operator(-), operator(<=)
use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS
use MOM_tracer_diabatic, only : tracer_vertdiff
use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs
@@ -92,6 +91,8 @@ module MOM_diabatic_driver
logical :: use_energetic_PBL !< If true, use the implicit energetics planetary
!! boundary layer scheme to determine the diffusivity
!! in the surface boundary layer.
+ logical :: use_KPP !< If true, use CVMix/KPP boundary layer scheme to determine the
+ !! OBLD and the diffusivities within this layer.
logical :: use_kappa_shear !< If true, use the kappa_shear module to find the
!! shear-driven diapycnal diffusivity.
logical :: use_CVMix_shear !< If true, use the CVMix module to find the
@@ -146,16 +147,17 @@ module MOM_diabatic_driver
!! operating.
real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that
!! will allow for explicitly specified bottom fluxes
- !! in m2 s-1. The entrainment at the bottom is at
+ !! in Z2 s-1. The entrainment at the bottom is at
!! least sqrt(Kd_BBL_tr*dt) over the same distance.
real :: Kd_min_tr !< A minimal diffusivity that should always be
!! applied to tracers, especially in massless layers
- !! near the bottom, in m2 s-1.
+ !! near the bottom, in Z2 s-1.
real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater
- !! fluxes is applied, in m.
+ !! fluxes are applied, in m.
real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be
!! evaporated in one time-step (non-dim).
-
+ integer :: halo_TS_diff = 0 !< The temperature, salinity and thickness halo size that
+ !! must be valid for the diffusivity calculations.
logical :: useKPP = .false. !< use CVMix/KPP diffusivities and non-local transport
logical :: salt_reject_below_ML !< If true, add salt below mixed layer (layer mode only)
logical :: KPPisPassive !< If true, KPP is in passive mode, not changing answers.
@@ -163,11 +165,12 @@ module MOM_diabatic_driver
logical :: debugConservation !< If true, monitor conservation and extrema.
logical :: tracer_tridiag !< If true, use tracer_vertdiff instead of tridiagTS for
!< vertical diffusion of T and S
- logical :: debug_energy_req ! If true, test the mixing energy requirement code.
+ logical :: debug_energy_req !< If true, test the mixing energy requirement code.
type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output
real :: MLDdensityDifference !< Density difference used to determine MLD_user
integer :: nsw !< SW_NBANDS
+ !>@{ Diagnostic IDs
integer :: id_cg1 = -1 ! diag handle for mode-1 speed (BDM)
integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds (BDM)
integer :: id_wd = -1, id_ea = -1, id_eb = -1 ! used by layer diabatic
@@ -190,7 +193,6 @@ module MOM_diabatic_driver
integer :: id_diabatic_diff_heat_tend_2d = -1
integer :: id_diabatic_diff_salt_tend_2d = -1
integer :: id_diabatic_diff_h= -1
- logical :: diabatic_diff_tendency_diag = .false.
integer :: id_boundary_forcing_h = -1
integer :: id_boundary_forcing_h_tendency = -1
@@ -200,38 +202,39 @@ module MOM_diabatic_driver
integer :: id_boundary_forcing_salt_tend = -1
integer :: id_boundary_forcing_heat_tend_2d = -1
integer :: id_boundary_forcing_salt_tend_2d = -1
- logical :: boundary_forcing_tendency_diag = .false.
integer :: id_frazil_h = -1
integer :: id_frazil_temp_tend = -1
integer :: id_frazil_heat_tend = -1
integer :: id_frazil_heat_tend_2d = -1
- logical :: frazil_tendency_diag = .false.
+ !!@}
+
+ logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics
+ logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics
+ logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics
real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil
real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil
- real :: ppt2mks = 0.001
-
- type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL()
- type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL()
- type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL()
- type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL()
- type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL()
- type(geothermal_CS), pointer :: geothermal_CSp => NULL()
- type(int_tide_CS), pointer :: int_tide_CSp => NULL()
- type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL()
- type(int_tide_input_type), pointer :: int_tide_input => NULL()
- type(opacity_CS), pointer :: opacity_CSp => NULL()
- type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL()
- type(sponge_CS), pointer :: sponge_CSp => NULL()
- type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL()
- type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL()
- type(optics_type), pointer :: optics => NULL()
- type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL()
- type(KPP_CS), pointer :: KPP_CSp => NULL()
- type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL()
- type(CVMix_conv_cs), pointer :: CVMix_conv_csp => NULL()
- type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL()
+ type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module
+ type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL() !< Control structure for a child module
+ type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module
+ type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module
+ type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module
+ type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module
+ type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module
+ type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module
+ type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module
+ type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module
+ type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module
+ type(sponge_CS), pointer :: sponge_CSp => NULL() !< Control structure for a child module
+ type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() !< Control structure for a child module
+ type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< Control structure for a child module
+ type(optics_type), pointer :: optics => NULL() !< Control structure for a child module
+ type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() !< Control structure for a child module
+ type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module
+ type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() !< Control structure for a child module
+ type(CVMix_conv_cs), pointer :: CVMix_conv_csp => NULL() !< Control structure for a child module
+ type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module
type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass
type(group_pass_type) :: pass_Kv !< For group halo pass
@@ -265,7 +268,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss)
type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields
!! unused have NULL ptrs
- real, dimension(:,:), pointer :: Hml !< active mixed layer depth
+ real, dimension(:,:), pointer :: Hml !< mixed layer depth, m
type(forcing), intent(inout) :: fluxes !< points to forcing fields
!! unused fields have NULL ptrs
type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and
@@ -288,9 +291,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
! one time step (m for Bouss, kg/m^2 for non-Bouss)
eb_t, & ! amount of fluid entrained from the layer below within
! one time step (m for Bouss, kg/m^2 for non-Bouss)
- Kd, & ! diapycnal diffusivity of layers (m^2/sec)
+ Kd_lay, & ! diapycnal diffusivity of layers (Z^2/sec)
h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss)
- h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss)
+ h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss)
! hold, & ! layer thickness before diapycnal entrainment, and later
! the initial layer thicknesses (if a mixed layer is used),
! (m for Bouss, kg/m^2 for non-Bouss)
@@ -299,13 +302,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
cTKE, & ! convective TKE requirements for each layer in J/m^2.
u_h, & ! zonal and meridional velocities at thickness points after
v_h ! entrainment (m/s)
-
real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: &
- cn ! baroclinic gravity wave speeds (formerly cg1 - BDM)
-
+ cn ! baroclinic gravity wave speeds
real, dimension(SZI_(G),SZJ_(G)) :: &
Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges
- SkinBuoyFlux! 2d surface buoyancy flux (m2/s3), used by ePBL
+ SkinBuoyFlux! 2d surface buoyancy flux (Z2/s3), used by ePBL
real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness
real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp
real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity
@@ -318,13 +319,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
! These are targets so that the space can be shared with eaml & ebml.
eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and
ebtr ! eb in that they tend to homogenize tracers in massless layers
- ! near the boundaries (m for Bouss and kg/m^2 for non-Bouss)
+ ! near the boundaries in H (m for Bouss and kg/m^2 for non-Bouss)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: &
Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s)
- Kd_heat, & ! diapycnal diffusivity of heat (m^2/s)
- Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s)
- Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s)
+ Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s)
+ Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s)
+ Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s)
eta, & ! Interface heights before diapycnal mixing, in m.
Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s)
Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s)
@@ -333,7 +334,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
! The following 5 variables are only used with a bulk mixed layer.
real, pointer, dimension(:,:,:) :: &
- eaml, & ! The equivalent of ea and eb due to mixed layer processes,
+ eaml, & ! The equivalent of ea and eb due to mixed layer processes, in H
ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be
! pointers to eatr and ebtr so as to reuse the memory as
! the arrays are not needed at the same time.
@@ -365,7 +366,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is
! coupled to the bottom within a timestep (m)
- real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in m.
+ real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in H.
real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the
real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver.
@@ -379,11 +380,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth
integer :: dir_flag ! An integer encoding the directions in which to do halo updates.
logical :: showCallTree ! If true, show the call tree
- integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m
+ 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)
logical :: avg_enabled ! for testing internal tides (BDM)
- real :: Kd_add_here ! An added diffusivity in m2/s
+ real :: Kd_add_here ! An added diffusivity in Z2/s
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
@@ -406,7 +407,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag)
if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag)
if (CS%id_e_predia > 0) then
- call find_eta(h, tv, GV%g_Earth, G, GV, eta)
+ call find_eta(h, tv, G, GV, eta, eta_to_m=1.0)
call post_data(CS%id_e_predia, eta, CS%diag)
endif
@@ -439,7 +440,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
! the end of the diabatic processes.
if (associated(tv%T) .AND. associated(tv%frazil)) then
! For frazil diagnostic, the first call covers the first half of the time step
- call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag)
+ call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag)
if (CS%frazil_tendency_diag) then
do k=1,nz ; do j=js,je ; do i=is,ie
temp_diag(i,j,k) = tv%T(i,j,k)
@@ -447,9 +448,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
endif
if (associated(fluxes%p_surf_full)) then
- call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full)
+ call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff)
else
- call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp)
+ call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff)
endif
if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)")
@@ -465,15 +466,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G)
if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then
-!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml)
- do k=1,nz ; do j=js,je ; do i=is,ie
+ halo = CS%halo_TS_diff
+ !$OMP parallel do default(shared)
+ do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo
h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0
enddo ; enddo ; enddo
endif
if (CS%use_geothermal) then
call cpu_clock_begin(id_clock_geothermal)
- call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp)
+ call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff)
call cpu_clock_end(id_clock_geothermal)
if (showCallTree) call callTree_waypoint("geothermal (diabatic)")
if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G)
@@ -551,41 +553,40 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
endif ! end CS%use_int_tides
call cpu_clock_begin(id_clock_set_diffusivity)
- ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S
+ ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S
! Also changes: visc%Kd_shear, visc%Kv_slow and visc%TKE_turb (not clear that TKE_turb is used as input ????
- call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int)
+ call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, &
+ Kd_lay, Kd_int)
call cpu_clock_end(id_clock_set_diffusivity)
if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)")
! Set diffusivities for heat and salt separately
-!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat)
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
- Kd_salt(i,j,k) = Kd_int(i,j,k)
- Kd_heat(i,j,k) = Kd_int(i,j,k)
+ Kd_salt(i,j,k) = Kd_int(i,j,K)
+ Kd_heat(i,j,k) = Kd_int(i,j,K)
enddo ; enddo ; enddo
! Add contribution from double diffusion
if (associated(visc%Kd_extra_S)) then
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k)
enddo ; enddo ; enddo
endif
if (associated(visc%Kd_extra_T)) then
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k)
enddo ; enddo ; enddo
endif
-!$OMP end parallel
if (CS%debug) then
call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0)
call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0)
call MOM_thermovar_chksum("after set_diffusivity ", tv, G)
- call hchksum(Kd_heat, "after set_diffusivity Kd_heat",G%HI,haloshift=0)
- call hchksum(Kd_salt, "after set_diffusivity Kd_salt",G%HI,haloshift=0)
+ call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=GV%Z_to_m**2)
+ call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=GV%Z_to_m**2)
endif
if (CS%useKPP) then
@@ -609,11 +610,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, &
Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves)
-!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml)
if (associated(Hml)) then
+ !$OMP parallel default(shared)
call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G)
+ !$OMP end parallel
call pass_var(Hml, G%domain, halo=1)
+ ! If visc%MLD exists, copy KPP's BLD into it
+ if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:)
endif
call cpu_clock_end(id_clock_kpp)
@@ -622,8 +626,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0)
call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0)
call MOM_thermovar_chksum("after KPP", tv, G)
- call hchksum(Kd_heat, "after KPP Kd_heat",G%HI,haloshift=0)
- call hchksum(Kd_salt, "after KPP Kd_salt",G%HI,haloshift=0)
+ call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%Z_to_m**2)
+ call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%Z_to_m**2)
endif
endif ! endif for KPP
@@ -667,13 +671,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
! increment heat and salt diffusivity.
! CS%useKPP==.true. already has extra_T and extra_S included
if (.not. CS%useKPP) then
-!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,Kd_heat)
-!$OMP do
+ !$OMP parallel do default(shared)
do K=2,nz ; do j=js,je ; do i=is,ie
Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K)
Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K)
enddo ; enddo ; enddo
-!$OMP end parallel
endif
endif
@@ -682,8 +684,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
if (CS%use_CVMix_conv) then
call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml)
! Increment vertical diffusion and viscosity due to convection
-!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,CS,Kd_heat)
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k)
Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k)
@@ -693,7 +694,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k)
endif
enddo ; enddo ; enddo
-!$OMP end parallel
endif
! Save fields before boundary forcing is applied for tendency diagnostics
@@ -733,15 +733,19 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, &
CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves)
- ! If visc%MLD exists, copy the ePBL's MLD into it
- if (associated(visc%MLD)) then
- call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G)
+ if (associated(Hml)) then
+ call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, GV)
+ call pass_var(Hml, G%domain, halo=1)
+ ! If visc%MLD exists, copy ePBL's MLD into it
+ if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:)
+ elseif (associated(visc%MLD)) then
+ call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, GV)
call pass_var(visc%MLD, G%domain, halo=1)
- Hml(:,:) = visc%MLD(:,:)
endif
! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL.
do K=2,nz ; do j=js,je ; do i=is,ie
+ !### These expressesions assume a Prandtl number of 1.
if (CS%ePBL_is_additive) then
Kd_add_here = Kd_ePBL(i,j,K)
visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K)
@@ -760,7 +764,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m)
call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m)
call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m)
- call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0)
+ call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%Z_to_m**2)
endif
else
@@ -825,17 +829,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
ea_t(i,j,1) = 0.; ea_s(i,j,1) = 0.
enddo ; enddo
-!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea_t,ea_s,GV,dt,Kd_salt,Kd_heat,eb_t,eb_s) &
-!$OMP private(hval)
+ !$OMP parallel do default(shared) private(hval)
do k=2,nz ; do j=js,je ; do i=is,ie
- hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k)))
- ea_t(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_heat(i,j,k)
+ hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k)))
+ ea_t(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_heat(i,j,k)
eb_t(i,j,k-1) = ea_t(i,j,k)
- ea_s(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_salt(i,j,k)
+ ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_salt(i,j,k)
eb_s(i,j,k-1) = ea_s(i,j,k)
enddo ; enddo ; enddo
do j=js,je ; do i=is,ie
- eb_t(i,j,nz) = 0.; eb_s(i,j,nz) = 0.
+ eb_t(i,j,nz) = 0. ; eb_s(i,j,nz) = 0.
enddo ; enddo
if (showCallTree) call callTree_waypoint("done setting ea_t,ea_s,eb_t,eb_s from Kd_heat" //&
"and Kd_salt (diabatic)")
@@ -917,7 +920,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
call cpu_clock_begin(id_clock_tracers)
if (CS%mix_boundary_tracers) then
- Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr)
+ Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr)
!$OMP parallel do default(shared) private(htot,in_boundary,add_ent)
do j=js,je
do i=is,ie
@@ -934,9 +937,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
! thicknesses, as this corresponds pretty closely (to within
! differences in the density jumps between layers) with what is done
! in the calculation of the fluxes in the first place. Kd_min_tr
- ! should be much less than the values that have been set in Kd,
+ ! should be much less than the values that have been set in Kd_lay,
! perhaps a molecular diffusivity.
- add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * &
+ add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * &
((h(i,j,k-1)+h(i,j,k)+h_neglect) / &
(h(i,j,k-1)*h(i,j,k)+h_neglect2)) - &
0.5*(ea_s(i,j,k) + eb_s(i,j,k-1))
@@ -954,7 +957,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
endif
if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then
- add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / &
+ add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / &
(0.5 * (h(i,j,k-1) + h(i,j,k)) + &
h_neglect)
ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent
@@ -980,7 +983,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
!$OMP parallel do default(shared) private(add_ent)
do k=nz,2,-1 ; do j=js,je ; do i=is,ie
if (visc%Kd_extra_S(i,j,k) > 0.0) then
- add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / &
+ add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / &
(0.5 * (h(i,j,k-1) + h(i,j,k)) + &
h_neglect)
else
@@ -1166,9 +1169,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
! one time step (m for Bouss, kg/m^2 for non-Bouss)
eb, & ! amount of fluid entrained from the layer below within
! one time step (m for Bouss, kg/m^2 for non-Bouss)
- Kd, & ! diapycnal diffusivity of layers (m^2/sec)
+ Kd_lay, & ! diapycnal diffusivity of layers (Z^2/sec)
h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss)
- h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss)
+ h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss)
hold, & ! layer thickness before diapycnal entrainment, and later
! the initial layer thicknesses (if a mixed layer is used),
! (m for Bouss, kg/m^2 for non-Bouss)
@@ -1200,9 +1203,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: &
Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s)
- Kd_heat, & ! diapycnal diffusivity of heat (m^2/s)
- Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s)
- Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s)
+ Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s)
+ Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s)
+ Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s)
eta, & ! Interface heights before diapycnal mixing, in m.
Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s)
Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s)
@@ -1257,11 +1260,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth
integer :: dir_flag ! An integer encoding the directions in which to do halo updates.
logical :: showCallTree ! If true, show the call tree
- integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m
+ 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)
logical :: avg_enabled ! for testing internal tides (BDM)
- real :: Kd_add_here ! An added diffusivity in m2/s
+ real :: Kd_add_here ! An added diffusivity in Z2/s
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
@@ -1282,7 +1285,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag)
if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag)
if (CS%id_e_predia > 0) then
- call find_eta(h, tv, GV%g_Earth, G, GV, eta)
+ call find_eta(h, tv, G, GV, eta, eta_to_m=1.0)
call post_data(CS%id_e_predia, eta, CS%diag)
endif
@@ -1314,7 +1317,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
! the end of the diabatic processes.
if (associated(tv%T) .AND. associated(tv%frazil)) then
! For frazil diagnostic, the first call covers the first half of the time step
- call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag)
+ call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag)
if (CS%frazil_tendency_diag) then
do k=1,nz ; do j=js,je ; do i=is,ie
temp_diag(i,j,k) = tv%T(i,j,k)
@@ -1322,9 +1325,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
endif
if (associated(fluxes%p_surf_full)) then
- call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full)
+ call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff)
else
- call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp)
+ call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff)
endif
if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)")
@@ -1339,15 +1342,16 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G)
if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then
-!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml)
- do k=1,nz ; do j=js,je ; do i=is,ie
+ halo = CS%halo_TS_diff
+ !$OMP parallel do default(shared)
+ do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo
h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0
enddo ; enddo ; enddo
endif
if (CS%use_geothermal) then
call cpu_clock_begin(id_clock_geothermal)
- call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp)
+ call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff)
call cpu_clock_end(id_clock_geothermal)
if (showCallTree) call callTree_waypoint("geothermal (diabatic)")
if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G)
@@ -1474,10 +1478,16 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
endif
call cpu_clock_begin(id_clock_set_diffusivity)
- ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S
+ ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S
! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????
! And sets visc%Kv_shear
- call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int)
+ if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then
+ if (associated(tv%T)) call pass_var(tv%T, G%Domain, halo=CS%halo_TS_diff, complete=.false.)
+ if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.)
+ call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.)
+ endif
+ call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, &
+ Kd_lay, Kd_int)
call cpu_clock_end(id_clock_set_diffusivity)
if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)")
@@ -1485,8 +1495,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0)
call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0)
call MOM_thermovar_chksum("after set_diffusivity ", tv, G)
- call hchksum(Kd, "after set_diffusivity Kd",G%HI,haloshift=0)
- call hchksum(Kd_Int, "after set_diffusivity Kd_Int",G%HI,haloshift=0)
+ call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2)
+ call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0)
endif
@@ -1501,65 +1511,64 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux)
! The KPP scheme calculates boundary layer diffusivities and non-local transport.
-!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat)
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
- Kd_salt(i,j,k) = Kd_int(i,j,k)
- Kd_heat(i,j,k) = Kd_int(i,j,k)
+ Kd_salt(i,j,k) = Kd_int(i,j,K)
+ Kd_heat(i,j,k) = Kd_int(i,j,K)
enddo ; enddo ; enddo
if (associated(visc%Kd_extra_S)) then
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k)
enddo ; enddo ; enddo
endif
if (associated(visc%Kd_extra_T)) then
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k)
enddo ; enddo ; enddo
endif
-!$OMP end parallel
call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, &
fluxes%ustar, CS%KPP_buoy_flux)
call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, &
Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves)
-!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml)
if (associated(Hml)) then
call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G)
call pass_var(Hml, G%domain, halo=1)
+ ! If visc%MLD exists, copy KPP's BLD into it
+ if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:)
endif
if (.not. CS%KPPisPassive) then
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
- Kd_int(i,j,k) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) )
+ Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) )
enddo ; enddo ; enddo
if (associated(visc%Kd_extra_S)) then
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
- visc%Kd_extra_S(i,j,k) = Kd_salt(i,j,k) - Kd_int(i,j,k)
+ visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K))
enddo ; enddo ; enddo
endif
if (associated(visc%Kd_extra_T)) then
-!$OMP do
+ !$OMP parallel do default(shared)
do k=1,nz+1 ; do j=js,je ; do i=is,ie
- visc%Kd_extra_T(i,j,k) = Kd_heat(i,j,k) - Kd_int(i,j,k)
+ visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K))
enddo ; enddo ; enddo
endif
endif ! not passive
-!$OMP end parallel
+
call cpu_clock_end(id_clock_kpp)
if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)")
if (CS%debug) then
call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0)
call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0)
call MOM_thermovar_chksum("after KPP", tv, G)
- call hchksum(Kd, "after KPP Kd",G%HI,haloshift=0)
- call hchksum(Kd_Int, "after KPP Kd_Int",G%HI,haloshift=0)
+ call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2)
+ call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0)
endif
endif ! endif for KPP
@@ -1568,12 +1577,13 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
if (CS%use_CVMix_conv) then
call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml)
- !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- do k=1,nz ; do j=js,je ; do i=is,ie
- Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k)
- visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k)
- enddo ; enddo ; enddo
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1.
+ do k=1,nz ; do j=js,je ; do i=is,ie
+ Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,k)
+ visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k)
+ enddo ; enddo ; enddo
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
endif
@@ -1637,7 +1647,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
!$OMP private(hval)
do k=2,nz ; do j=js,je ; do i=is,ie
hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k)))
- ea(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_int(i,j,k)
+ ea(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_int(i,j,K)
eb(i,j,k-1) = ea(i,j,k)
enddo ; enddo ; enddo
do j=js,je ; do i=is,ie
@@ -1652,7 +1662,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
! Calculate appropriately limited diapycnal mass fluxes to account
! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb
call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS%entrain_diffusive_CSp, &
- ea, eb, kb, Kd_Lay=Kd, Kd_int=Kd_int)
+ ea, eb, kb, Kd_Lay=Kd_lay, Kd_int=Kd_int)
call cpu_clock_end(id_clock_entrain)
if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)")
@@ -1705,7 +1715,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
! If visc%MLD exists, copy the ePBL's MLD into it
if (associated(visc%MLD)) then
- call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G)
+ call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, GV)
call pass_var(visc%MLD, G%domain, halo=1)
Hml(:,:) = visc%MLD(:,:)
endif
@@ -1720,11 +1730,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0)
visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K))
endif
- Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / &
+ Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / &
(0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect)
eb(i,j,k-1) = eb(i,j,k-1) + Ent_int
ea(i,j,k) = ea(i,j,k) + Ent_int
- Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here
+ Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here
! for diagnostics
Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K)
@@ -1735,7 +1745,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
if (CS%debug) then
call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m)
call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m)
- call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0)
+ call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%Z_to_m**2)
endif
else
@@ -1782,10 +1792,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
hold(i,j,nz) = h(i,j,nz)
h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1))
if (h(i,j,1) <= 0.0) then
- h(i,j,1) = GV%Angstrom
+ h(i,j,1) = GV%Angstrom_H
endif
if (h(i,j,nz) <= 0.0) then
- h(i,j,nz) = GV%Angstrom
+ h(i,j,nz) = GV%Angstrom_H
endif
enddo
do k=2,nz-1 ; do i=is,ie
@@ -1793,7 +1803,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + &
(eb(i,j,k) - ea(i,j,k+1)))
if (h(i,j,k) <= 0.0) then
- h(i,j,k) = GV%Angstrom
+ h(i,j,k) = GV%Angstrom_H
endif
enddo ; enddo
enddo
@@ -2073,9 +2083,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
! thicknesses, as this corresponds pretty closely (to within
! differences in the density jumps between layers) with what is done
! in the calculation of the fluxes in the first place. Kd_min_tr
- ! should be much less than the values that have been set in Kd,
+ ! should be much less than the values that have been set in Kd_lay,
! perhaps a molecular diffusivity.
- add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * &
+ add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * &
((h(i,j,k-1)+h(i,j,k)+h_neglect) / &
(h(i,j,k-1)*h(i,j,k)+h_neglect2)) - &
0.5*(ea(i,j,k) + eb(i,j,k-1))
@@ -2092,7 +2102,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k)
endif
if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then
- add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / &
+ add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / &
(0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + &
h_neglect)
ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent
@@ -2123,7 +2133,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
!$OMP parallel do default(shared) private(add_ent)
do k=nz,2,-1 ; do j=js,je ; do i=is,ie
if (visc%Kd_extra_S(i,j,k) > 0.0) then
- add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / &
+ add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / &
(0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + &
h_neglect)
else
@@ -2227,12 +2237,12 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
!$OMP parallel do default(shared)
do k=1,nz
do i=is-1,ie+1
- hold(i,js-1,k) = GV%Angstrom ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0
- hold(i,je+1,k) = GV%Angstrom ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0
+ hold(i,js-1,k) = GV%Angstrom_H ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0
+ hold(i,je+1,k) = GV%Angstrom_H ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0
enddo
do j=js,je
- hold(is-1,j,k) = GV%Angstrom ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0
- hold(ie+1,j,k) = GV%Angstrom ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0
+ hold(is-1,j,k) = GV%Angstrom_H ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0
+ hold(ie+1,j,k) = GV%Angstrom_H ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0
enddo
enddo
@@ -2428,12 +2438,14 @@ end subroutine legacy_diabatic
!! each returned argument is an optional argument
subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, &
evap_CFL_limit, minimum_forcing_depth)
- type(diabatic_CS), intent(in ) :: CS
+ type(diabatic_CS), intent(in ) :: CS !< module control structure
! All output arguments are optional
- type(opacity_CS), optional, pointer :: opacity_CSp
- type(optics_type), optional, pointer :: optics_CSp
- real, optional, intent( out) :: evap_CFL_limit
- real, optional, intent( out) :: minimum_forcing_depth
+ type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure
+ type(optics_type), optional, pointer :: optics_CSp !< A pointer to be set to the optics control structure
+ real, optional, intent( out) :: evap_CFL_limit ! CS%opacity_CSp
@@ -2479,9 +2491,11 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV,
real, intent(in) :: dt !< time step (sec)
type(diabatic_CS), pointer :: CS !< module control structure
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d
real, dimension(SZI_(G),SZJ_(G)) :: work_2d
- real :: Idt
+ real :: Idt ! The inverse of the timestep, in s-1
+ real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg.
integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
@@ -2528,7 +2542,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV,
! salt tendency
if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then
do k=1,nz ; do j=js,je ; do i=is,ie
- work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * CS%ppt2mks * work_3d(i,j,k)
+ work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * ppt2mks * work_3d(i,j,k)
enddo ; enddo ; enddo
if (CS%id_diabatic_diff_salt_tend > 0) then
call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h = h)
@@ -2567,9 +2581,11 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old,
real, intent(in) :: dt !< time step (sec)
type(diabatic_CS), pointer :: CS !< module control structure
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d
real, dimension(SZI_(G),SZJ_(G)) :: work_2d
- real :: Idt
+ real :: Idt ! The inverse of the timestep, in s-1
+ real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg.
integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
@@ -2623,7 +2639,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old,
! salt tendency
if (CS%id_boundary_forcing_salt_tend > 0 .or. CS%id_boundary_forcing_salt_tend_2d > 0) then
do k=1,nz ; do j=js,je ; do i=is,ie
- work_3d(i,j,k) = GV%H_to_kg_m2 * CS%ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k))
+ work_3d(i,j,k) = GV%H_to_kg_m2 * ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k))
enddo ; enddo ; enddo
if (CS%id_boundary_forcing_salt_tend > 0) then
call post_data(CS%id_boundary_forcing_salt_tend, work_3d, CS%diag, alt_h = h_old)
@@ -2709,7 +2725,7 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, &
! This "include" declares and sets the variable "version".
#include "version_variable.h"
- character(len=40) :: mod = "MOM_diabatic_driver" ! This module's name.
+ character(len=40) :: mdl = "MOM_diabatic_driver" ! This module's name.
if (associated(CS)) then
call MOM_error(WARNING, "adiabatic_driver_init called with an "// &
@@ -2722,7 +2738,7 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, &
if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp
! Set default, read and log parameters
- call log_version(param_file, mod, version, &
+ call log_version(param_file, mdl, version, &
"The following parameters are used for diabatic processes.")
end subroutine adiabatic_driver_init
@@ -2755,7 +2771,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
! This "include" declares and sets the variable "version".
#include "version_variable.h"
- character(len=40) :: mod = "MOM_diabatic_driver" ! This module's name.
+ character(len=40) :: mdl = "MOM_diabatic_driver" ! This module's name.
character(len=48) :: thickness_units
character(len=40) :: var_name
character(len=160) :: var_descript
@@ -2783,28 +2799,31 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
CS%bulkmixedlayer = (GV%nkml > 0)
! Set default, read and log parameters
- call log_version(param_file, mod, version, &
+ call log_version(param_file, mdl, version, &
"The following parameters are used for diabatic processes.")
- call get_param(param_file, mod, "SPONGE", CS%use_sponge, &
+ call get_param(param_file, mdl, "SPONGE", CS%use_sponge, &
"If true, sponges may be applied anywhere in the domain. \n"//&
"The exact location and properties of those sponges are \n"//&
"specified via calls to initialize_sponge and possibly \n"//&
"set_up_sponge_field.", default=.false.)
- call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", use_temperature, &
+ call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, &
"If true, temperature and salinity are used as state \n"//&
"variables.", default=.true.)
- call get_param(param_file, mod, "ENERGETICS_SFC_PBL", CS%use_energetic_PBL, &
+ call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", CS%use_energetic_PBL, &
"If true, use an implied energetics planetary boundary \n"//&
"layer scheme to determine the diffusivity and viscosity \n"//&
"in the surface boundary layer.", default=.false.)
- call get_param(param_file, mod, "EPBL_IS_ADDITIVE", CS%ePBL_is_additive, &
+ call get_param(param_file, mdl, "EPBL_IS_ADDITIVE", CS%ePBL_is_additive, &
"If true, the diffusivity from ePBL is added to all\n"//&
"other diffusivities. Otherwise, the larger of kappa-\n"//&
"shear and ePBL diffusivities are used.", default=.true.)
- call get_param(param_file, mod, "DOUBLE_DIFFUSION", differentialDiffusion, &
+ call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differentialDiffusion, &
"If true, apply parameterization of double-diffusion.", &
default=.false. )
-
+ call get_param(param_file, mdl, "USE_KPP", CS%use_KPP, &
+ "If true, turns on the [CVMix] KPP scheme of Large et al., 1994,\n"// &
+ "to calculate diffusivities and non-local transport in the OBL.", &
+ default=.false., do_not_log=.true.)
CS%use_CVMix_ddiff = CVMix_ddiff_is_used(param_file)
if (CS%use_CVMix_ddiff .and. differentialDiffusion) then
@@ -2817,55 +2836,55 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
CS%use_CVMix_shear = CVMix_shear_is_used(param_file)
if (CS%bulkmixedlayer) then
- call get_param(param_file, mod, "ML_MIX_FIRST", CS%ML_mix_first, &
+ call get_param(param_file, mdl, "ML_MIX_FIRST", CS%ML_mix_first, &
"The fraction of the mixed layer mixing that is applied \n"//&
"before interior diapycnal mixing. 0 by default.", &
units="nondim", default=0.0)
- call get_param(param_file, mod, "NKBL", CS%nkbl, default=2, do_not_log=.true.)
+ call get_param(param_file, mdl, "NKBL", CS%nkbl, default=2, do_not_log=.true.)
else
CS%ML_mix_first = 0.0
endif
if (use_temperature) then
- call get_param(param_file, mod, "DO_GEOTHERMAL", CS%use_geothermal, &
+ call get_param(param_file, mdl, "DO_GEOTHERMAL", CS%use_geothermal, &
"If true, apply geothermal heating.", default=.false.)
else
CS%use_geothermal = .false.
endif
- call get_param(param_file, mod, "INTERNAL_TIDES", CS%use_int_tides, &
+ call get_param(param_file, mdl, "INTERNAL_TIDES", CS%use_int_tides, &
"If true, use the code that advances a separate set of \n"//&
"equations for the internal tide energy density.", default=.false.)
CS%nMode = 1
if (CS%use_int_tides) then
! SET NUMBER OF MODES TO CONSIDER
- call get_param(param_file, mod, "INTERNAL_TIDE_MODES", CS%nMode, &
+ call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, &
"The number of distinct internal tide modes \n"//&
"that will be calculated.", default=1, do_not_log=.true.)
! The following parameters are used in testing the internal tide code.
! GET LOCATION AND DURATION OF ENERGY POINT SOURCE FOR TESTING (BDM)
- call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, &
+ call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, &
"If true, apply an arbitrary generation site for internal tide testing", &
default=.false.)
if (CS%int_tide_source_test)then
- call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, &
+ call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, &
"X Location of generation site for internal tide", default=1.)
- call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, &
+ call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, &
"Y Location of generation site for internal tide", default=1.)
- call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, &
+ call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, &
"Time interval from start of experiment for adding wave source", &
units="days", default=0)
CS%time_max_source = increment_time(Time,0,days=CS%tlen_days)
endif
! GET UNIFORM MODE VELOCITY FOR TESTING (BDM)
- call get_param(param_file, mod, "UNIFORM_CG", CS%uniform_cg, &
+ call get_param(param_file, mdl, "UNIFORM_CG", CS%uniform_cg, &
"If true, set cg = cg_test everywhere for test case", default=.false.)
if (CS%uniform_cg)then
- call get_param(param_file, mod, "CG_TEST", CS%cg_test, &
+ call get_param(param_file, mdl, "CG_TEST", CS%cg_test, &
"Uniform group velocity of internal tide for test case", default=1.)
endif
endif
- call get_param(param_file, mod, "MASSLESS_MATCH_TARGETS", &
+ call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", &
CS%massless_match_targets, &
"If true, the temperature and salinity of massless layers \n"//&
"are kept consistent with their target densities. \n"//&
@@ -2873,7 +2892,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
"diffusively to match massive neighboring layers.", &
default=.true.)
- call get_param(param_file, mod, "AGGREGATE_FW_FORCING", CS%aggregate_FW_forcing, &
+ call get_param(param_file, mdl, "AGGREGATE_FW_FORCING", CS%aggregate_FW_forcing, &
"If true, the net incoming and outgoing fresh water fluxes are combined\n"//&
"and applied as either incoming or outgoing depending on the sign of the net.\n"//&
"If false, the net incoming fresh water flux is added to the model and\n"//&
@@ -2881,44 +2900,44 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
"into the first non-vanished layer for which the column remains stable", &
default=.true.)
- call get_param(param_file, mod, "DEBUG", CS%debug, &
+ call get_param(param_file, mdl, "DEBUG", CS%debug, &
"If true, write out verbose debugging data.", &
default=.false., debuggingParam=.true.)
- call get_param(param_file, mod, "DEBUG_CONSERVATION", CS%debugConservation, &
+ call get_param(param_file, mdl, "DEBUG_CONSERVATION", CS%debugConservation, &
"If true, monitor conservation and extrema.", &
default=.false., debuggingParam=.true.)
- call get_param(param_file, mod, "DEBUG_ENERGY_REQ", CS%debug_energy_req, &
+ call get_param(param_file, mdl, "DEBUG_ENERGY_REQ", CS%debug_energy_req, &
"If true, debug the energy requirements.", default=.false., do_not_log=.true.)
- call get_param(param_file, mod, "MIX_BOUNDARY_TRACERS", CS%mix_boundary_tracers, &
+ call get_param(param_file, mdl, "MIX_BOUNDARY_TRACERS", CS%mix_boundary_tracers, &
"If true, mix the passive tracers in massless layers at \n"//&
"the bottom into the interior as though a diffusivity of \n"//&
"KD_MIN_TR were operating.", default=.true.)
if (CS%mix_boundary_tracers) then
- call get_param(param_file, mod, "KD", Kd, fail_if_missing=.true.)
- call get_param(param_file, mod, "KD_MIN_TR", CS%Kd_min_tr, &
+ call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.)
+ call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, &
"A minimal diffusivity that should always be applied to \n"//&
"tracers, especially in massless layers near the bottom. \n"//&
- "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd)
- call get_param(param_file, mod, "KD_BBL_TR", CS%Kd_BBL_tr, &
+ "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=GV%m_to_Z**2)
+ call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, &
"A bottom boundary layer tracer diffusivity that will \n"//&
"allow for explicitly specified bottom fluxes. The \n"//&
"entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) \n"//&
- "over the same distance.", units="m2 s-1", default=0.)
+ "over the same distance.", units="m2 s-1", default=0., scale=GV%m_to_Z**2)
endif
- call get_param(param_file, mod, "TRACER_TRIDIAG", CS%tracer_tridiag, &
+ call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, &
"If true, use the passive tracer tridiagonal solver for T and S\n", &
default=.false.)
- call get_param(param_file, mod, "MINIMUM_FORCING_DEPTH", CS%minimum_forcing_depth, &
+ call get_param(param_file, mdl, "MINIMUM_FORCING_DEPTH", CS%minimum_forcing_depth, &
"The smallest depth over which forcing can be applied. This\n"//&
"only takes effect when near-surface layers become thin\n"//&
"relative to this scale, in which case the forcing tendencies\n"//&
"scaled down by distributing the forcing over this depth scale.", &
units="m", default=0.001)
- call get_param(param_file, mod, "EVAP_CFL_LIMIT", CS%evap_CFL_limit, &
+ call get_param(param_file, mdl, "EVAP_CFL_LIMIT", CS%evap_CFL_limit, &
"The largest fraction of a layer than can be lost to forcing\n"//&
"(e.g. evaporation, sea-ice formation) in one time-step. The unused\n"//&
"mass loss is passed down through the column.", &
@@ -2972,20 +2991,21 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
CS%id_Sadv = register_diag_field('ocean_model',"Sflx_dia_adv",diag%axesTi, &
Time, "Advective diapycnal salnity flux across interfaces", &
"psu m s-1")
- CS%id_MLD_003 = register_diag_field('ocean_model','MLD_003',diag%axesT1,Time, &
- 'Mixed layer depth (delta rho = 0.03)', 'm', cmor_field_name='mlotst', &
- cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', &
+ CS%id_MLD_003 = register_diag_field('ocean_model', 'MLD_003', diag%axesT1, Time, &
+ 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=GV%Z_to_m, &
+ cmor_field_name='mlotst', cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', &
cmor_standard_name='ocean_mixed_layer_thickness_defined_by_sigma_t')
- CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1,Time, &
- long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', &
- standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t',units='m2')
+ CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1, Time, &
+ long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', &
+ standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t', &
+ units='m2', conversion=GV%Z_to_m**2)
CS%id_MLD_0125 = register_diag_field('ocean_model','MLD_0125',diag%axesT1,Time, &
- 'Mixed layer depth (delta rho = 0.125)', 'm')
+ 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=GV%Z_to_m)
CS%id_subMLN2 = register_diag_field('ocean_model','subML_N2',diag%axesT1,Time, &
'Squared buoyancy frequency below mixed layer', 's-2')
CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, &
- 'Mixed layer depth (used defined)', 'm')
- call get_param(param_file, mod, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, &
+ 'Mixed layer depth (used defined)', 'm', conversion=GV%Z_to_m)
+ call get_param(param_file, mdl, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, &
"The density difference used to determine a diagnostic mixed\n"//&
"layer depth, MLD_user, following the definition of Levitus 1982. \n"//&
"The MLD is the depth at which the density is larger than the\n"//&
@@ -3001,15 +3021,15 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
z_grid='z')
CS%id_Tdif_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time)
vd = var_desc("Tflx_dia_adv", "degC m s-1", &
- "Advective diapycnal temperature flux across interfaces, interpolated to z",&
+ "Advective diapycnal temperature flux across interfaces, interpolated to z", &
z_grid='z')
CS%id_Tadv_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time)
vd = var_desc("Sflx_dia_diff", "psu m s-1", &
- "Diffusive diapycnal salinity flux across interfaces, interpolated to z",&
+ "Diffusive diapycnal salinity flux across interfaces, interpolated to z", &
z_grid='z')
CS%id_Sdif_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time)
vd = var_desc("Sflx_dia_adv", "psu m s-1", &
- "Advective diapycnal salinity flux across interfaces, interpolated to z",&
+ "Advective diapycnal salinity flux across interfaces, interpolated to z", &
z_grid='z')
CS%id_Sadv_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time)
endif
@@ -3036,26 +3056,26 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
!call set_diffusivity_init(Time, G, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp)
CS%id_Kd_interface = register_diag_field('ocean_model', 'Kd_interface', diag%axesTi, Time, &
- 'Total diapycnal diffusivity at interfaces', 'm2 s-1')
+ 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2)
if (CS%use_energetic_PBL) then
CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, &
- 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1')
+ 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2)
endif
CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, &
- 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', &
+ 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2, &
cmor_field_name='difvho', &
cmor_standard_name='ocean_vertical_heat_diffusivity', &
cmor_long_name='Ocean vertical heat diffusivity')
CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, &
- 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', &
+ 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2, &
cmor_field_name='difvso', &
cmor_standard_name='ocean_vertical_salt_diffusivity', &
cmor_long_name='Ocean vertical salt diffusivity')
! CS%useKPP is set to True if KPP-scheme is to be used, False otherwise.
! KPP_init() allocated CS%KPP_Csp and also sets CS%KPPisPassive
- CS%useKPP = KPP_init(param_file, G, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive)
+ CS%useKPP = KPP_init(param_file, G, GV, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive)
if (CS%useKPP) then
allocate( CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTheat(:,:,:) = 0.
allocate( CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTscalar(:,:,:) = 0.
@@ -3072,7 +3092,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
'set DOUBLE_DIFFUSION=False and USE_CVMIX_DDIFF=True.')
endif
- call get_param(param_file, mod, "SALT_REJECT_BELOW_ML", CS%salt_reject_below_ML, &
+ call get_param(param_file, mdl, "SALT_REJECT_BELOW_ML", CS%salt_reject_below_ML, &
"If true, place salt from brine rejection below the mixed layer,\n"// &
"into the first non-vanished layer for which the column remains stable", &
default=.false.)
@@ -3270,7 +3290,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
! initialize module for setting diffusivities
call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, &
- CS%int_tide_CSp, CS%tidal_mixing_CSp)
+ CS%int_tide_CSp, CS%tidal_mixing_CSp, CS%halo_TS_diff)
! set up the clocks for this module
@@ -3300,14 +3320,14 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,
if (CS%use_energetic_PBL) &
call energetic_PBL_init(Time, G, GV, param_file, diag, CS%energetic_PBL_CSp)
- call regularize_layers_init(Time, G, param_file, diag, CS%regularize_layers_CSp)
+ call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp)
if (CS%debug_energy_req) &
call diapyc_energy_req_init(Time, G, param_file, diag, CS%diapyc_en_rec_CSp)
! obtain information about the number of bands for penetrative shortwave
if (use_temperature) then
- call get_param(param_file, mod, "PEN_SW_NBANDS", nbands, default=1)
+ call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1)
if (nbands > 0) then
allocate(CS%optics)
call opacity_init(Time, G, param_file, diag, CS%tracer_flow_CSp, CS%opacity_CSp, CS%optics)
diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90
index 2678b18e1a..93676a384c 100644
--- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90
+++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90
@@ -1,16 +1,11 @@
+!> Calculates the energy requirements of mixing.
module MOM_diapyc_energy_req
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, May 2015 *
-!* *
-!* This module calculates the energy requirements of mixing. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
+!! \author By Robert Hallberg, May 2015
-use MOM_diag_mediator, only : diag_ctrl, Time_type, post_data_1d_k, register_diag_field
+use MOM_diag_mediator, only : diag_ctrl, Time_type, post_data, register_diag_field
use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
@@ -22,25 +17,29 @@ module MOM_diapyc_energy_req
public diapyc_energy_req_init, diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_end
+!> This control structure holds parameters for the MOM_diapyc_energy_req module
type, public :: diapyc_energy_req_CS ; private
- logical :: initialized = .false. ! A variable that is here because empty
- ! structures are not permitted by some compilers.
- real :: test_Kh_scaling ! A scaling factor for the diapycnal diffusivity.
- real :: ColHt_scaling ! A scaling factor for the column height change
- ! correction term.
- logical :: use_test_Kh_profile ! If true, use the internal test diffusivity
- ! profile in place of any that might be passed
- ! in as an argument.
- type(diag_ctrl), pointer :: diag ! Structure used to regulate timing of diagnostic output
+ logical :: initialized = .false. !< A variable that is here because empty
+ !! structures are not permitted by some compilers.
+ real :: test_Kh_scaling !< A scaling factor for the diapycnal diffusivity.
+ real :: ColHt_scaling !< A scaling factor for the column height change correction term.
+ logical :: use_test_Kh_profile !< If true, use the internal test diffusivity profile in place of
+ !! any that might be passed in as an argument.
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+
+ !>@{ Diagnostic IDs
integer :: id_ERt=-1, id_ERb=-1, id_ERc=-1, id_ERh=-1, id_Kddt=-1, id_Kd=-1
integer :: id_CHCt=-1, id_CHCb=-1, id_CHCc=-1, id_CHCh=-1
integer :: id_T0=-1, id_Tf=-1, id_S0=-1, id_Sf=-1, id_N2_0=-1, id_N2_f=-1
integer :: id_h=-1, id_zInt=-1
+ !!@}
end type diapyc_energy_req_CS
contains
-! #@# This subroutine needs a doxygen description
+!> This subroutine helps test the accuracy of the diapycnal mixing energy requirement code
+!! by writing diagnostics, possibly using an intensely mixing test profile of diffusivity
subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -54,17 +53,9 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int)
!! in s.
type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure.
real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), &
- optional, intent(in) :: Kd_int !< Interface diffusivities.
-
-! Arguments: h_3d - Layer thickness before entrainment, in m or kg m-2.
-! (in) tv - A structure containing pointers to any available
-! thermodynamic fields. Absent fields have NULL ptrs.
-! (in) dt - The amount of time covered by this call, in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - This module's control structure
-! (in,opt) Kd_int - Interface diffusivities.
+ optional, intent(in) :: Kd_int !< Interface diffusivities in Z2 s-1.
+ ! Local variables
real, dimension(GV%ke) :: &
T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities, in degC and g/kg.
h_col ! h_col is a column of thicknesses h at tracer points, in H (m or kg m-2).
@@ -84,7 +75,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int)
!$OMP do
do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then
if (present(Kd_int) .and. .not.CS%use_test_Kh_profile) then
- do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*Kd_int(i,j,K) ; enddo
+ do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*GV%Z_to_m**2*Kd_int(i,j,K) ; enddo
else
htot = 0.0 ; h_top(1) = 0.0
do k=1,nz
@@ -98,13 +89,13 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int)
h_bot(K) = h_bot(K+1) + h_col(k)
enddo
- ustar = 0.01 ! Change this to being an input parameter?
+ ustar = 0.01*GV%m_to_Z ! Change this to being an input parameter?
absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + &
(abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))))
Kd(1) = 0.0 ; Kd(nz+1) = 0.0
do K=2,nz
- tmp1 = h_top(K) * h_bot(K) * GV%H_to_m
- Kd(K) = CS%test_Kh_scaling * &
+ tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z
+ Kd(K) = CS%test_Kh_scaling * GV%Z_to_m**2 * &
ustar * 0.41 * (tmp1*ustar) / (absf*tmp1 + htot*ustar)
enddo
endif
@@ -126,7 +117,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment,
- !! in m or kg m-2.
+ !! in H (m or kg m-2).
real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC.
real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1.
real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities,
@@ -141,21 +132,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
logical, optional, intent(in) :: may_print !< If present and true, write out diagnostics
!! of energy use.
type(diapyc_energy_req_CS), &
- optional, pointer :: CS !< This module's control structure.
-
-! Arguments: h_in - Layer thickness before entrainment, in m or kg m-2.
-! (in) T_in - The layer temperatures, in degC.
-! (in) S_in - The layer salinities, in g kg-1.
-! (in) Kd - The interfaces diapycnal diffusivities, in m2 s-1.
-! (in/out) tv - A structure containing pointers to any available
-! thermodynamic fields. Absent fields have NULL ptrs.
-! (in) dt - The amount of time covered by this call, in s.
-! (out) energy_Kd - The column-integrated rate of energy consumption
-! by diapycnal diffusion, in W m-2.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in,opt) may_print - If present and true, write out diagnostics of energy use.
-! (in,opt) CS - This module's control structure
+ optional, pointer :: CS !< This module's control structure.
! This subroutine uses a substantially refactored tridiagonal equation for
! diapycnal mixing of temperature and salinity to estimate the potential energy
@@ -274,7 +251,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
nz = G%ke
h_neglect = GV%H_subroundoff
- I_G_Earth = 1.0 / GV%g_Earth
+ I_G_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z)
debug = .true.
surface_BL = .true. ; bottom_BL = .true. ; halves = .true.
@@ -292,7 +269,7 @@ 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%g_Earth * GV%H_to_kg_m2 * h_tr(k)
+ pres(K+1) = pres(K) + GV%H_to_Pa * h_tr(k)
p_lay(k) = 0.5*(pres(K) + pres(K+1))
Z_int(K+1) = Z_int(K) - GV%H_to_m * h_tr(k)
enddo
@@ -313,7 +290,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
do k=1,nz
dMass = GV%H_to_kg_m2 * h_tr(k)
- dPres = GV%g_Earth * dMass
+ dPres = (GV%g_Earth*GV%m_to_Z) * dMass
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 * dSV_dT(k) * CS%ColHt_scaling
@@ -933,43 +910,43 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
K=nz
if (do_print) then
- if (CS%id_ERt>0) call post_data_1d_k(CS%id_ERt, PE_chg_k(:,1), CS%diag)
- if (CS%id_ERb>0) call post_data_1d_k(CS%id_ERb, PE_chg_k(:,2), CS%diag)
- if (CS%id_ERc>0) call post_data_1d_k(CS%id_ERc, PE_chg_k(:,3), CS%diag)
- if (CS%id_ERh>0) call post_data_1d_k(CS%id_ERh, PE_chg_k(:,4), CS%diag)
- if (CS%id_Kddt>0) call post_data_1d_k(CS%id_Kddt, GV%H_to_m*Kddt_h, CS%diag)
- if (CS%id_Kd>0) call post_data_1d_k(CS%id_Kd, Kd, CS%diag)
- if (CS%id_h>0) call post_data_1d_k(CS%id_h, GV%H_to_m*h_tr, CS%diag)
- if (CS%id_zInt>0) call post_data_1d_k(CS%id_zInt, Z_int, CS%diag)
- if (CS%id_CHCt>0) call post_data_1d_k(CS%id_CHCt, ColHt_cor_k(:,1), CS%diag)
- if (CS%id_CHCb>0) call post_data_1d_k(CS%id_CHCb, ColHt_cor_k(:,2), CS%diag)
- if (CS%id_CHCc>0) call post_data_1d_k(CS%id_CHCc, ColHt_cor_k(:,3), CS%diag)
- if (CS%id_CHCh>0) call post_data_1d_k(CS%id_CHCh, ColHt_cor_k(:,4), CS%diag)
- if (CS%id_T0>0) call post_data_1d_k(CS%id_T0, T0, CS%diag)
- if (CS%id_Tf>0) call post_data_1d_k(CS%id_Tf, Tf, CS%diag)
- if (CS%id_S0>0) call post_data_1d_k(CS%id_S0, S0, CS%diag)
- if (CS%id_Sf>0) call post_data_1d_k(CS%id_Sf, Sf, CS%diag)
+ if (CS%id_ERt>0) call post_data(CS%id_ERt, PE_chg_k(:,1), CS%diag)
+ if (CS%id_ERb>0) call post_data(CS%id_ERb, PE_chg_k(:,2), CS%diag)
+ if (CS%id_ERc>0) call post_data(CS%id_ERc, PE_chg_k(:,3), CS%diag)
+ if (CS%id_ERh>0) call post_data(CS%id_ERh, PE_chg_k(:,4), CS%diag)
+ if (CS%id_Kddt>0) call post_data(CS%id_Kddt, GV%H_to_m*Kddt_h, CS%diag)
+ if (CS%id_Kd>0) call post_data(CS%id_Kd, Kd, CS%diag)
+ if (CS%id_h>0) call post_data(CS%id_h, GV%H_to_m*h_tr, CS%diag)
+ if (CS%id_zInt>0) call post_data(CS%id_zInt, Z_int, CS%diag)
+ if (CS%id_CHCt>0) call post_data(CS%id_CHCt, ColHt_cor_k(:,1), CS%diag)
+ if (CS%id_CHCb>0) call post_data(CS%id_CHCb, ColHt_cor_k(:,2), CS%diag)
+ if (CS%id_CHCc>0) call post_data(CS%id_CHCc, ColHt_cor_k(:,3), CS%diag)
+ if (CS%id_CHCh>0) call post_data(CS%id_CHCh, ColHt_cor_k(:,4), CS%diag)
+ if (CS%id_T0>0) call post_data(CS%id_T0, T0, CS%diag)
+ if (CS%id_Tf>0) call post_data(CS%id_Tf, Tf, CS%diag)
+ if (CS%id_S0>0) call post_data(CS%id_S0, S0, CS%diag)
+ if (CS%id_Sf>0) call post_data(CS%id_Sf, Sf, CS%diag)
if (CS%id_N2_0>0) then
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)
- N2(K) = (GV%g_Earth * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * &
+ N2(K) = ((GV%g_Earth*GV%m_to_Z**2) * 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)) )
enddo
- call post_data_1d_k(CS%id_N2_0, N2, CS%diag)
+ call post_data(CS%id_N2_0, N2, CS%diag)
endif
if (CS%id_N2_f>0) then
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)
- N2(K) = (GV%g_Earth * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * &
+ N2(K) = ((GV%g_Earth*GV%m_to_Z**2) * 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)) )
enddo
- call post_data_1d_k(CS%id_N2_f, N2, CS%diag)
+ call post_data(CS%id_N2_f, N2, CS%diag)
endif
endif
@@ -1278,15 +1255,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, &
end subroutine find_PE_chg_orig
+!> Initialize parameters and allocate memory associated with the diapycnal energy requirement module.
subroutine diapyc_energy_req_init(Time, G, param_file, diag, CS)
type(time_type), intent(in) :: Time !< model time
type(ocean_grid_type), intent(in) :: G !< model grid structure
type(param_file_type), intent(in) :: param_file !< file to parse for parameter values
type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output
type(diapyc_energy_req_CS), pointer :: CS !< module control structure
-! Arguments: param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in/out) Reg - A pointer that is set to point to the tracer registry.
+
integer, save :: init_calls = 0
! This include declares and sets the variable "version".
#include "version_variable.h"
@@ -1351,8 +1327,10 @@ subroutine diapyc_energy_req_init(Time, G, param_file, diag, CS)
end subroutine diapyc_energy_req_init
+!> Clean up and deallocate memory associated with the diapycnal energy requirement module.
subroutine diapyc_energy_req_end(CS)
- type(diapyc_energy_req_CS), pointer :: CS
+ type(diapyc_energy_req_CS), pointer :: CS !< Diapycnal energy requirement control structure that
+ !! will be deallocated in this subroutine.
if (associated(CS)) deallocate(CS)
end subroutine diapyc_energy_req_end
diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90
index a58773d066..b82c697b8d 100644
--- a/src/parameterizations/vertical/MOM_energetic_PBL.F90
+++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90
@@ -1,52 +1,8 @@
+!> Energetically consistent planetary boundary layer parameterization
module MOM_energetic_PBL
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, 2015. *
-!* *
-!* This file contains the subroutine (energetic_PBL) that uses an *
-!* integrated boundary layer energy budget (like a bulk- or refined- *
-!* bulk mixed layer scheme), but instead of homogenizing this model *
-!* calculates a finite diffusivity and viscosity, which in this *
-!* regard is conceptually similar to what is done with KPP or various *
-!* two-equation closures. However, the scheme that is implemented *
-!* here has the big advantage that is entirely implicit, but is *
-!* simple enough that it requires only a single vertical pass to *
-!* determine the diffusivity. The development of bulk mixed layer *
-!* models stems from the work of various people, as described in the *
-!* review paper by Niiler and Kraus (1979). The work here draws in *
-!* with particular on the form for TKE decay proposed by Oberhuber *
-!* (JPO, 1993, 808-829), with an extension to a refined bulk mixed *
-!* layer as described in Hallberg (Aha Huliko'a, 2003). The physical *
-!* processes portrayed in this subroutine include convectively driven *
-!* mixing and mechanically driven mixing. Unlike boundary-layer *
-!* mixing, stratified shear mixing is not a one-directional turbulent *
-!* process, and it is dealt with elsewhere in the MOM6 code within *
-!* the module MOM_kappa_shear.F90. It is assumed that the heat, *
-!* mass, and salt fluxes have been applied elsewhere, but that their *
-!* implications for the integrated TKE budget have been captured in *
-!* an array that is provided as an argument to this subroutine. This *
-!* is a full 3-d array due to the effects of penetrating shortwave *
-!* radiation. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, T, S, Kd, etc. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc
use MOM_diag_mediator, only : time_type, diag_ctrl
@@ -68,138 +24,142 @@ module MOM_energetic_PBL
public energetic_PBL, energetic_PBL_init, energetic_PBL_end
public energetic_PBL_get_MLD
+!> This control structure holds parameters for the MOM_energetic_PBL module
type, public :: energetic_PBL_CS ; private
- real :: mstar ! The ratio of the friction velocity cubed to the
- ! TKE available to drive entrainment, nondimensional.
- ! This quantity is the vertically integrated
- ! shear production minus the vertically integrated
- ! dissipation of TKE produced by shear.
- real :: nstar ! The fraction of the TKE input to the mixed layer
- ! available to drive entrainment, nondim.
- ! This quantity is the vertically integrated
- ! buoyancy production minus the vertically integrated
- ! dissipation of TKE produced by buoyancy.
- real :: MixLenExponent ! Exponent in the mixing length shape-function.
- ! 1 is law-of-the-wall at top and bottom,
- ! 2 is more KPP like.
- real :: TKE_decay ! The ratio of the natural Ekman depth to the TKE
- ! decay scale, nondimensional.
- real :: MKE_to_TKE_effic ! The efficiency with which mean kinetic energy
- ! released by mechanically forced entrainment of
- ! the mixed layer is converted to TKE, nondim.
-! real :: Hmix_min ! The minimum mixed layer thickness in m.
- real :: ustar_min ! A minimum value of ustar to avoid numerical
- ! problems, in m s-1. If the value is small enough,
- ! this should not affect the solution.
- real :: omega ! The Earth's rotation rate, in s-1.
- real :: omega_frac ! When setting the decay scale for turbulence, use
- ! this fraction of the absolute rotation rate blended
- ! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).
- real :: wstar_ustar_coef ! A ratio relating the efficiency with which
- ! convectively released energy is converted to a
- ! turbulent velocity, relative to mechanically
- ! forced turbulent kinetic energy, nondim. Making
- ! this larger increases the diffusivity.
- real :: vstar_scale_fac ! An overall nondimensional scaling factor
- ! for vstar. Making this larger increases the
- ! diffusivity.
- real :: Ekman_scale_coef ! A nondimensional scaling factor controlling
- ! the inhibition of the diffusive length scale by
- ! rotation. Making this larger decreases the
- ! diffusivity in the planetary boundary layer.
- real :: transLay_scale ! A scale for the mixing length in the transition layer
- ! at the edge of the boundary layer as a fraction of the
- ! boundary layer thickness. The default is 0, but a
- ! value of 0.1 might be better justified by observations.
- real :: MLD_tol ! A tolerance for determining the boundary layer
- ! thickness when Use_MLD_iteration is true, in m.
- real :: min_mix_len ! The minimum mixing length scale that will be
- ! used by ePBL, in m. The default (0) does not
- ! set a minimum.
- real :: N2_Dissipation_Scale_Neg
- real :: N2_Dissipation_Scale_Pos
- ! A nondimensional scaling factor controlling the
- ! loss of TKE due to enhanced dissipation in the presence
- ! of stratification. This dissipation is applied to the
- ! available TKE which includes both that generated at the
- ! surface and that generated at depth. It may be important
- ! to distinguish which TKE flavor that this dissipation
- ! applies to in subsequent revisions of this code.
- ! "_Neg" and "_Pos" refer to which scale is applied as a
- ! function of negative or positive local buoyancy.
- real :: MSTAR_CAP ! Since MSTAR is restoring undissipated energy to mixing,
- ! there must be a cap on how large it can be. This
- ! is definitely a function of latitude (Ekman limit),
- ! but will be taken as constant for now.
- real :: MSTAR_SLOPE ! Slope of the function which relates the shear production
- ! to the mixing layer depth, Ekman depth, and Monin-Obukhov
- ! depth.
- real :: MSTAR_XINT ! Value where MSTAR function transitions from linear
- ! to decay toward MSTAR->0 at fully developed Ekman depth.
- real :: MSTAR_XINT_UP ! Similar but for transition to asymptotic cap.
- real :: MSTAR_AT_XINT ! Intercept value of MSTAR at value where function
- ! changes to linear transition.
- integer :: LT_ENHANCE_FORM ! Integer for Enhancement functional form (various options)
- real :: LT_ENHANCE_COEF ! Coefficient in fit for Langmuir Enhancment
- real :: LT_ENHANCE_EXP ! Exponent in fit for Langmuir Enhancement
- real :: MSTAR_N = -2. ! Exponent in decay at negative and positive limits of MLD_over_STAB
- real :: MSTAR_A,MSTAR_A2 ! MSTAR_A and MSTAR_B are coefficients in asymptote toward limits.
- real :: MSTAR_B,MSTAR_B2 ! These are computed to match the function value and slope at both
- ! ends of the linear fit within the well constrained region.
- real :: C_EK = 0.17 ! MSTAR Coefficient in rotation limit for mstar_mode=2
- real :: MSTAR_COEF = 0.3 ! MSTAR coefficient in rotation/stabilizing balance for mstar_mode=2
- real :: LaC_MLDoEK ! Coefficients for Langmuir number modification based on
- real :: LaC_MLDoOB_stab ! length scale ratios, MLD is boundary, EK is Ekman,
- real :: LaC_EKoOB_stab ! and OB is Obukhov, the "o" in the name is for division.
- real :: LaC_MLDoOB_un ! Stab/un are for stable (pos) and unstable (neg) Obukhov depths
- real :: LaC_EKoOB_un ! ...
- real :: Max_Enhance_M = 5. ! The maximum allowed LT enhancement to the mixing.
- real :: CNV_MST_FAC ! Factor to reduce mstar when statically unstable.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
-
- integer :: MSTAR_MODE = 0 ! An integer to determine which formula is used to
- ! set mstar
- integer :: CONST_MSTAR=0,MLD_o_OBUKHOV=1,EKMAN_o_OBUKHOV=2
- logical :: MSTAR_FLATCAP=.true. !Set false to use asymptotic mstar cap.
- logical :: TKE_diagnostics = .false.
- logical :: Use_LT = .false. ! Flag for using LT in Energy calculation
- logical :: orig_PE_calc = .true.
- logical :: Use_MLD_iteration=.false. ! False to use old ePBL method.
- logical :: Orig_MLD_iteration=.false. ! False to use old MLD value
- logical :: MLD_iteration_guess=.false. ! False to default to guessing half the
- ! ocean depth for the iteration.
- logical :: Mixing_Diagnostics = .false. ! Will be true when outputing mixing
- ! length and velocity scale
- logical :: MSTAR_Diagnostics=.false.
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
-
-! These are terms in the mixed layer TKE budget, all in J m-2 = kg s-2.
+ real :: mstar !< The ratio of the friction velocity cubed to the TKE available to
+ !! drive entrainment, nondimensional. This quantity is the vertically
+ !! integrated shear production minus the vertically integrated
+ !! dissipation of TKE produced by shear.
+ real :: nstar !< The fraction of the TKE input to the mixed layer available to drive
+ !! entrainment, nondim. This quantity is the vertically integrated
+ !! buoyancy production minus the vertically integrated dissipation of
+ !! TKE produced by buoyancy.
+ real :: MixLenExponent !< Exponent in the mixing length shape-function.
+ !! 1 is law-of-the-wall at top and bottom,
+ !! 2 is more KPP like.
+ real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale, nondim.
+ real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by
+ !! mechanically forced entrainment of the mixed layer is converted to
+ !! TKE, nondim.
+! real :: Hmix_min !< The minimum mixed layer thickness in m.
+ real :: ustar_min !< A minimum value of ustar to avoid numerical problems, in m s-1.
+ !! If the value is small enough, this should not affect the solution.
+ real :: omega !< The Earth's rotation rate, in s-1.
+ real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of
+ !! the absolute rotation rate blended with the local value of f, as
+ !! sqrt((1-of)*f^2 + of*4*omega^2).
+ real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released
+ !! energy is converted to a turbulent velocity, relative to
+ !! mechanically forced turbulent kinetic energy, nondim.
+ !! Making this larger increases the diffusivity.
+ real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit
+ !! conversion factor. Making this larger increases the diffusivity.
+ real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the
+ !! diffusive length scale by rotation. Making this larger decreases
+ !! the diffusivity in the planetary boundary layer.
+ real :: transLay_scale !< A scale for the mixing length in the transition layer
+ !! at the edge of the boundary layer as a fraction of the
+ !! boundary layer thickness. The default is 0, but a
+ !! value of 0.1 might be better justified by observations.
+ real :: MLD_tol !< A tolerance for determining the boundary layer thickness when
+ !! Use_MLD_iteration is true, in Z.
+ real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in Z.
+ !! The default (0) does not set a minimum.
+ real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE
+ !! due to enhanced dissipation in the presence of negative (unstable)
+ !! local stratification. This dissipation is applied to the available
+ !! TKE which includes both that generated at the surface and that
+ !! generated at depth.
+ real :: N2_Dissipation_Scale_Pos !< A nondimensional scaling factor controlling the loss of TKE
+ !! due to enhanced dissipation in the presence of positive (stable)
+ !! local stratification. This dissipation is applied to the available
+ !! TKE which includes both that generated at the surface and that
+ !! generated at depth.
+ real :: MSTAR_CAP !< Since MSTAR is restoring undissipated energy to mixing,
+ !! there must be a cap on how large it can be. This
+ !! is definitely a function of latitude (Ekman limit),
+ !! but will be taken as constant for now.
+ real :: MSTAR_SLOPE !< Slope of the function which relates the shear production to the
+ !< mixing layer depth, Ekman depth, and Monin-Obukhov depth.
+ real :: MSTAR_XINT !< Value where MSTAR function transitions from linear
+ !! to decay toward MSTAR->0 at fully developed Ekman depth.
+ real :: MSTAR_XINT_UP !< Similar but for transition to asymptotic cap.
+ real :: MSTAR_AT_XINT !< Intercept value of MSTAR at value where function
+ !! changes to linear transition.
+ integer :: LT_ENHANCE_FORM !< Integer for Enhancement functional form (various options)
+ real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancment
+ real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement
+ real :: MSTAR_N = -2. !< Exponent in decay at negative and positive limits of MLD_over_STAB
+ real :: MSTAR_A !< Coefficients of expressions for mstar in asymptotic limits, computed
+ !! to match the function value and slope at both ends of the linear fit
+ !! within the well constrained region.
+ real :: MSTAR_A2 !< Coefficients of expressions for mstar in asymptotic limits.
+ real :: MSTAR_B !< Coefficients of expressions for mstar in asymptotic limits.
+ real :: MSTAR_B2 !< Coefficients of expressions for mstar in asymptotic limits.
+ real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_mode=2
+ real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_mode=2
+ real :: LaC_MLDoEK !< Coefficient for Langmuir number modification based on the ratio of
+ !! the mixed layer depth over the Ekman depth.
+ real :: LaC_MLDoOB_stab !< Coefficient for Langmuir number modification based on the ratio of
+ !! the mixed layer depth over the Obukov depth with stablizing forcing.
+ real :: LaC_EKoOB_stab !< Coefficient for Langmuir number modification based on the ratio of
+ !! the Ekman depth over the Obukov depth with stablizing forcing.
+ real :: LaC_MLDoOB_un !< Coefficient for Langmuir number modification based on the ratio of
+ !! the mixed layer depth over the Obukov depth with destablizing forcing.
+ real :: LaC_EKoOB_un !< Coefficient for Langmuir number modification based on the ratio of
+ !! the Ekman depth over the Obukov depth with destablizing forcing.
+ real :: Max_Enhance_M = 5. !< The maximum allowed LT enhancement to the mixing.
+ real :: CNV_MST_FAC !< Factor to reduce mstar when statically unstable.
+ type(time_type), pointer :: Time=>NULL() !< A pointer to the ocean model's clock.
+
+ integer :: MSTAR_MODE = 0 !< An coded integer to determine which formula is used to set mstar
+ integer :: CONST_MSTAR=0 !< The value of MSTAR_MODE to use a constant mstar
+ integer :: MLD_o_OBUKHOV=1 !< The value of MSTAR_MODE to base mstar on the ratio of the mixed
+ !! layer depth to the Obukhov depth
+ integer :: EKMAN_o_OBUKHOV=2 !< The value of MSTAR_MODE to base mstar on the ratio of the Ekman
+ !! layer depth to the Obukhov depth
+ logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap.
+ logical :: TKE_diagnostics = .false. !< If true, diagnostics of the TKE budget are being calculated.
+ logical :: Use_LT = .false. !< Flag for using LT in Energy calculation
+ logical :: orig_PE_calc = .true. !< If true, the ePBL code uses the original form of the
+ !! potential energy change code. Otherwise, it uses a newer version
+ !! that can work with successive increments to the diffusivity in
+ !! upward or downward passes.
+ logical :: Use_MLD_iteration=.false. !< False to use old ePBL method.
+ logical :: Orig_MLD_iteration=.false. !< False to use old MLD value
+ logical :: MLD_iteration_guess=.false. !< False to default to guessing half the
+ !! ocean depth for the iteration.
+ logical :: Mixing_Diagnostics = .false. !< Will be true when outputting mixing
+ !! length and velocity scales
+ logical :: MSTAR_Diagnostics=.false. !< If true, utput diagnostics of the mstar calculation.
+ type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the
+ !! timing of diagnostic output.
+
+ ! These are terms in the mixed layer TKE budget, all in J m-2 = kg s-2.
real, allocatable, dimension(:,:) :: &
- diag_TKE_wind, & ! The wind source of TKE.
- diag_TKE_MKE, & ! The resolved KE source of TKE.
- diag_TKE_conv, & ! The convective source of TKE.
- diag_TKE_forcing, & ! The TKE sink required to mix surface
- ! penetrating shortwave heating.
- diag_TKE_mech_decay, & ! The decay of mechanical TKE.
- diag_TKE_conv_decay, & ! The decay of convective TKE.
- diag_TKE_mixing,& ! The work done by TKE to deepen
- ! the mixed layer.
+ diag_TKE_wind, & !< The wind source of TKE, in J m-2.
+ diag_TKE_MKE, & !< The resolved KE source of TKE, in J m-2.
+ diag_TKE_conv, & !< The convective source of TKE, in J m-2.
+ diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating, in J m-2.
+ diag_TKE_mech_decay, & !< The decay of mechanical TKE, in J m-2.
+ diag_TKE_conv_decay, & !< The decay of convective TKE, in J m-2.
+ diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer, in J m-2.
! Additional output parameters also 2d
- ML_depth, & ! The mixed layer depth in m. (result after iteration step)
- ML_depth2, & ! The mixed layer depth in m. (guess for iteration step)
- Enhance_M, & ! The enhancement to the turbulent velocity scale (non-dim)
- MSTAR_MIX, & ! Mstar used in EPBL
- MSTAR_LT, & ! Mstar for Langmuir turbulence
- MLD_EKMAN, & ! MLD over Ekman length
- MLD_OBUKHOV, & ! MLD over Obukhov length
- EKMAN_OBUKHOV, & ! Ekman over Obukhov length
- LA, & ! Langmuir number
- LA_MOD ! Modified Langmuir number
+ ML_depth, & !< The mixed layer depth in Z. (result after iteration step)
+ ML_depth2, & !< The mixed layer depth in Z. (guess for iteration step)
+ Enhance_M, & !< The enhancement to the turbulent velocity scale (non-dim)
+ MSTAR_MIX, & !< Mstar used in EPBL
+ MSTAR_LT, & !< Mstar for Langmuir turbulence
+ MLD_EKMAN, & !< MLD over Ekman length
+ MLD_OBUKHOV, & !< MLD over Obukhov length
+ EKMAN_OBUKHOV, & !< Ekman over Obukhov length
+ LA, & !< Langmuir number
+ LA_MOD !< Modified Langmuir number
real, allocatable, dimension(:,:,:) :: &
- Velocity_Scale, & ! The velocity scale used in getting Kd
- Mixing_Length ! The length scale used in getting Kd
+ Velocity_Scale, & !< The velocity scale used in getting Kd
+ Mixing_Length !< The length scale used in getting Kd
+ !>@{ Diagnostic IDs
integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1
integer :: id_TKE_MKE = -1, id_TKE_conv = -1, id_TKE_forcing = -1
integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1
@@ -208,10 +168,9 @@ module MOM_energetic_PBL
integer :: id_OSBL = -1, id_LT_Enhancement = -1, id_MSTAR_mix = -1
integer :: id_mld_ekman = -1, id_mld_obukhov = -1, id_ekman_obukhov = -1
integer :: id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1
+ !!@}
end type energetic_PBL_CS
-integer :: num_msg = 0, max_msg = 2
-
contains
!> This subroutine determines the diffusivities from the integrated energetics
@@ -224,9 +183,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(inout) :: h_3d !< Layer thickness, in m or kg m-2.
- !! (Intent in/out) The units of h are referred
- !! to as H below.
+ intent(inout) :: h_3d !< Layer thicknesses, in H (usually m or kg m-2).
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: u_3d !< Zonal velocities interpolated to h points,
!! m s-1.
@@ -253,11 +210,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
real, intent(in) :: dt !< Time increment, in s.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces,
- !! in m2 s-1.
+ !! in Z2 s-1.
type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous
!! call to mixedlayer_init.
real, dimension(SZI_(G),SZJ_(G)), &
- intent(in) :: Buoy_Flux !< The surface buoyancy flux. in m2/s3.
+ intent(in) :: Buoy_Flux !< The surface buoyancy flux in Z2/s3.
real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less
!! than dt if there are two callse to
!! mixedlayer, in s.
@@ -298,33 +255,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
! For a traditional Kraus-Turner mixed layer, the values are:
! mstar = 1.25, nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0
-! Arguments: h_3d - Layer thickness, in m or kg m-2. (Intent in/out)
-! The units of h are referred to as H below.
-! (in) u_3d - Zonal velocities interpolated to h points, m s-1.
-! (in) v_3d - Zonal velocities interpolated to h points, m s-1.
-! (in/out) tv - A structure containing pointers to any available
-! thermodynamic fields. Absent fields have NULL ptrs.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) dt - Time increment, in s.
-! (out) Kd_int - The diagnosed diffusivities at interfaces, in m2 s-1.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! mixedlayer_init.
-! (in) dSV_dT - The partial derivative of in-situ specific volume with
-! potential temperature, in m3 kg-1 K-1.
-! (in) dSV_dS - The partial derivative of in-situ specific volume with
-! salinity, in m3 kg-1 ppt-1.
-! (in) TKE_forced - The forcing requirements to homogenize the forcing
-! that has been applied to each layer through each layer, in J m-2.
-! (in) Buoy_Flux - The surface buoyancy flux. in m2/s3.
-! (in,opt) dt_diag - The diagnostic time step, which may be less than dt
-! if there are two callse to mixedlayer, in s.
-! (in,opt) last_call - if true, this is the last call to mixedlayer in the
-! current time step, so diagnostics will be written.
-! The default is .true.
-
real, dimension(SZI_(G),SZK_(GV)) :: &
h, & ! The layer thickness, in H (usually m or kg m-2).
T, & ! The layer temperatures, in deg C.
@@ -405,9 +335,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
real :: dt_h ! The timestep divided by the averages of the thicknesses around
! a layer, times a thickness conversion factor, in H s m-2.
real :: h_bot ! The distance from the bottom, in H.
- real :: h_rsum ! The running sum of h from the top, in H.
+ real :: h_rsum ! The running sum of h from the top, in Z.
real :: I_hs ! The inverse of h_sum, in H-1.
- real :: I_mld ! The inverse of the current value of MLD, in H-1.
+ real :: I_MLD ! The inverse of the current value of MLD, in Z-1.
real :: h_tt ! The distance from the surface or up to the next interface
! that did not exhibit turbulent mixing from this scheme plus
! a surface mixing roughness length given by h_tt_min, in H.
@@ -417,14 +347,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
real :: vonKar ! The vonKarman constant.
real :: I_dtrho ! 1.0 / (dt * Rho0) in m3 kg-1 s-1. This is
! used convert TKE back into ustar^3.
- real :: U_star ! The surface friction velocity, in m s-1.
+ real :: U_star ! The surface friction velocity, in Z s-1.
real :: U_Star_Mean ! The surface friction without gustiness in m s-1.
real :: vstar ! An in-situ turbulent velocity, in m s-1.
real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact.
real :: LA ! The Langmuir number (non-dim)
real :: LAmod ! A modified Langmuir number accounting for other parameters.
real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a
- ! conversion factor from H to M, in m H-1.
+ ! conversion factor from H to Z, in Z H-1.
real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing, nondim.
real :: TKE_reduc ! The fraction by which TKE and other energy fields are
! reduced to support mixing, nondim. between 0 and 1.
@@ -443,7 +373,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
real :: dPE_conv ! The convective change in column potential energy, in J m-2.
real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K), in J m-2.
real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K), in J m-2 H-1.
- real :: Kd_guess0, PE_chg_g0, dPEa_dKd_g0, Kddt_h_g0
+ real :: Kd_guess0 ! A first guess of the diapycnal diffusivity, in Z2 s-1.
+ real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0
+ real :: dPEa_dKd_g0
+ real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided
+ ! by the average thicknesses around a layer, in H (m or kg m-2).
real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K).
real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K)
! for very small values of Kddt_h(K), in J m-2 H-1.
@@ -472,18 +406,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
real :: dt__diag ! A copy of dt_diag (if present) or dt, in s.
real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0), in m3 kg-1 s-1.
real, dimension(SZI_(G),SZJ_(G)) :: &
- Hsfc_used ! The thickness of the surface region after buffer layer
+ Hsfc_used ! The thickness of the surface region in Z
logical :: write_diags ! If true, write out diagnostics with this step.
logical :: reset_diags ! If true, zero out the accumulated diagnostics.
- ! detrainment, in units of m.
! Local column copies of energy change diagnostics, all in J m-2.
real :: dTKE_conv, dTKE_forcing, dTKE_mixing
real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay
!----------------------------------------------------------------------
!/BGR added Aug24,2016 for adding iteration to get boundary layer depth
! - needed to compute new mixing length.
- real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in m.
- real :: max_MLD, min_MLD ! Iteration bounds, in m, which are adjusted at each step
+ real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in Z.
+ real :: max_MLD, min_MLD ! Iteration bounds, in Z, which are adjusted at each step
! - These are initialized based on surface/bottom
! 1. The iteration guesses a value (possibly from
! prev step or neighbor).
@@ -531,29 +464,29 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
integer, save :: NOTCONVERGED!
!-End BGR iteration parameters-----------------------------------------
real :: N2_dissipation
- real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only)
+ real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only)
real :: Bf_UNSTABLE ! Buoyancy flux, floored at 0 (positive only)
- real :: STAB_SCALE ! Composite of Stabilizing length scales:
- ! Ekman scale and Monin-Obukhov scale.
- real :: iL_Ekman ! Inverse of Ekman length scale
- real :: iL_Obukhov ! Inverse of Obukhov length scale
+ real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales, in Z
+ real :: iL_Ekman ! Inverse of Ekman length scale, in Z-1
+ real :: iL_Obukhov ! Inverse of Obukhov length scale, in Z-1
real :: MLD_o_Ekman ! >
real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth
real :: Ekman_o_Obukhov_stab ! >
real :: MLD_o_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth
real :: Ekman_o_Obukhov_un ! >
- real :: C_MO = 1. ! Constant in STAB_SCALE for Monin-Obukhov
- real :: C_EK = 2. ! Constant in STAB_SCALE for Ekman length
- real :: MLD_over_STAB ! Mixing layer depth divided by STAB_SCALE
- real :: MSTAR_MIX! The value of mstar (Proportionality of TKE to drive mixing to ustar
+ real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov
+ real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length
+ real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale
+ real :: MSTAR_MIX ! The value of mstar (Proportionality of TKE to drive mixing to ustar
! cubed) which is computed as a function of latitude, boundary layer depth,
! and the Monin-Obukhov depth.
- real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence
+ real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence
real :: MSTAR_Conv_Adj ! Adjustment made to mstar due to convection reducing mechanical mixing.
real :: MSTAR_STAB, MSTAR_ROT ! Mstar in each limit, max is used.
logical :: debug=.false. ! Change this hard-coded value for debugging.
-! The following arrays are used only for debugging purposes.
+
+ ! The following arrays are used only for debugging purposes.
real :: dPE_debug, mixing_debug, taux2, tauy2
real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt
real, dimension(SZI_(G),SZK_(GV)) :: &
@@ -618,7 +551,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
!!OMP TKE_forced,debug,H_neglect,dSV_dT, &
!!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, &
!!OMP max_itt,Kd_int) &
-!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, &
+!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, &
!!OMP U_Star,absf,mech_TKE,conv_PErel,nstar_k, &
!!OMP h_sum,I_hs,h_bot,hb_hs,T0,S0,num_itts, &
!!OMP pres,dMass,dPres,dT_to_dPE,dS_to_dPE, &
@@ -650,8 +583,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
Kd(i,K) = 0.0
enddo ; enddo
do i=is,ie
- CS%ML_depth(i,j) = h(i,1)*GV%H_to_m
- !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_m
+ CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z
+ !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z
sfc_connected(i) = .true.
enddo
@@ -667,17 +600,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
! interface.
do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then
- U_Star = fluxes%ustar(i,j)
+ U_star = GV%m_to_Z*fluxes%ustar(i,j)
U_Star_Mean = fluxes%ustar_gustless(i,j)
if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then
if (fluxes%frac_shelf_h(i,j) > 0.0) &
- U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + &
- fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j)
+ U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + &
+ fluxes%frac_shelf_h(i,j) * GV%m_to_Z*fluxes%ustar_shelf(i,j)
endif
if (U_Star < CS%ustar_min) U_Star = CS%ustar_min
! Computing Bf w/ limiters.
- Bf_Stable = max(0.0,buoy_Flux(i,j)) ! Positive for stable
- Bf_Unstable = min(0.0,buoy_flux(i,j)) ! Negative for unstable
+ Bf_Stable = max(0.0, buoy_Flux(i,j)) ! Positive for stable
+ Bf_Unstable = min(0.0, buoy_flux(i,j)) ! Negative for unstable
if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega
else
absf(i) = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + &
@@ -687,13 +620,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
endif
! Computing stability scale which correlates with TKE for mixing, where
! TKE for mixing = TKE production minus TKE dissipation
- Stab_Scale = u_star**2 / ( VonKar * ( C_MO * BF_Stable/u_star - C_EK * u_star * absf(i)))
+ Stab_Scale = U_star**2 / ( VonKar * ( C_MO * BF_Stable / U_star - C_EK * U_star * absf(i)))
! Inverse of Ekman and Obukhov
- iL_Ekman = absf(i)/U_star
- iL_Obukhov = buoy_flux(i,j)*vonkar/U_Star**3
+ iL_Ekman = absf(i) / U_star
+ iL_Obukhov = buoy_flux(i,j)*vonkar / (U_star**3)
if (CS%Mstar_Mode == CS%CONST_MSTAR) then
- mech_TKE(i) = (dt*CS%mstar*GV%Rho0)*((U_Star**3))
+ mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * GV%Z_to_m**3 * U_star**3
conv_PErel(i) = 0.0
if (CS%TKE_diagnostics) then
@@ -733,7 +666,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
pres(i,1) = 0.0
do k=1,nz
dMass = GV%H_to_kg_m2 * h(i,k)
- dPres = GV%g_Earth * dMass
+ dPres = (GV%g_Earth*GV%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k)
dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k)
dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k)
dT_to_dColHt(i,k) = dMass * dSV_dT(i,j,k)
@@ -755,18 +688,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
!/The following lines are for the iteration over MLD
!{
! max_MLD will initialized as ocean bottom depth
- max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_m ; enddo
+ max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_Z ; enddo
min_MLD = 0.0 !min_MLD will initialize as 0.
!/BGR: May add user-input bounds for max/min MLD
!/BGR: Add MLD_guess based on stored previous value.
! note that this is different from ML_Depth already
! computed by EPBL, need to figure out why.
- if (CS%MLD_iteration_guess .and. CS%ML_Depth2(i,j) > 1.) then
+ if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*GV%m_to_Z)) then
!If prev value is present use for guess.
- MLD_guess=CS%ML_Depth2(i,j)
+ MLD_guess = CS%ML_Depth2(i,j)
else
- !Otherwise guess middle of water column (or stab_scale if smaller).
+ !Otherwise guess middle of water column (or Stab_Scale if smaller).
MLD_guess = 0.5 * (min_MLD+max_MLD)
endif
@@ -779,8 +712,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
do OBL_IT=1,MAX_OBL_IT ; if (.not. OBL_CONVERGED) then
! Reset ML_depth
- CS%ML_depth(i,j) = h(i,1)*GV%H_to_m
- !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_m
+ CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z
+ !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z
sfc_connected(i) = .true.
@@ -812,8 +745,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
endif
elseif (CS%MSTAR_MODE == CS%EKMAN_o_OBUKHOV) then
!### Please refrain from using the construct A / B / C in place of A/(B*C).
- mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable/u_star**2/(absf(i)+1.e-10))
- mstar_ROT = CS%C_EK*log(max(1.,u_star/(absf(i)+1.e-10)/mld_guess))
+ mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / U_star**2 / (absf(i)+1.e-10))
+ mstar_ROT = CS%C_EK * log(max(1., U_star / (absf(i)+1.e-10) / MLD_guess))
if ( CS%MSTAR_CAP <= 0.0) then !No cap.
MSTAR_MIX = max(mstar_STAB,& ! 1st term if balance of rotation and stabilizing
! the balance is f(L_Ekman,L_Obukhov)
@@ -836,18 +769,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
! Adjustment for unstable buoyancy flux.
! Convection reduces mechanical mixing because there
! is less density gradient to mix. (Statically unstable near surface)
- MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable+1.e-10) / &
- ( (-Bf_Unstable+1.e-10)+ &
- 2. *MSTAR_MIX *U_STAR**3 / MLD_GUESS )
+ MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*GV%m_to_Z**2) / &
+ ( (-Bf_Unstable + 1.e-10*GV%m_to_Z**2) + &
+ 2.0 *MSTAR_MIX * U_star**3 / MLD_guess )
if (CS%USE_LT) then
- call get_Langmuir_Number( LA, G, GV, abs(MLD_guess), u_star_mean, I, J, &
+ call get_Langmuir_Number( LA, G, GV, abs(GV%Z_to_m*MLD_guess), u_star_mean, i, j, &
H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES)
! 2. Get parameters for modified LA
- MLD_o_Ekman = abs(MLD_guess*iL_Ekman)
- MLD_o_Obukhov_stab = abs(max(0.,MLD_guess*iL_Obukhov))
- MLD_o_Obukhov_un = abs(min(0.,MLD_guess*iL_Obukhov))
- Ekman_o_Obukhov_stab = abs(max(0.,iL_Obukhov/(iL_Ekman+1.e-10)))
- Ekman_o_Obukhov_un = abs(min(0.,iL_Obukhov/(iL_Ekman+1.e-10)))
+ MLD_o_Ekman = abs(MLD_guess * iL_Ekman)
+ MLD_o_Obukhov_stab = abs(max(0., MLD_guess*iL_Obukhov))
+ MLD_o_Obukhov_un = abs(min(0., MLD_guess*iL_Obukhov))
+ Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m)))
+ Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m)))
! 3. Adjust LA based on various parameters.
! Assumes linear factors based on length scale ratios to adjust LA
! Note when these coefficients are set to 0 recovers simple LA.
@@ -871,7 +804,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
endif
endif
!Reset mech_tke and conv_perel values (based on new mstar)
- mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * (dt*GV%Rho0*U_Star**3)
+ mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * &
+ GV%Z_to_m**3 * (dt*GV%Rho0*U_star**3)
conv_PErel(i) = 0.0
if (CS%TKE_diagnostics) then
CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0
@@ -922,7 +856,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
I_MLD = 1.0 / MLD_guess ; h_rsum = 0.0
MixLen_shape(1) = 1.0
do K=2,nz+1
- h_rsum = h_rsum + h(i,k-1)*GV%H_to_m
+ h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z
if (CS%MixLenExponent==2.0)then
MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * &
(max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2!CS%MixLenExponent
@@ -954,7 +888,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
! different rates. The following form is often used for mechanical
! stirring from the surface, perhaps due to breaking surface gravity
! waves and wind-driven turbulence.
- Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_Star) * GV%H_to_m
+ Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_star) * GV%H_to_Z
exp_kh = 1.0
if (Idecay_len_TKE(i) > 0.0) exp_kh = exp(-h(i,k-1)*Idecay_len_TKE(i))
if (CS%TKE_diagnostics) &
@@ -1025,7 +959,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2))
endif
endif
- dt_h = (GV%m_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i))
+ dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i))
! This tests whether the layers above and below this interface are in
! a convetively stable configuration, without considering any effects of
@@ -1115,13 +1049,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i)
if (TKE_here > 0.0) then
vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3
- hbs_here = GV%H_to_m * min(hb_hs(i,K), MixLen_shape(K))
+ hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K))
Mixing_Length_Used(k) = MAX(CS%min_mix_len,((h_tt*hbs_here)*vstar) / &
((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar))
!Note setting Kd_guess0 to Mixing_Length_Used(K) here will
! change the answers. Therefore, skipping that.
if (.not.CS%Use_MLD_Iteration) then
- Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / &
+ Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / &
((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)
else
Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k)
@@ -1167,16 +1101,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max)
if (TKE_here > 0.0) then
vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3
- hbs_here = GV%H_to_m * min(hb_hs(i,K), MixLen_shape(K))
+ hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K))
Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / &
((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar))
if (.not.CS%Use_MLD_Iteration) then
! Note again (as prev) that using Mixing_Length_Used here
! instead of redoing the computation will change answers...
- Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / &
+ Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / &
((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)
else
- Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k)
+ Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k)
endif
else
vstar = 0.0 ; Kd(i,k) = 0.0
@@ -1215,8 +1149,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0
endif
if (sfc_connected(i)) then
- CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_m * h(i,k)
- !CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_m * h(i,k)
+ CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k)
+ ! CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k)
endif
Kddt_h(K) = Kd(i,k)*dt_h
@@ -1240,8 +1174,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
mech_TKE(i) = TKE_reduc*(mech_TKE(i) + MKE_src)
conv_PErel(i) = TKE_reduc*conv_PErel(i)
if (sfc_connected(i)) then
- CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_m * h(i,k)
- !CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_m * h(i,k)
+ CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k)
+ ! CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k)
endif
elseif (tot_TKE == 0.0) then
! This can arise if nstar_FC = 0.
@@ -1343,7 +1277,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
endif
if (sfc_connected(i)) CS%ML_depth(i,J) = CS%ML_depth(i,J) + &
- (PE_chg / PE_chg_g0) * GV%H_to_m * h(i,k)
+ (PE_chg / PE_chg_g0) * GV%H_to_Z * h(i,k)
tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0
sfc_disconnect = .true.
endif
@@ -1427,18 +1361,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
ITmin(obl_it) = min_MLD ! Track min } For debug purpose
ITguess(obl_it) = MLD_guess ! Track guess }
!/
- MLD_FOUND=0.0 ; FIRST_OBL=.true.
+ MLD_found = 0.0 ; FIRST_OBL = .true.
if (CS%Orig_MLD_iteration) then
!This is how the iteration was original conducted
do k=2,nz
if (FIRST_OBL) then !Breaks when OBL found
- if (Vstar_Used(k) > 1.e-10 .and. k < nz) then
- MLD_FOUND = MLD_FOUND + h(i,k-1)*GV%H_to_m
+ if ((Vstar_Used(k) > 1.e-10*GV%m_to_Z) .and. k < nz) then
+ MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z
else
FIRST_OBL = .false.
- if (MLD_FOUND-CS%MLD_tol > MLD_guess) then
+ if (MLD_found - CS%MLD_tol > MLD_guess) then
min_MLD = MLD_guess
- elseif ((MLD_guess-MLD_FOUND) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_m)) then
+ elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then
OBL_CONVERGED = .true.!Break convergence loop
if (OBL_IT_STATS) then !Compute iteration statistics
MAXIT = max(MAXIT,obl_it)
@@ -1456,10 +1390,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
enddo
else
!New method uses ML_DEPTH as computed in ePBL routine
- MLD_FOUND=CS%ML_DEPTH(i,j)
- if (MLD_FOUND-CS%MLD_tol > MLD_guess) then
+ MLD_found = CS%ML_Depth(i,j)
+ if (MLD_found - CS%MLD_tol > MLD_guess) then
min_MLD = MLD_guess
- elseif (abs(MLD_guess-MLD_FOUND) < (CS%MLD_tol)) then
+ elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then
OBL_CONVERGED = .true.!Break convergence loop
if (OBL_IT_STATS) then !Compute iteration statistics
MAXIT = max(MAXIT,obl_it)
@@ -1474,8 +1408,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
endif
endif
! For next pass, guess average of minimum and maximum values.
- MLD_guess = min_MLD*0.5 + max_MLD*0.5
- ITresult(obl_it) = MLD_FOUND
+ MLD_guess = 0.5*(min_MLD + max_MLD)
+ ITresult(obl_it) = MLD_found
endif ; enddo ! Iteration loop for converged boundary layer thickness.
if (.not.OBL_CONVERGED) then
!/Temp output, warn that EPBL didn't converge
@@ -1518,13 +1452,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
if (allocated(CS%Enhance_M)) CS%Enhance_M(i,j) = Enhance_M
if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = MSTAR_MIX
if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT
- if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = (MLD_guess*iL_Obukhov)
- if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = (MLD_guess*iL_Ekman)
- if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = (iL_Obukhov/(iL_Ekman+1.e-10))
+ if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = MLD_guess * iL_Obukhov
+ if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = MLD_guess * iL_Ekman
+ if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m)
if (allocated(CS%La)) CS%La(i,j) = LA
if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod
else
- ! For masked points, Kd_int must still be set (to 0) because it has intent(out).
+ ! For masked points, Kd_int must still be set (to 0) because it has intent out.
do K=1,nz+1
Kd(i,K) = 0.
enddo
@@ -1537,9 +1471,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, &
endif ; enddo ; ! Close of i-loop - Note unusual loop order!
if (CS%id_Hsfc_used > 0) then
- do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_m ; enddo
+ do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_Z ; enddo
do k=2,nz ; do i=is,ie
- if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_m
+ if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_Z
enddo ; enddo
endif
@@ -1896,22 +1830,30 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, &
end subroutine find_PE_chg_orig
!> Copies the ePBL active mixed layer depth into MLD
-subroutine energetic_PBL_get_MLD(CS, MLD, G)
+subroutine energetic_PBL_get_MLD(CS, MLD, G, GV, m_to_MLD_units)
type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL
type(ocean_grid_type), intent(in) :: G !< Grid structure
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer, in m
+ real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the desired units for MLD
! Local variables
+ real :: scale ! A dimensional rescaling factor
integer :: i,j
+
+ scale = GV%Z_to_m ; if (present(m_to_MLD_units)) scale = scale * m_to_MLD_units
+
do j = G%jsc, G%jec ; do i = G%isc, G%iec
- MLD(i,j) = CS%ML_depth(i,j)
+ MLD(i,j) = scale*CS%ML_Depth(i,j)
enddo ; enddo
+
end subroutine energetic_PBL_get_MLD
!> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship
subroutine ust_2_u10_coare3p5(USTair,U10,GV)
- real, intent(in) :: USTair
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, intent(out) :: U10
+ real, intent(in) :: USTair !< Ustar in the air, in m s-1.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, intent(out) :: U10 !< The 10 m wind speed, in m s-1.
+
real, parameter :: vonkar = 0.4
real, parameter :: nu=1e-6
real :: z0sm, z0, z0rough, u10a, alpha, CD
@@ -1932,7 +1874,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV)
CT=CT+1
u10a = u10
alpha = min(0.028,0.0017 * u10 - 0.005)
- z0rough = alpha * USTair**2/GV%g_Earth ! Compute z0rough from ustar guess
+ z0rough = alpha * USTair**2/(GV%g_Earth*GV%m_to_Z) ! Compute z0rough from ustar guess
z0=z0sm+z0rough
CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness
u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop
@@ -1950,7 +1892,13 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV)
return
end subroutine ust_2_u10_coare3p5
+!> This subroutine returns the Langmuir number, given ustar and the boundary
+!! layer thickness, inclusion conversion to the 10m wind.
subroutine get_LA_windsea(ustar, hbl, GV, LA)
+ real, intent(in) :: ustar !< The water-side surface friction velocity (m/s)
+ real, intent(in) :: hbl !< The ocean boundary layer depth (m)
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, intent(out) :: LA !< The Langmuir number returned from this module
! Original description:
! This function returns the enhancement factor, given the 10-meter
! wind (m/s), friction velocity (m/s) and the boundary layer depth (m).
@@ -1965,13 +1913,6 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA)
! BGR remove u10 input
! Input
- real, intent(in) :: &
- ! water-side surface friction velocity (m/s)
- ustar, &
- ! boundary layer depth (m)
- hbl
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, intent(out) :: LA
! Local variables
! parameters
real, parameter :: &
@@ -1989,22 +1930,21 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA)
real :: pi, u10
pi = 4.0*atan(1.0)
if (ustar > 0.0) then
- ! Computing u10 based on u_star and COARE 3.5 relationships
- call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225),U10,GV)
+ ! Computing u10 based on ustar and COARE 3.5 relationships
+ call ust_2_u10_coare3p5(ustar * sqrt(GV%Rho0/1.225), U10, GV)
! surface Stokes drift
us = us_to_u10*u10
- !
- ! significant wave height from Pierson-Moskowitz
- ! spectrum (Bouws, 1998)
+
+ ! significant wave height from Pierson-Moskowitz spectrum (Bouws, 1998)
hm0 = 0.0246 *u10**2
- !
+
! peak frequency (PM, Bouws, 1998)
tmp = 2.0 * PI * u19p5_to_u10 * u10
- fp = 0.877 * GV%g_Earth / tmp
- !
+ fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp
+
! mean frequency
fm = fm_to_fp * fp
- !
+
! total Stokes transport (a factor r_loss is applied to account
! for the effect of directional spreading, multidirectional waves
! and the use of PM peak frequency and PM significant wave height
@@ -2044,13 +1984,15 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA)
endif
endsubroutine Get_LA_windsea
+!> This subroutine initializes the energetic_PBL module
subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS)
- type(time_type), target, intent(in) :: Time
+ type(time_type), target, intent(in) :: Time !< The current model time
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- type(diag_ctrl), target, intent(inout) :: diag
- type(energetic_PBL_CS), pointer :: CS
+ type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output
+ type(energetic_PBL_CS), pointer :: CS !< A pointer that is set to point to the control
+ !! structure for this module
! Arguments: Time - The current model time.
! (in) G - The ocean's grid structure.
! (in) GV - The ocean's vertical grid structure.
@@ -2168,7 +2110,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS)
call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, &
"An overall nondimensional scaling factor for v*. \n"// &
"Making this larger decreases the PBL diffusivity.", &
- units="nondim", default=1.0)
+ units="nondim", default=1.0, scale=GV%m_to_Z)
call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, &
"A nondimensional scaling factor controlling the inhibition \n"// &
"of the diffusive length scale by rotation. Making this larger \n"//&
@@ -2188,11 +2130,11 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS)
call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, &
"The tolerance for the iteratively determined mixed \n"// &
"layer depth. This is only used with USE_MLD_ITERATION.", &
- units="meter", default=1.0)
+ units="meter", default=1.0, scale=GV%m_to_Z)
call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, &
"The minimum mixing length scale that will be used \n"//&
"by ePBL. The default (0) does not set a minimum.", &
- units="meter", default=0.0)
+ units="meter", default=0.0, scale=GV%m_to_Z)
call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, &
"If true, the ePBL code uses the original form of the \n"// &
"potential energy change code. Otherwise, the newer \n"// &
@@ -2266,13 +2208,13 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS)
units="nondim", default=0.95)
endif
! This gives a minimum decay scale that is typically much less than Angstrom.
- CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff)
- call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min, &
+ CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff)
+ call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*GV%Z_to_m, &
"The (tiny) minimum friction velocity used within the \n"//&
"ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1")
CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, &
- Time, 'Surface boundary layer depth', 'm', &
+ Time, 'Surface boundary layer depth', 'm', conversion=GV%Z_to_m, &
cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme')
CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, &
Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3')
@@ -2290,17 +2232,17 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS)
CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, &
Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3')
CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, &
- Time, 'Surface region thickness that is used', 'm')
+ Time, 'Surface region thickness that is used', 'm', conversion=GV%m_to_Z)
CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, &
- Time, 'Mixing Length that is used', 'm')
+ Time, 'Mixing Length that is used', 'm', conversion=GV%Z_to_m)
CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, &
- Time, 'Velocity Scale that is used.', 'm s-1')
+ Time, 'Velocity Scale that is used.', 'm s-1', conversion=GV%Z_to_m)
CS%id_LT_enhancement = register_diag_field('ocean_model', 'LT_Enhancement', diag%axesT1, &
Time, 'LT enhancement that is used.', 'nondim')
CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, &
Time, 'MSTAR that is used.', 'nondim')
CS%id_OSBL = register_diag_field('ocean_model', 'ePBL_OSBL', diag%axesT1, &
- Time, 'ePBL Surface Boundary layer depth.', 'm')
+ Time, 'ePBL Surface Boundary layer depth.', 'm', conversion=GV%m_to_Z)
! BGR (9/21/2017) Note that ePBL_OSBL is the guess for iteration step while ePBL_h_ML is
! result from iteration step.
CS%id_mld_ekman = register_diag_field('ocean_model', 'MLD_EKMAN', diag%axesT1, &
@@ -2367,8 +2309,10 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS)
end subroutine energetic_PBL_init
+!> Clean up and deallocate memory associated with the energetic_PBL module.
subroutine energetic_PBL_end(CS)
- type(energetic_PBL_CS), pointer :: CS
+ type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure that
+ !! will be deallocated in this subroutine.
if (.not.associated(CS)) return
@@ -2396,4 +2340,33 @@ subroutine energetic_PBL_end(CS)
end subroutine energetic_PBL_end
+!> \namespace MOM_energetic_PBL
+!!
+!! By Robert Hallberg, 2015.
+!!
+!! This file contains the subroutine (energetic_PBL) that uses an
+!! integrated boundary layer energy budget (like a bulk- or refined-
+!! bulk mixed layer scheme), but instead of homogenizing this model
+!! calculates a finite diffusivity and viscosity, which in this
+!! regard is conceptually similar to what is done with KPP or various
+!! two-equation closures. However, the scheme that is implemented
+!! here has the big advantage that is entirely implicit, but is
+!! simple enough that it requires only a single vertical pass to
+!! determine the diffusivity. The development of bulk mixed layer
+!! models stems from the work of various people, as described in the
+!! review paper by Niiler and Kraus (1979). The work here draws in
+!! with particular on the form for TKE decay proposed by Oberhuber
+!! (JPO, 1993, 808-829), with an extension to a refined bulk mixed
+!! layer as described in Hallberg (Aha Huliko'a, 2003). The physical
+!! processes portrayed in this subroutine include convectively driven
+!! mixing and mechanically driven mixing. Unlike boundary-layer
+!! mixing, stratified shear mixing is not a one-directional turbulent
+!! process, and it is dealt with elsewhere in the MOM6 code within
+!! the module MOM_kappa_shear.F90. It is assumed that the heat,
+!! mass, and salt fluxes have been applied elsewhere, but that their
+!! implications for the integrated TKE budget have been captured in
+!! an array that is provided as an argument to this subroutine. This
+!! is a full 3-d array due to the effects of penetrating shortwave
+!! radiation.
+
end module MOM_energetic_PBL
diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90
index 5f3f982dd1..4ddde1060c 100644
--- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90
+++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90
@@ -1,55 +1,8 @@
+!> Diapycnal mixing and advection in isopycnal mode
module MOM_entrain_diffusive
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, September 1997 - July 2000 *
-!* *
-!* This file contains the subroutines that implement diapycnal *
-!* mixing and advection in isopycnal layers. The main subroutine, *
-!* calculate_entrainment, returns the entrainment by each layer *
-!* across the interfaces above and below it. These are calculated *
-!* subject to the constraints that no layers can be driven to neg- *
-!* ative thickness and that the each layer maintains its target *
-!* density, using the scheme described in Hallberg (MWR 2000). There *
-!* may or may not be a bulk mixed layer above the isopycnal layers. *
-!* The solution is iterated until the change in the entrainment *
-!* between successive iterations is less than some small tolerance. *
-!* *
-!* The dual-stream entrainment scheme of MacDougall and Dewar *
-!* (JPO 1997) is used for combined diapycnal advection and diffusion, *
-!* modified as described in Hallberg (MWR 2000) to be solved *
-!* implicitly in time. Any profile of diffusivities may be used. *
-!* Diapycnal advection is fundamentally the residual of diapycnal *
-!* diffusion, so the fully implicit upwind differencing scheme that *
-!* is used is entirely appropriate. The downward buoyancy flux in *
-!* each layer is determined from an implicit calculation based on *
-!* the previously calculated flux of the layer above and an estim- *
-!* ated flux in the layer below. This flux is subject to the foll- *
-!* owing conditions: (1) the flux in the top and bottom layers are *
-!* set by the boundary conditions, and (2) no layer may be driven *
-!* below an Angstrom thickness. If there is a bulk mixed layer, the *
-!* mixed and buffer layers are treated as Eulerian layers, whose *
-!* thicknesses only change due to entrainment by the interior layers. *
-!* *
-!* In addition, the model may adjust the fluxes to drive the layer *
-!* densities (sigma 2?) back toward their targer values. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, buoy, T, S, ea, eb, etc. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
use MOM_diag_mediator, only : diag_ctrl, time_type
use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE
@@ -66,29 +19,28 @@ module MOM_entrain_diffusive
public entrainment_diffusive, entrain_diffusive_init, entrain_diffusive_end
+!> The control structure holding parametes for the MOM_entrain_diffusive module
type, public :: entrain_diffusive_CS ; private
- logical :: bulkmixedlayer ! If true, a refined bulk mixed layer is used with
- ! GV%nk_rho_varies variable density mixed & buffer
- ! layers.
- logical :: correct_density ! If true, the layer densities are restored toward
- ! their target variables by the diapycnal mixing.
- integer :: max_ent_it ! The maximum number of iterations that may be
- ! used to calculate the diapycnal entrainment.
- real :: Tolerance_Ent ! The tolerance with which to solve for entrainment
- ! values, in m.
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- integer :: id_Kd = -1, id_diff_work = -1
+ logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with
+ !! GV%nk_rho_varies variable density mixed & buffer layers.
+ logical :: correct_density !< If true, the layer densities are restored toward
+ !! their target variables by the diapycnal mixing.
+ integer :: max_ent_it !< The maximum number of iterations that may be used to
+ !! calculate the diapycnal entrainment.
+ real :: Tolerance_Ent !< The tolerance with which to solve for entrainment values, in m.
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ integer :: id_Kd = -1 !< Diagnostic ID for diffusivity
+ integer :: id_diff_work = -1 !< Diagnostic ID for mixing work
end type entrain_diffusive_CS
contains
-!> This subroutine calculates ea and eb, the rates at which a layer
-!! entrains from the layers above and below. The entrainment rates
-!! are proportional to the buoyancy flux in a layer and inversely
-!! proportional to the density differences between layers. The
-!! scheme that is used here is described in detail in Hallberg, Mon.
-!! Wea. Rev. 2000.
+!> This subroutine calculates ea and eb, the rates at which a layer entrains
+!! from the layers above and below. The entrainment rates are proportional to
+!! the buoyancy flux in a layer and inversely proportional to the density
+!! differences between layers. The scheme that is used here is described in
+!! detail in Hallberg, Mon. Wea. Rev. 2000.
subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, &
kb_out, Kd_Lay, Kd_int)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
@@ -117,43 +69,20 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, &
!! as h, m or kg m-2.
integer, dimension(SZI_(G),SZJ_(G)), &
optional, intent(inout) :: kb_out !< The index of the lightest layer denser than
- !! the buffer layer. At least one of the two
- !! arguments must be present.
+ !! the buffer layer.
+ ! At least one of the two following arguments must be present.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers,
- !! in m2 s-1.
+ !! in Z2 s-1.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), &
optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces,
- !! in m2 s-1.
-
-! This subroutine calculates ea and eb, the rates at which a layer
-! entrains from the layers above and below. The entrainment rates
-! are proportional to the buoyancy flux in a layer and inversely
-! proportional to the density differences between layers. The
-! scheme that is used here is described in detail in Hallberg, Mon.
-! Wea. Rev. 2000.
-
-! Arguments: u - Zonal velocity, in m s-1.
-! (in) v - Meridional velocity, in m s-1.
-! (in) h - Layer thickness, in m or kg m-2.
-! (in) fluxes - A structure of surface fluxes that may be used.
-! (in) kb_out - The index of the lightest layer denser than the
-! buffer layers.
-! (in) tv - A structure containing pointers to any available
-! thermodynamic fields. Absent fields have NULL ptrs.
-! (in) dt - The time increment in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! entrain_diffusive_init.
-! (out) ea - The amount of fluid entrained from the layer above within
-! this time step, in the same units as h, m or kg m-2.
-! (out) eb - The amount of fluid entrained from the layer below within
-! this time step, in the same units as h, m or kg m-2.
-! (out,opt) kb - The index of the lightest layer denser than the buffer layer.
-! At least one of the two arguments must be present.
-! (in,opt) Kd_Lay - The diapycnal diffusivity of layers, in m2 s-1.
-! (in,opt) Kd_int - The diapycnal diffusivity of interfaces, in m2 s-1.
+ !! in Z2 s-1.
+
+! This subroutine calculates ea and eb, the rates at which a layer entrains
+! from the layers above and below. The entrainment rates are proportional to
+! the buoyancy flux in a layer and inversely proportional to the density
+! differences between layers. The scheme that is used here is described in
+! detail in Hallberg, Mon. Wea. Rev. 2000.
! In the comments below, H is used as shorthand for the units of h, m or kg m-2.
real, dimension(SZI_(G),SZK_(G)) :: &
@@ -242,7 +171,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, &
real :: dRHo ! The change in locally referenced potential density between
! the layers above and below an interface, in kg m-3.
- real :: g_2dt ! 0.5 * G_Earth / dt, in m s-3.
+ real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors, in m3 H-2 s-3.
real, dimension(SZI_(G)) :: &
pressure, & ! The pressure at an interface, in Pa.
T_eos, S_eos, & ! The potential temperature and salinity at which to
@@ -265,7 +194,6 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, &
real :: h1 ! The layer thickness after entrainment through the
! interface below is taken into account, in H.
real :: Idt ! The inverse of the time step, in s-1.
- real :: H_to_m, m_to_H ! Local copies of unit conversion factors.
logical :: do_any
logical :: do_i(SZI_(G)), did_i(SZI_(G)), reiterate, correct_density
@@ -275,7 +203,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, &
integer :: kb_min_act ! The minimum active value of kb in the current j-row.
integer :: is1, ie1 ! The minimum and maximum active values of i in the current j-row.
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
- Angstrom = GV%Angstrom
+ Angstrom = GV%Angstrom_H
h_neglect = GV%H_subroundoff
if (.not. associated(CS)) call MOM_error(FATAL, &
@@ -295,9 +223,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, &
&and a linear equation of state to drive the model.")
endif
- H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H
- tolerance = m_to_H * CS%Tolerance_Ent
- g_2dt = 0.5 * GV%g_Earth / dt
+ tolerance = CS%Tolerance_Ent
kmb = GV%nk_rho_varies
K2 = max(kmb+1,2) ; kb_min = K2
if (.not. CS%bulkmixedlayer) then
@@ -323,7 +249,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, &
!$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_Lay,G,GV,dt,Kd_int,CS,h,tv, &
!$OMP kmb,Angstrom,fluxes,K2,h_neglect,tolerance, &
!$OMP ea,eb,correct_density,Kd_eff,diff_work, &
-!$OMP g_2dt, kb_out, m_to_H, H_to_m) &
+!$OMP 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, &
!$OMP I2p2dsp1_ds,grats,htot,max_eakb,I_dSkbp1, &
@@ -341,23 +267,23 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, &
if (present(Kd_Lay)) then
do k=1,nz ; do i=is,ie
- dtKd(i,k) = m_to_H**2 * (dt*Kd_Lay(i,j,k))
+ dtKd(i,k) = GV%Z_to_H**2 * (dt*Kd_lay(i,j,k))
enddo ; enddo
if (present(Kd_int)) then
do K=1,nz+1 ; do i=is,ie
- dtKd_int(i,K) = m_to_H**2 * (dt*Kd_int(i,j,K))
+ dtKd_int(i,K) = GV%Z_to_H**2 * (dt*Kd_int(i,j,K))
enddo ; enddo
else
do K=2,nz ; do i=is,ie
- dtKd_int(i,K) = m_to_H**2 * (0.5*dt*(Kd_Lay(i,j,k-1) + Kd_Lay(i,j,k)))
+ dtKd_int(i,K) = GV%Z_to_H**2 * (0.5*dt*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)))
enddo ; enddo
endif
else ! Kd_int must be present, or there already would have been an error.
do k=1,nz ; do i=is,ie
- dtKd(i,k) = m_to_H**2 * (0.5*dt*(Kd_int(i,j,K)+Kd_int(i,j,K+1)))
+ dtKd(i,k) = GV%Z_to_H**2 * (0.5*dt*(Kd_int(i,j,K)+Kd_int(i,j,K+1)))
enddo ; enddo
dO K=1,nz+1 ; do i=is,ie
- dtKd_int(i,K) = m_to_H**2 * (dt*Kd_int(i,j,K))
+ dtKd_int(i,K) = GV%Z_to_H**2 * (dt*Kd_int(i,j,K))
enddo ; enddo
endif
@@ -455,7 +381,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, &
htot(i) = h(i,j,1) - Angstrom
enddo
if (associated(fluxes%buoy)) then ; do i=is,ie
- maxF(i,1) = (dt*fluxes%buoy(i,j)) / GV%g_prime(2)
+ maxF(i,1) = (dt*fluxes%buoy(i,j)) / (GV%g_prime(2)*GV%m_to_Z)
enddo ; endif
endif
@@ -880,22 +806,23 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, &
endif ! correct_density
if (CS%id_Kd > 0) then
- Idt = 1.0 / dt
+ Idt = GV%H_to_Z**2 / dt
do k=2,nz-1 ; do i=is,ie
if (k 0) then
+ g_2dt = 0.5 * GV%H_to_Z**2 * (GV%g_Earth / dt)
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
@@ -959,18 +886,36 @@ end subroutine entrainment_diffusive
!! amount of surface forcing that is applied to each layer if there is no bulk
!! mixed layer.
subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, do_i_in)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: F
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- integer, dimension(SZI_(G)), intent(in) :: kb
- integer, intent(in) :: kmb, j
- type(entrain_diffusive_CS), intent(in) :: CS
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: dsp1_ds
- real, dimension(SZI_(G)), intent(in) :: eakb
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: ea, eb
- logical, dimension(SZI_(G)), optional, intent(in) :: do_i_in
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: F !< The density flux through a layer within
+ !! a time step divided by the density
+ !! difference across the interface below
+ !! the layer, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ integer, dimension(SZI_(G)), intent(in) :: kb !< The index of the lightest layer denser than
+ !! the deepest buffer layer.
+ integer, intent(in) :: kmb !< The number of mixed and buffer layers.
+ integer, intent(in) :: j !< The meridional index upon which to work.
+ type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure.
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: dsp1_ds !< The ratio of coordinate variable
+ !! differences across the interfaces below
+ !! a layer over the difference across the
+ !! interface above the layer.
+ real, dimension(SZI_(G)), intent(in) :: eakb !< The entrainment from above by the layer
+ !! below the buffer layer, in H.
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and
+ !! downward across each interface around
+ !! the buffer layers, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: ea !< The amount of fluid entrained from the layer
+ !! above within this time step, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: eb !< The amount of fluid entrained from the layer
+ !! below within this time step, in H.
+ logical, dimension(SZI_(G)), &
+ optional, intent(in) :: do_i_in !< Indicates which i-points to work on.
! This subroutine calculates the actual entrainments (ea and eb) and the
! amount of surface forcing that is applied to each layer if there is no bulk
! mixed layer.
@@ -1017,7 +962,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb,
ea(i,j,k) = ea(i,j,k+1)
! Add the entrainment of the thin interior layers to eb going
! up into the buffer layer.
- eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom)
+ eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom_H)
endif
endif ; enddo ; enddo
k = kmb
@@ -1025,10 +970,10 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb,
! Adjust the previously calculated entrainment from below by the deepest
! buffer layer to account for entrainment of thin interior layers .
if (kb(i) > kmb+1) &
- eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom)
+ eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom_H)
! Determine the entrainment from above for each buffer layer.
- h1 = (h(i,j,k) - GV%Angstrom) + (eb(i,j,k) - ea(i,j,k+1))
+ h1 = (h(i,j,k) - GV%Angstrom_H) + (eb(i,j,k) - ea(i,j,k+1))
ea(i,j,k) = MAX(Ent_bl(i,K), Ent_bl(i,K)-0.5*h1, -h1)
endif ; enddo
do k=kmb-1,2,-1 ; do i=is,ie ; if (do_i(i)) then
@@ -1036,7 +981,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb,
eb(i,j,k) = max(2.0*Ent_bl(i,K+1) - ea(i,j,k+1), 0.0)
! Determine the entrainment from above for each buffer layer.
- h1 = (h(i,j,k) - GV%Angstrom) + (eb(i,j,k) - ea(i,j,k+1))
+ h1 = (h(i,j,k) - GV%Angstrom_H) + (eb(i,j,k) - ea(i,j,k+1))
ea(i,j,k) = MAX(Ent_bl(i,K), Ent_bl(i,K)-0.5*h1, -h1)
! if (h1 >= 0.0) then ; ea(i,j,k) = Ent_bl(i,K)
! elseif (Ent_bl(i,K)+0.5*h1 >= 0.0) then ; ea(i,j,k) = Ent_bl(i,K)-0.5*h1
@@ -1086,12 +1031,11 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref
integer, dimension(SZI_(G)), intent(inout) :: kb !< The index of the lightest layer denser
!! than the buffer layer or 1 if there is
!! no buffer layer.
- integer, intent(in) :: kmb
+ integer, intent(in) :: kmb !< The number of mixed and buffer layers.
logical, dimension(SZI_(G)), intent(in) :: do_i !< A logical variable indicating which
!! i-points to work on.
type(entrain_diffusive_CS), pointer :: CS !< This module's control structure.
- integer, intent(in) :: j !< The meridional index upon which
- !! to work.
+ integer, intent(in) :: j !< The meridional index upon which to work.
real, dimension(SZI_(G),SZK_(G)+1), &
intent(out) :: Ent_bl !< The average entrainment upward and
!! downward across each interface around
@@ -1143,7 +1087,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref
integer :: i, k, is, ie, nz
is = G%isc ; ie = G%iec ; nz = G%ke
-! max_ent = 1.0e14*GV%Angstrom ! This is set to avoid roundoff problems.
+! max_ent = 1.0e14*GV%Angstrom_H ! This is set to avoid roundoff problems.
max_ent = 1.0e4*GV%m_to_H
h_neglect = GV%H_subroundoff
@@ -1197,9 +1141,9 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref
do k=kmb+1,nz ; do i=is,ie ; if (do_i(i)) then
if ((k == kb(i)) .and. (S_est(i,kmb) > (GV%Rlay(k) - 1000.0))) then
if (4.0*dtKd_int(i,Kmb+1)*frac_rem(i) > &
- (h_bl(i,kmb) + h(i,j,k)) * (h(i,j,k) - GV%Angstrom)) then
+ (h_bl(i,kmb) + h(i,j,k)) * (h(i,j,k) - GV%Angstrom_H)) then
! Entrain this layer into the buffer layer and move kb down.
- dh = max((h(i,j,k) - GV%Angstrom), 0.0)
+ dh = max((h(i,j,k) - GV%Angstrom_H), 0.0)
if (dh > 0.0) then
frac_rem(i) = frac_rem(i) - ((h_bl(i,kmb) + h(i,j,k)) * dh) / &
(4.0*dtKd_int(i,Kmb+1))
@@ -1217,7 +1161,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref
! This is where variables are be set up with a different vertical grid
! in which the (newly?) massless layers are taken out.
do k=nz,kmb+1,-1 ; do i=is,ie
- if (k >= kb(i)) h_interior(i) = h_interior(i) + (h(i,j,k)-GV%Angstrom)
+ if (k >= kb(i)) h_interior(i) = h_interior(i) + (h(i,j,k)-GV%Angstrom_H)
if (k==kb(i)) then
h_bl(i,kmb+1) = h(i,j,k) ; Sref(i,kmb+1) = GV%Rlay(k) - 1000.0
elseif (k==kb(i)+1) then
@@ -1227,7 +1171,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref
do i=is,ie ; if (kb(i) >= nz) then
h_bl(i,kmb+1) = h(i,j,nz)
Sref(i,kmb+1) = GV%Rlay(nz) - 1000.0
- h_bl(i,kmb+2) = GV%Angstrom
+ h_bl(i,kmb+2) = GV%Angstrom_H
Sref(i,kmb+2) = Sref(i,kmb+1) + (GV%Rlay(nz) - GV%Rlay(nz-1))
endif ; enddo
@@ -1276,9 +1220,9 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, &
!! around the buffer layers, in H.
real, dimension(SZI_(G)), intent(in) :: E_kb !< The entrainment by the top interior
!! layer, in H.
- integer, intent(in) :: is, ie !< The range of i-indices to work on.
- integer, intent(in) :: kmb !< The number of mixed and buffer
- !! layers.
+ integer, intent(in) :: is !< The start of the i-index range to work on.
+ integer, intent(in) :: ie !< The end of the i-index range to work on.
+ integer, intent(in) :: kmb !< The number of mixed and buffer layers.
logical, intent(in) :: limit !< If true, limit dSkb and dSlay to
!! avoid negative values.
real, dimension(SZI_(G)), intent(inout) :: dSkb !< The limited potential density
@@ -1286,15 +1230,17 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, &
!! between the bottommost buffer layer
!! and the topmost interior layer.
!! dSkb > 0.
- real, dimension(SZI_(G)), optional, intent(inout) :: ddSkb_dE !< The partial derivative of dSkb
+ real, dimension(SZI_(G)), optional, intent(inout) :: ddSkb_dE !< The partial derivative of dSkb
!! with E, in kg m-3 H-1.
- real, dimension(SZI_(G)), optional, intent(inout) :: dSlay !< The limited potential density
+ real, dimension(SZI_(G)), optional, intent(inout) :: dSlay !< The limited potential density
!! difference across the topmost
!! interior layer. 0 < dSkb
real, dimension(SZI_(G)), optional, intent(inout) :: ddSlay_dE !< The partial derivative of dSlay
!! with E, in kg m-3 H-1.
- real, dimension(SZI_(G)), optional, intent(inout) :: dS_anom_lim
- logical, dimension(SZI_(G)), optional, intent(in) :: do_i_in !< If present, determines which
+ real, dimension(SZI_(G)), optional, intent(inout) :: dS_anom_lim !< A limiting value to use for
+ !! the density anomalies below the
+ !! buffer layer, in kg m-3.
+ logical, dimension(SZI_(G)), optional, intent(in) :: do_i_in !< If present, determines which
!! columns are worked on.
! Arguments: h_bl - Layer thickness, in m or kg m-2 (abbreviated as H below).
! (in) Sref - Reference potential vorticity (in kg m-3?)
@@ -1315,7 +1261,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, &
! (out,opt) ddSlay_dE - The partial derivative of dSlay with E, in kg m-3 H-1.
! (in,opt) do_i_in - If present, determines which columns are worked on.
! Note that dSkb, ddSkb_dE, dSlay, ddSlay_dE, and dS_anom_lim are declared
-! intent(inout) because they should not change where do_i_in is false.
+! intent inout because they should not change where do_i_in is false.
! This subroutine determines the reference density difference between the
! bottommost buffer layer and the first interior after the mixing between mixed
@@ -1380,7 +1326,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, &
endif
! Determine the entrainment from above for each buffer layer.
- h1 = (h_bl(i,k) - GV%Angstrom) + (eb(i,k) - ea(i,k+1))
+ h1 = (h_bl(i,k) - GV%Angstrom_H) + (eb(i,k) - ea(i,k+1))
if (h1 >= 0.0) then
ea(i,k) = Ent_bl(i,K) ; dea_dE(i,k) = 0.0
elseif (Ent_bl(i,K) + 0.5*h1 >= 0.0) then
@@ -1463,7 +1409,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, &
if (present(dSLay)) then
dz_drat = 1000.0 ! The limit of large dz_drat the same as choosing a
! Heaviside function.
- eps_dSLay = 1.0e-10 ! Should be ~= GV%Angstrom / sqrt(Kd*dt)
+ eps_dSLay = 1.0e-10 ! Should be ~= GV%Angstrom_H / sqrt(Kd*dt)
do i=is,ie ; if (do_i(i)) then
dS_kbp1 = Sref(i,kmb+2) - Sref(i,kmb+1)
IdS_kbp1 = 1.0 / (Sref(i,kmb+2) - Sref(i,kmb+1))
@@ -1519,14 +1465,31 @@ end subroutine determine_dSkb
!! guess of the iterations. Ideally ea_kb should be an under-estimate
subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, &
G, GV, CS, ea_kb, tol_in)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: h_bl, Sref, Ent_bl
- real, dimension(SZI_(G)), intent(in) :: I_dSkbp1, F_kb
- integer, intent(in) :: kmb, i
- type(entrain_diffusive_CS), pointer :: CS
- real, dimension(SZI_(G)), intent(inout) :: ea_kb
- real, optional, intent(in) :: tol_in
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZK_(G)), &
+ intent(in) :: h_bl !< Layer thickness, with the top interior
+ !! layer at k-index kmb+1, in units of m
+ !! or kg m-2 (abbreviated as H below).
+ real, dimension(SZI_(G),SZK_(G)), &
+ intent(in) :: Sref !< The coordinate reference potential density,
+ !! with the value of the topmost interior layer
+ !! at index kmb+1, in units of kg m-3.
+ real, dimension(SZI_(G),SZK_(G)), &
+ intent(in) :: Ent_bl !< The average entrainment upward and downward
+ !! across each interface around the buffer layers, in H.
+ real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in reference
+ !! potential density across the base of the
+ !! uppermost interior layer, in units of m3 kg-1.
+ real, dimension(SZI_(G)), intent(in) :: F_kb !< The entrainment from below by the
+ !! uppermost interior layer, in H
+ integer, intent(in) :: kmb !< The number of mixed and buffer layers.
+ integer, intent(in) :: i !< The i-index to work on
+ type(entrain_diffusive_CS), pointer :: CS !< This module's control structure.
+ real, dimension(SZI_(G)), intent(inout) :: ea_kb !< The entrainment from above by the layer below
+ !! the buffer layer (i.e. layer kb), in H.
+ real, optional, intent(in) :: tol_in !< A tolerance for the iterative determination
+ !! of the entrainment, in H.
real :: max_ea, min_ea
real :: err, err_min, err_max
@@ -1546,7 +1509,7 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, &
val = dS_kbp1 * F_kb(i)
err_min = -val
- tolerance = GV%m_to_H * CS%Tolerance_Ent
+ tolerance = CS%Tolerance_Ent
if (present(tol_in)) tolerance = tol_in
bisect_next = .true.
@@ -1637,10 +1600,9 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, &
error, err_min_eakb0, err_max_eakb0, F_kb, dFdfm_kb)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: h_bl !< Layer thickness, with the top
- !! interior layer at k-index kmb+1, in
- !! units of m or kg m-2
- !! (abbreviated as H below).
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: h_bl !< Layer thickness, with the top interior
+ !! layer at k-index kmb+1, in units of m
+ !! or kg m-2 (abbreviated as H below).
real, dimension(SZI_(G),SZK_(G)), intent(in) :: Sref !< The coordinate reference potential
!! density, with the value of the
!! topmost interior layer at layer
@@ -1661,8 +1623,9 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, &
!! entrainment, in H.
real, dimension(SZI_(G)), intent(in) :: max_eakb !< The maximum permissible rate of
!! entrainment, in H.
- integer, intent(in) :: kmb
- integer, intent(in) :: is, ie !< The range of i-indices to work on.
+ integer, intent(in) :: kmb !< The number of mixed and buffer layers.
+ integer, intent(in) :: is !< The start of the i-index range to work on.
+ integer, intent(in) :: ie !< The end of the i-index range to work on.
logical, dimension(SZI_(G)), intent(in) :: do_i !< A logical variable indicating which
!! i-points to work on.
type(entrain_diffusive_CS), pointer :: CS !< This module's control structure.
@@ -1672,11 +1635,12 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, &
real, dimension(SZI_(G)), optional, intent(out) :: error !< The error (locally defined in this
!! routine) associated with the returned
!! solution.
- real, dimension(SZI_(G)), optional, intent(in) :: err_min_eakb0, err_max_eakb0 !< The errors
- !! (locally defined) associated with
- !! min_eakb and max_eakb when ea_kbp1
- !! = 0, returned from a previous call
- !! to this routine.
+ real, dimension(SZI_(G)), optional, intent(in) :: err_min_eakb0 !< The errors (locally defined)
+ !! associated with min_eakb when ea_kbp1 = 0,
+ !! returned from a previous call to this fn.
+ real, dimension(SZI_(G)), optional, intent(in) :: err_max_eakb0 !< The errors (locally defined)
+ !! associated with min_eakb when ea_kbp1 = 0,
+ !! returned from a previous call to this fn.
real, dimension(SZI_(G)), optional, intent(out) :: F_kb !< The entrainment from below by the
!! uppermost interior layer
!! corresponding to the returned
@@ -1750,7 +1714,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, &
call MOM_error(FATAL, "determine_Ea_kb should not be called "//&
"unless BULKMIXEDLAYER is defined.")
endif
- tolerance = GV%m_to_H * CS%Tolerance_Ent
+ tolerance = CS%Tolerance_Ent
large_err = GV%m_to_H**2 * 1.0e30
do i=is,ie ; redo_i(i) = do_i(i) ; enddo
@@ -1792,7 +1756,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, &
fa = (1.0 + eL) + dS_kb(i)*I_dSkbp1(i)
fk = dtKd_kb(i) * (dS_Lay(i)/dS_kb(i))
fm = (ea_kbp1(i) - h_bl(i,kmb+1)) + eL*2.0*Ent_bl(i,Kmb+1)
- if (fm > -GV%Angstrom) fm = fm + GV%Angstrom ! This could be smooth if need be.
+ if (fm > -GV%Angstrom_H) fm = fm + GV%Angstrom_H ! This could be smooth if need be.
err(i) = (fa * Ent(i)**2 - fm * Ent(i)) - fk
derror_dE(i) = ((2.0*fa + (ddSkb_dE(i)*I_dSkbp1(i))*Ent(i))*Ent(i) - fm) - &
dtKd_kb(i) * (ddSlay_dE(i)*dS_kb(i) - ddSkb_dE(i)*dS_Lay(i))/(dS_kb(i)**2)
@@ -1893,8 +1857,9 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, &
!! in H.
real, dimension(SZI_(G)), intent(in) :: max_ent_in !< The maximum value of ent to search,
!! in H.
- integer, intent(in) :: kmb
- integer, intent(in) :: is, ie !< The range of i-indices to work on.
+ integer, intent(in) :: kmb !< The number of mixed and buffer layers.
+ integer, intent(in) :: is !< The start of the i-index range to work on.
+ integer, intent(in) :: ie !< The end of the i-index range to work on.
type(entrain_diffusive_CS), pointer :: CS !< This module's control structure.
real, dimension(SZI_(G)), intent(out) :: maxF !< The maximum value of F
!! = ent*ds_kb*I_dSkbp1 found in the range
@@ -1937,7 +1902,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, &
integer :: i, it, is1, ie1
integer, parameter :: MAXIT = 20
- tolerance = GV%m_to_H * CS%Tolerance_Ent
+ tolerance = CS%Tolerance_Ent
if (present(do_i_in)) then
do i=is,ie ; do_i(i) = do_i_in(i) ; enddo
@@ -2166,6 +2131,8 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, &
end subroutine find_maxF_kb
+!> This subroutine initializes the parameters and memory associated with the
+!! entrain_diffusive module.
subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS)
type(time_type), intent(in) :: Time !< The current model time.
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
@@ -2188,7 +2155,7 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS)
real :: decay_length, dt, Kd
! This include declares and sets the variable "version".
#include "version_variable.h"
- character(len=40) :: mod = "MOM_entrain_diffusive" ! This module's name.
+ character(len=40) :: mdl = "MOM_entrain_diffusive" ! This module's name.
if (associated(CS)) then
call MOM_error(WARNING, "entrain_diffusive_init called with an associated "// &
@@ -2202,37 +2169,70 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS)
CS%bulkmixedlayer = (GV%nkml > 0)
! Set default, read and log parameters
- call log_version(param_file, mod, version, "")
- call get_param(param_file, mod, "CORRECT_DENSITY", CS%correct_density, &
+ call log_version(param_file, mdl, version, "")
+ call get_param(param_file, mdl, "CORRECT_DENSITY", CS%correct_density, &
"If true, and USE_EOS is true, the layer densities are \n"//&
"restored toward their target values by the diapycnal \n"//&
"mixing, as described in Hallberg (MWR, 2000).", &
default=.true.)
- call get_param(param_file, mod, "MAX_ENT_IT", CS%max_ent_it, &
+ call get_param(param_file, mdl, "MAX_ENT_IT", CS%max_ent_it, &
"The maximum number of iterations that may be used to \n"//&
"calculate the interior diapycnal entrainment.", default=5)
! In this module, KD is only used to set the default for TOLERANCE_ENT. (m2 s-1)
- call get_param(param_file, mod, "KD", Kd, fail_if_missing=.true.)
- call get_param(param_file, mod, "DT", dt, &
+ call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.)
+ call get_param(param_file, mdl, "DT", dt, &
"The (baroclinic) dynamics time step.", units = "s", &
fail_if_missing=.true.)
-! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom,1.0e-4*sqrt(dt*Kd)) !
- call get_param(param_file, mod, "TOLERANCE_ENT", CS%Tolerance_Ent, &
+! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom_H,1.0e-4*sqrt(dt*Kd)) !
+ call get_param(param_file, mdl, "TOLERANCE_ENT", CS%Tolerance_Ent, &
"The tolerance with which to solve for entrainment values.", &
- units="m", default=MAX(100.0*GV%Angstrom_Z,1.0e-4*sqrt(dt*Kd)))
+ units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H)
CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, &
- 'Diapycnal diffusivity as applied', 'm2 s-1')
+ 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=GV%Z_to_m**2)
CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, &
- 'Work actually done by diapycnal diffusion across each interface', 'W m-2')
+ 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=GV%Z_to_m)
end subroutine entrain_diffusive_init
+!> This subroutine cleans up and deallocates any memory associated with the
+!! entrain_diffusive module.
subroutine entrain_diffusive_end(CS)
- type(entrain_diffusive_CS), pointer :: CS
-
+ type(entrain_diffusive_CS), pointer :: CS !< A pointer to the control structure for this
+ !! module that will be deallocated.
if (associated(CS)) deallocate(CS)
end subroutine entrain_diffusive_end
+!> \namespace mom_entrain_diffusive
+!!
+!! By Robert Hallberg, September 1997 - July 2000
+!!
+!! This file contains the subroutines that implement diapycnal
+!! mixing and advection in isopycnal layers. The main subroutine,
+!! calculate_entrainment, returns the entrainment by each layer
+!! across the interfaces above and below it. These are calculated
+!! subject to the constraints that no layers can be driven to neg-
+!! ative thickness and that the each layer maintains its target
+!! density, using the scheme described in Hallberg (MWR 2000). There
+!! may or may not be a bulk mixed layer above the isopycnal layers.
+!! The solution is iterated until the change in the entrainment
+!! between successive iterations is less than some small tolerance.
+!!
+!! The dual-stream entrainment scheme of MacDougall and Dewar
+!! (JPO 1997) is used for combined diapycnal advection and diffusion,
+!! modified as described in Hallberg (MWR 2000) to be solved
+!! implicitly in time. Any profile of diffusivities may be used.
+!! Diapycnal advection is fundamentally the residual of diapycnal
+!! diffusion, so the fully implicit upwind differencing scheme that
+!! is used is entirely appropriate. The downward buoyancy flux in
+!! each layer is determined from an implicit calculation based on
+!! the previously calculated flux of the layer above and an estim-
+!! ated flux in the layer below. This flux is subject to the foll-
+!! owing conditions: (1) the flux in the top and bottom layers are
+!! set by the boundary conditions, and (2) no layer may be driven
+!! below an Angstrom thickness. If there is a bulk mixed layer, the
+!! mixed and buffer layers are treated as Eulerian layers, whose
+!! thicknesses only change due to entrainment by the interior layers.
+
end module MOM_entrain_diffusive
diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90
new file mode 100644
index 0000000000..299c230e0b
--- /dev/null
+++ b/src/parameterizations/vertical/MOM_full_convection.F90
@@ -0,0 +1,424 @@
+!> Does full convective adjustment of unstable regions via a strong diffusivity.
+module MOM_full_convection
+
+! This file is part of MOM6. See LICENSE.md for the license.
+
+use MOM_grid, only : ocean_grid_type
+use MOM_variables, only : thermo_var_ptrs
+use MOM_verticalGrid, only : verticalGrid_type
+use MOM_EOS, only : int_specific_vol_dp, calculate_density_derivs
+
+implicit none ; private
+
+#include
+
+public full_convection
+
+contains
+
+!> Calculate new temperatures and salinities that have been subject to full convective mixing.
+subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, &
+ Kddt_convect, halo)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually 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)), &
+ intent(out) :: T_adj !< Adjusted potential temperature in degC.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(out) :: S_adj !< Adjusted salinity in ppt.
+ real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa (or NULL).
+ real, intent(in) :: Kddt_smooth !< A smoothing vertical
+ !! diffusivity times a timestep, in H2.
+ real, optional, intent(in) :: Kddt_convect !< A large convecting vertical
+ !! diffusivity times a timestep, in H2.
+ integer, optional, intent(in) :: halo !< Halo width over which to compute
+
+ ! Local variables
+ real, dimension(SZI_(G),SZK_(G)+1) :: &
+ drho_dT, & ! The derivatives of density with temperature and
+ drho_dS ! salinity, in kg m-3 K-1 and kg m-3 psu-1.
+ real :: h_neglect, h0 ! A thickness that is so small it is usually lost
+ ! in roundoff and can be neglected, in H.
+! logical :: use_EOS ! If true, density is calculated from T & S using an equation of state.
+ real, dimension(SZI_(G),SZK0_(G)) :: &
+ Te_a, & ! A partially updated temperature estimate including the influnce from
+ ! mixing with layers above rescaled by a factor of d_a, in degC.
+ ! This array is discreted on tracer cells, but contains an extra
+ ! layer at the top for algorithmic convenience.
+ Se_a ! A partially updated salinity estimate including the influnce from
+ ! mixing with layers above rescaled by a factor of d_a, in ppt.
+ ! This array is discreted on tracer cells, but contains an extra
+ ! layer at the top for algorithmic convenience.
+ real, dimension(SZI_(G),SZK_(G)+1) :: &
+ Te_b, & ! A partially updated temperature estimate including the influnce from
+ ! mixing with layers below rescaled by a factor of d_b, in degC.
+ ! This array is discreted on tracer cells, but contains an extra
+ ! layer at the bottom for algorithmic convenience.
+ Se_b ! A partially updated salinity estimate including the influnce from
+ ! mixing with layers below rescaled by a factor of d_b, in ppt.
+ ! This array is discreted on tracer cells, but contains an extra
+ ! layer at the bottom for algorithmic convenience.
+ real, dimension(SZI_(G),SZK_(G)+1) :: &
+ c_a, & ! The fractional influence of the properties of the layer below
+ ! in the final properies with a downward-first solver, nondim.
+ d_a, & ! The fractional influence of the properties of the layer in question
+ ! and layers above in the final properies with a downward-first solver, nondim.
+ ! d_a = 1.0 - c_a
+ c_b, & ! The fractional influence of the properties of the layer above
+ ! in the final properies with a upward-first solver, nondim.
+ d_b ! The fractional influence of the properties of the layer in question
+ ! and layers below in the final properies with a upward-first solver, nondim.
+ ! d_b = 1.0 - c_b
+ real, dimension(SZI_(G),SZK_(G)+1) :: &
+ mix !< The amount of mixing across the interface between layers, in H.
+ real :: mix_len ! The length-scale of mixing, when it is active, in H
+ real :: h_b, h_a ! The thicknessses of the layers above and below in interface, in H
+ real :: b_b, b_a ! Inverse pivots used by the tridiagonal solver, in H-1.
+
+ real :: kap_dt_x2 ! The product of 2*kappa*dt in H2 (often m2 or kg2 m-4).
+
+ logical, dimension(SZI_(G)) :: do_i ! Do more work on this column.
+ logical, dimension(SZI_(G)) :: last_down ! The last setup pass was downward.
+ integer, dimension(SZI_(G)) :: change_ct ! The number of interfaces where the
+ ! mixing has changed this iteration.
+ integer :: changed_col ! The number of colums whose mixing changed.
+ integer :: i, j, k, is, ie, js, je, nz, itt
+
+ if (present(halo)) then
+ is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo
+ else
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
+ endif
+ nz = G%ke
+
+ if (.not.associated(tv%eqn_of_state)) return
+
+ h_neglect = GV%H_subroundoff
+ kap_dt_x2 = 0.0
+ if (present(Kddt_convect)) kap_dt_x2 = 2.0*Kddt_convect
+ mix_len = (1.0e20 * nz) * (G%max_depth * GV%Z_to_H)
+ h0 = 1.0e-16*sqrt(Kddt_smooth) + h_neglect
+
+ do j=js,je
+ mix(:,:) = 0.0 ; d_b(:,:) = 1.0
+ ! These would be Te_b(:,:) = tv%T(:,j,:), etc., but the values are not used
+ Te_b(:,:) = 0.0 ; Se_b(:,:) = 0.0
+
+ call smoothed_dRdT_dRdS(h, tv, Kddt_smooth, drho_dT, drho_dS, G, GV, j, p_surf, halo)
+
+ do i=is,ie
+ do_i(i) = (G%mask2dT(i,j) > 0.0)
+
+ d_a(i,1) = 1.0
+ last_down(i) = .true. ! This is set for debuggers.
+ ! These are extra values are used for convenience in the stability test
+ Te_a(i,0) = 0.0 ; Se_a(i,0) = 0.0
+ enddo
+
+ do itt=1,nz ! At least 2 interfaces will change with each full pass, or the
+ ! iterations stop, so the maximum count of nz is very conservative.
+
+ do i=is,ie ; change_ct(i) = 0 ; enddo
+ ! Move down the water column, finding unstable interfaces, and building up the
+ ! temporary arrays for the tridiagonal solver.
+ do K=2,nz ; do i=is,ie ; if (do_i(i)) then
+
+ h_a = h(i,j,k-1) + h_neglect ; h_b = h(i,j,k) + h_neglect
+ if (mix(i,K) <= 0.0) then
+ if (is_unstable(dRho_dT(i,K), dRho_dS(i,K), h_a, h_b, mix(i,K-1), mix(i,K+1), &
+ tv%T(i,j,k-1), tv%T(i,j,k), tv%S(i,j,k-1), tv%S(i,j,k), &
+ Te_a(i,k-2), Te_b(i,k+1), Se_a(i,k-2), Se_b(i,k+1), &
+ d_a(i,K-1), d_b(i,K+1))) then
+ mix(i,K) = mix_len
+ if (kap_dt_x2 > 0.0) mix(i,K) = kap_dt_x2 / ((h(i,j,k-1)+h(i,j,k)) + h0)
+ change_ct(i) = change_ct(i) + 1
+ endif
+ endif
+
+ b_a = 1.0 / ((h_a + d_a(i,K-1)*mix(i,K-1)) + mix(i,K))
+ if (mix(i,K) <= 0.0) then
+ c_a(i,K) = 0.0 ; d_a(i,K) = 1.0
+ else
+ d_a(i,K) = b_a * (h_a + d_a(i,K-1)*mix(i,K-1)) ! = 1.0-c_a(i,K)
+ c_a(i,K) = 1.0 ; if (d_a(i,K) > epsilon(b_a)) c_a(i,K) = b_a * mix(i,K)
+ endif
+
+ if (K>2) then
+ Te_a(i,k-1) = b_a * (h_a*tv%T(i,j,k-1) + mix(i,K-1)*Te_a(i,k-2))
+ Se_a(i,k-1) = b_a * (h_a*tv%S(i,j,k-1) + mix(i,K-1)*Se_a(i,k-2))
+ else
+ Te_a(i,k-1) = b_a * (h_a*tv%T(i,j,k-1))
+ Se_a(i,k-1) = b_a * (h_a*tv%S(i,j,k-1))
+ endif
+ endif ; enddo ; enddo
+
+ ! Determine which columns might have further instabilities.
+ changed_col = 0
+ do i=is,ie ; if (do_i(i)) then
+ if (change_ct(i) == 0) then
+ last_down(i) = .true. ; do_i(i) = .false.
+ else
+ changed_col = changed_col + 1 ; change_ct(i) = 0
+ endif
+ endif ; enddo
+ if (changed_col == 0) exit ! No more columns are unstable.
+
+ ! This is the same as above, but with the direction reversed (bottom to top)
+ do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then
+
+ h_a = h(i,j,k-1) + h_neglect ; h_b = h(i,j,k) + h_neglect
+ if (mix(i,K) <= 0.0) then
+ if (is_unstable(dRho_dT(i,K), dRho_dS(i,K), h_a, h_b, mix(i,K-1), mix(i,K+1), &
+ tv%T(i,j,k-1), tv%T(i,j,k), tv%S(i,j,k-1), tv%S(i,j,k), &
+ Te_a(i,k-2), Te_b(i,k+1), Se_a(i,k-2), Se_b(i,k+1), &
+ d_a(i,K-1), d_b(i,K+1))) then
+ mix(i,K) = mix_len
+ if (kap_dt_x2 > 0.0) mix(i,K) = kap_dt_x2 / ((h(i,j,k-1)+h(i,j,k)) + h0)
+ change_ct(i) = change_ct(i) + 1
+ endif
+ endif
+
+ b_b = 1.0 / ((h_b + d_b(i,K+1)*mix(i,K+1)) + mix(i,K))
+ if (mix(i,K) <= 0.0) then
+ c_b(i,K) = 0.0 ; d_b(i,K) = 1.0
+ else
+ d_b(i,K) = b_b * (h_b + d_b(i,K+1)*mix(i,K+1)) ! = 1.0-c_b(i,K)
+ c_b(i,K) = 1.0 ; if (d_b(i,K) > epsilon(b_b)) c_b(i,K) = b_b * mix(i,K)
+ endif
+
+ if (k 0.0) .and. last_down(i)) ; enddo
+ do i=is,ie ; if (do_i(i)) then
+ h_a = h(i,j,nz) + h_neglect
+ b_a = 1.0 / (h_a + d_a(i,nz)*mix(i,nz))
+ T_adj(i,j,nz) = b_a * (h_a*tv%T(i,j,nz) + mix(i,nz)*Te_a(i,nz-1))
+ S_adj(i,j,nz) = b_a * (h_a*tv%S(i,j,nz) + mix(i,nz)*Se_a(i,nz-1))
+ endif ; enddo
+ do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then
+ T_adj(i,j,k) = Te_a(i,k) + c_a(i,K+1)*T_adj(i,j,k+1)
+ S_adj(i,j,k) = Se_a(i,k) + c_a(i,K+1)*S_adj(i,j,k+1)
+ endif ; enddo ; enddo
+
+ do i=is,ie ; if (do_i(i)) then
+ k = 1 ! A hook for debugging.
+ endif ; enddo
+
+ ! Do the final return pass on the columns where the penultimate pass was upward.
+ ! Also do a simple copy of T & S values on land points.
+ do i=is,ie
+ do_i(i) = ((G%mask2dT(i,j) > 0.0) .and. .not.last_down(i))
+ if (do_i(i)) then
+ h_b = h(i,j,1) + h_neglect
+ b_b = 1.0 / (h_b + d_b(i,2)*mix(i,2))
+ T_adj(i,j,1) = b_b * (h_b*tv%T(i,j,1) + mix(i,2)*Te_b(i,2))
+ S_adj(i,j,1) = b_b * (h_b*tv%S(i,j,1) + mix(i,2)*Se_b(i,2))
+ elseif (G%mask2dT(i,j) <= 0.0) then
+ T_adj(i,j,1) = tv%T(i,j,1) ; S_adj(i,j,1) = tv%S(i,j,1)
+ endif
+ enddo
+ do k=2,nz ; do i=is,ie
+ if (do_i(i)) then
+ T_adj(i,j,k) = Te_b(i,k) + c_b(i,K)*T_adj(i,j,k-1)
+ S_adj(i,j,k) = Se_b(i,k) + c_b(i,K)*S_adj(i,j,k-1)
+ elseif (G%mask2dT(i,j) <= 0.0) then
+ T_adj(i,j,k) = tv%T(i,j,k) ; S_adj(i,j,k) = tv%S(i,j,k)
+ endif
+ enddo ; enddo
+
+ do i=is,ie ; if (do_i(i)) then
+ k = 1 ! A hook for debugging.
+ endif ; enddo
+
+ enddo ! j-loop
+
+ k = 1 ! A hook for debugging.
+
+ ! The following set of expressions for the final values are derived from the the partial
+ ! updates for the estimated temperatures and salinities around an interface, then directly
+ ! solving for the final temperatures and salinities. They are here for later reference
+ ! and to document an intermediate step in the stability calculation.
+ ! hp_a = (h_a + d_a(i,K-1)*mix(i,K-1))
+ ! hp_b = (h_b + d_b(i,K+1)*mix(i,K+1))
+ ! b2_c = 1.0 / (hp_a*hp_b + (hp_a + hp_b) * mix(i,K))
+ ! Th_a = h_a*tv%T(i,j,k-1) + mix(i,K-1)*Te_a(i,k-2)
+ ! Th_b = h_b*tv%T(i,j,k) + mix(i,K+1)*Te_b(i,k+1)
+ ! T_fin(i,k) = ( (hp_a + mix(i,K)) * Th_b + Th_a * mix(i,K) ) * b2_c
+ ! T_fin(i,k-1) = ( (hp_b + mix(i,K)) * Th_a + Th_b * mix(i,K) ) * b2_c
+ ! Sh_a = h_a*tv%S(i,j,k-1) + mix(i,K-1)*Se_a(i,k-2)
+ ! Sh_b = h_b*tv%S(i,j,k) + mix(i,K+1)*Se_b(i,k+1)
+ ! S_fin(i,k) = ( (hp_a + mix(i,K)) * Sh_b + Sh_a * mix(i,K) ) * b2_c
+ ! S_fin(i,k-1) = ( (hp_b + mix(i,K)) * Sh_a + Sh_b * mix(i,K) ) * b2_c
+
+end subroutine full_convection
+
+!> This function returns True if the profiles around the given interface will be
+!! statically unstable after mixing above below. The arguments are the ocean state
+!! above and below, including partial calculations from a tridiagonal solver.
+function is_unstable(dRho_dT, dRho_dS, h_a, h_b, mix_A, mix_B, T_a, T_b, S_a, S_b, &
+ Te_aa, Te_bb, Se_aa, Se_bb, d_A, d_B)
+ real, intent(in) :: dRho_dT !< The derivative of in situ density with temperature in kg m-3 degC-1
+ real, intent(in) :: dRho_dS !< The derivative of in situ density with salinity in kg m-3 ppt-1
+ real, intent(in) :: h_a !< The thickness of the layer above, in H
+ real, intent(in) :: h_b !< The thickness of the layer below, in H
+ real, intent(in) :: mix_A !< The time integrated mixing rate of the interface above, in H
+ real, intent(in) :: mix_B !< The time integrated mixing rate of the interface below, in H
+ real, intent(in) :: T_a !< The initial temperature of the layer above, in degC
+ real, intent(in) :: T_b !< The initial temperature of the layer below, in degC
+ real, intent(in) :: S_a !< The initial salinity of the layer below, in ppt
+ real, intent(in) :: S_b !< The initial salinity of the layer below, in ppt
+ real, intent(in) :: Te_aa !< The estimated temperature two layers above rescaled by d_A, in degC
+ real, intent(in) :: Te_bb !< The estimated temperature two layers below rescaled by d_B, in degC
+ real, intent(in) :: Se_aa !< The estimated salinity two layers above rescaled by d_A, in ppt
+ real, intent(in) :: Se_bb !< The estimated salinity two layers below rescaled by d_B, in ppt
+ real, intent(in) :: d_A !< The rescaling dependency across the interface above, nondim.
+ real, intent(in) :: d_B !< The rescaling dependency across the interface below, nondim.
+ logical :: is_unstable !< The return value, true if the profile is statically unstable
+ !! around the interface in question.
+
+ ! These expressions for the local stability are long, but they have been carefully
+ ! grouped for accuracy even when the mixing rates are huge or tiny, and common
+ ! positive definite factors that would appear in the final expression for the
+ ! locally referenced potential density difference across an interface have been omitted.
+ is_unstable = (dRho_dT * ((h_a * h_b * (T_b - T_a) + &
+ mix_A*mix_B * (d_A*Te_bb - d_B*Te_aa)) + &
+ (h_a*mix_B * (Te_bb - d_B*T_a) + &
+ h_b*mix_A * (d_A*T_b - Te_aa)) ) + &
+ dRho_dS * ((h_a * h_b * (S_b - S_a) + &
+ mix_A*mix_B * (d_A*Se_bb - d_B*Se_aa)) + &
+ (h_a*mix_B * (Se_bb - d_B*S_a) + &
+ h_b*mix_A * (d_A*S_b - Se_aa)) ) < 0.0)
+end function is_unstable
+
+!> Returns the partial derivatives of locally referenced potential density with
+!! temperature and salinity after the properties have been smoothed with a small
+!! constant diffusivity.
+subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, j, p_surf, halo)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
+ !! thermodynamic variables
+ real, intent(in) :: Kddt !< A diffusivity times a time increment, in H2.
+ real, dimension(SZI_(G),SZK_(G)+1), &
+ intent(out) :: dR_dT !< Derivative of locally referenced
+ !! potential density with temperature, kg m-3 K-1
+ real, dimension(SZI_(G),SZK_(G)+1), &
+ intent(out) :: dR_dS !< Derivative of locally referenced
+ !! potential density with salinity, kg m-3 ppt-1
+ integer, intent(in) :: j !< The j-point to work on.
+ real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa (or NULL).
+ integer, optional, intent(in) :: halo !< Halo width over which to compute
+ ! Local variables
+ real :: mix(SZI_(G),SZK_(G)+1) ! The diffusive mixing length (kappa*dt)/dz
+ ! between layers within in a timestep in H.
+ real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the
+ real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver.
+ real :: T_f(SZI_(G),SZK_(G)) ! Filtered temperatures in degC
+ real :: S_f(SZI_(G),SZK_(G)) ! Filtered salinities in ppt
+ real :: pres(SZI_(G)) ! Interface pressures, in Pa.
+ real :: T_EOS(SZI_(G)) ! Filtered and vertically averaged temperatures in degC
+ real :: S_EOS(SZI_(G)) ! Filtered and vertically averaged salinities in ppt
+ real :: kap_dt_x2 ! The product of 2*kappa*dt in H2 (often m2 or kg2 m-4).
+ real :: h_neglect, h0 ! Negligible thicknesses, in H (m or kg m-2), to
+ ! allow for zero thicknesses.
+ real :: h_tr ! The thickness at tracer points, plus h_neglect, in H.
+ integer :: i, k, is, ie, nz
+
+ if (present(halo)) then
+ is = G%isc-halo ; ie = G%iec+halo
+ else
+ is = G%isc ; ie = G%iec
+ endif
+ nz = G%ke
+
+ h_neglect = GV%H_subroundoff
+ kap_dt_x2 = 2.0*Kddt
+
+ if (Kddt <= 0.0) then
+ do k=1,nz ; do i=is,ie
+ T_f(i,k) = tv%T(i,j,k) ; S_f(i,k) = tv%S(i,j,k)
+ enddo ; enddo
+ else
+ h0 = 1.0e-16*sqrt(Kddt) + h_neglect
+ do i=is,ie
+ mix(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0)
+
+ h_tr = h(i,j,1) + h_neglect
+ b1(i) = 1.0 / (h_tr + mix(i,2))
+ d1(i) = b1(i) * h(i,j,1)
+ T_f(i,1) = (b1(i)*h_tr)*tv%T(i,j,1)
+ S_f(i,1) = (b1(i)*h_tr)*tv%S(i,j,1)
+ enddo
+ do k=2,nz-1 ; do i=is,ie
+ mix(i,K+1) = kap_dt_x2 / ((h(i,j,k)+h(i,j,k+1)) + h0)
+
+ c1(i,k) = mix(i,K) * b1(i)
+ h_tr = h(i,j,k) + h_neglect
+ b1(i) = 1.0 / ((h_tr + d1(i)*mix(i,K)) + mix(i,K+1))
+ d1(i) = b1(i) * (h_tr + d1(i)*mix(i,K))
+ T_f(i,k) = b1(i) * (h_tr*tv%T(i,j,k) + mix(i,K)*T_f(i,k-1))
+ S_f(i,k) = b1(i) * (h_tr*tv%S(i,j,k) + mix(i,K)*S_f(i,k-1))
+ enddo ; enddo
+ do i=is,ie
+ c1(i,nz) = mix(i,nz) * b1(i)
+ h_tr = h(i,j,nz) + h_neglect
+ b1(i) = 1.0 / (h_tr + d1(i)*mix(i,nz))
+ T_f(i,nz) = b1(i) * (h_tr*tv%T(i,j,nz) + mix(i,nz)*T_f(i,nz-1))
+ S_f(i,nz) = b1(i) * (h_tr*tv%S(i,j,nz) + mix(i,nz)*S_f(i,nz-1))
+ enddo
+ do k=nz-1,1,-1 ; do i=is,ie
+ T_f(i,k) = T_f(i,k) + c1(i,k+1)*T_f(i,k+1)
+ S_f(i,k) = S_f(i,k) + c1(i,k+1)*S_f(i,k+1)
+ enddo ; enddo
+ endif
+
+ if (associated(p_surf)) then
+ 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)
+ do i=is,ie ; pres(i) = pres(i) + h(i,j,1)*GV%H_to_Pa ; 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)
+ do i=is,ie ; pres(i) = pres(i) + h(i,j,k)*GV%H_to_Pa ; 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)
+
+
+end subroutine smoothed_dRdT_dRdS
+
+end module MOM_full_convection
diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90
index 7cb7dc5dc7..c09d85f5b5 100644
--- a/src/parameterizations/vertical/MOM_geothermal.F90
+++ b/src/parameterizations/vertical/MOM_geothermal.F90
@@ -1,40 +1,11 @@
+!> Implemented geothermal heating at the ocean bottom.
module MOM_geothermal
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, 2010. *
-!* *
-!* This file contains the subroutine (geothemal) that implements *
-!* a geothermal heating at the bottom. This can be done either in a *
-!* layered isopycnal mode, in which the heating raises the density of *
-!* the layer to the target density of the layer above, and then moves *
-!* the water into that layer, or in a simple Eulerian mode, in which *
-!* the bottommost GEOTHERMAL_THICKNESS are heated. Geothermal heating*
-!* will also provide a buoyant source of bottom TKE that can be used *
-!* to further mix the near-bottom water. In cold fresh water lakes *
-!* where heating increases density, water should be moved into deeper *
-!* layers, but this is not implemented yet. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, buoy, Rml, eaml, ebml, etc. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
use MOM_diag_mediator, only : register_static_field, time_type, diag_ctrl
+use MOM_domains, only : pass_var
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_io, only : MOM_read_data, slasher
@@ -49,32 +20,32 @@ module MOM_geothermal
public geothermal, geothermal_init, geothermal_end
+!> Control structure for geothermal heating
type, public :: geothermal_CS ; private
- real :: dRcv_dT_inplace ! The value of dRcv_dT above which (dRcv_dT is
- ! negative) the water is heated in place instead
- ! of moving upward between layers, in kg m-3 K-1.
- real, pointer :: geo_heat(:,:) => NULL() ! The geothermal heat flux, in
- ! W m-2.
- real :: geothermal_thick ! The thickness over which geothermal heating is
- ! applied, in m.
- logical :: apply_geothermal ! If true, geothermal heating will be applied
- ! otherwise GEOTHERMAL_SCALE has been set to 0 and
- ! there is no heat to apply.
-
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
+ real :: dRcv_dT_inplace !< The value of dRcv_dT above which (dRcv_dT is
+ !! negative) the water is heated in place instead
+ !! of moving upward between layers, in kg m-3 K-1.
+ real, pointer :: geo_heat(:,:) => NULL() !< The geothermal heat flux, in W m-2.
+ real :: geothermal_thick !< The thickness over which geothermal heating is
+ !! applied, in m.
+ logical :: apply_geothermal !< If true, geothermal heating will be applied
+ !! otherwise GEOTHERMAL_SCALE has been set to 0 and
+ !! there is no heat to apply.
+
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
end type geothermal_CS
contains
-!> This subroutine applies geothermal heating, including the movement of water
+!> Applies geothermal heating, including the movement of water
!! between isopycnal layers to match the target densities. The heating is
!! applied to the bottommost layers that occur within ### of the bottom. If
!! the partial derivative of the coordinate density with temperature is positive
!! or very small, the layers are simply heated in place. Any heat that can not
!! be applied to the ocean is returned (WHERE)?
-subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS)
+subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid
!! structure.
@@ -99,32 +70,8 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS)
type(geothermal_CS), pointer :: CS !< The control structure returned by
!! a previous call to
!! geothermal_init.
-
-! This subroutine applies geothermal heating, including the movement of water
-! between isopycnal layers to match the target densities. The heating is
-! applied to the bottommost layers that occur within ### of the bottom. If
-! the partial derivative of the coordinate density with temperature is positive
-! or very small, the layers are simply heated in place. Any heat that can not
-! be applied to the ocean is returned (WHERE)?
-
-! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out)
-! The units of h are referred to as H below.
-! (in/out) tv - A structure containing pointers to any available
-! thermodynamic fields. Absent fields have NULL ptrs.
-! (in) dt - Time increment, in s.
-! (in/out) ea - The amount of fluid moved downward into a layer; this should
-! be increased due to mixed layer detrainment, in the same units
-! as h - usually m or kg m-2 (i.e., H).
-! (in/out) eb - The amount of fluid moved upward into a layer; this should
-! be increased due to mixed layer entrainment, in the same units
-! as h - usually m or kg m-2 (i.e., H).
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! geothermal_init.
-
-! real :: resid(SZI_(G),SZJ_(G)) !z1l: never been used.
-
+ integer, optional, intent(in) :: halo !< Halo width over which to work
+ ! Local variables
real, dimension(SZI_(G)) :: &
heat_rem, & ! remaining heat (H * degC)
h_geo_rem, & ! remaining thickness to apply geothermal heating (units of H)
@@ -160,6 +107,9 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS)
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
+ if (present(halo)) then
+ is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo
+ endif
if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//&
"Module must be initialized before it is used.")
@@ -167,7 +117,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS)
nkmb = GV%nk_rho_varies
Irho_cp = 1.0 / (GV%H_to_kg_m2 * tv%C_p)
- Angstrom = GV%Angstrom
+ Angstrom = GV%Angstrom_H
H_neglect = GV%H_subroundoff
p_ref(:) = tv%P_Ref
@@ -362,27 +312,19 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS)
end subroutine geothermal
+!> Initialize parameters and allocate memory associated with the geothermal heating module.
subroutine geothermal_init(Time, G, param_file, diag, CS)
type(time_type), target, intent(in) :: Time !< Current model time.
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
!! parameters.
type(diag_ctrl), target, intent(inout) :: diag !< Structure used to regulate diagnostic output.
type(geothermal_CS), pointer :: CS !< Pointer pointing to the module control
!! structure.
-
-! Arguments:
-! (in) Time - current model time
-! (in) G - ocean grid structure
-! (in) param_file - structure indicating the open file to parse for
-! model parameter values
-! (in) diag - structure used to regulate diagnostic output
-! (in/out) CS - pointer pointing to the module control structure
-
! This include declares and sets the variable "version".
#include "version_variable.h"
-
character(len=40) :: mdl = "MOM_geothermal" ! module name
+ ! Local variables
character(len=200) :: inputdir, geo_file, filename, geotherm_var
real :: scale
integer :: i, j, isd, ied, jsd, jed, id
@@ -440,6 +382,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS)
CS%geo_heat(i,j) = G%mask2dT(i,j) * scale
enddo ; enddo
endif
+ call pass_var(CS%geo_heat, G%domain)
! post the static geothermal heating field
id = register_static_field('ocean_model', 'geo_heat', diag%axesT1, &
@@ -452,11 +395,22 @@ subroutine geothermal_init(Time, G, param_file, diag, CS)
end subroutine geothermal_init
+!> Clean up and deallocate memory associated with the geothermal heating module.
subroutine geothermal_end(CS)
- type(geothermal_CS), pointer :: CS
+ type(geothermal_CS), pointer :: CS !< Geothermal heating control structure that
+ !! will be deallocated in this subroutine.
if (associated(CS%geo_heat)) deallocate(CS%geo_heat)
if (associated(CS)) deallocate(CS)
end subroutine geothermal_end
+!> \namespace mom_geothermal
+!!
+!! Geothermal heating can be added either in a layered isopycnal mode, in which the heating raises the density
+!! of the layer to the target density of the layer above, and then moves the water into that layer, or in a
+!! simple Eulerian mode, in which the bottommost GEOTHERMAL_THICKNESS are heated. Geothermal heating will also
+!! provide a buoyant source of bottom TKE that can be used to further mix the near-bottom water. In cold fresh
+!! water lakes where heating increases density, water should be moved into deeper layers, but this is not
+!! implemented yet.
+
end module MOM_geothermal
diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90
index 3c9188b6bb..e41cc8cb2b 100644
--- a/src/parameterizations/vertical/MOM_internal_tide_input.F90
+++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90
@@ -1,28 +1,8 @@
+!> Calculates energy input to the internal tides
module MOM_int_tide_input
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, January 2013 *
-!* *
-!* This file contains the subroutines that sets the energy input *
-!* to the internal tides. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, buoy, ustar, T, S, Kd, ea, eb, etc. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE
use MOM_diag_mediator, only : diag_ctrl, time_type
@@ -45,57 +25,49 @@ module MOM_int_tide_input
public set_int_tide_input, int_tide_input_init, int_tide_input_end
+!> This control structure holds parameters that regulate internal tide energy inputs.
type, public :: int_tide_input_CS ; private
- logical :: debug ! If true, write verbose checksums for debugging.
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- real :: TKE_itide_max ! Maximum Internal tide conversion (W m-2)
- ! available to mix above the BBL
+ logical :: debug !< If true, write verbose checksums for debugging.
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ real :: TKE_itide_max !< Maximum Internal tide conversion (W m-2)
+ !! available to mix above the BBL
- real, allocatable, dimension(:,:) :: &
- TKE_itidal_coef ! The time-invariant field that enters the TKE_itidal
- ! input calculation, in J m-2.
+ real, allocatable, dimension(:,:) :: TKE_itidal_coef
+ !< The time-invariant field that enters the TKE_itidal input calculation, in J m-2.
+ character(len=200) :: inputdir !< The directory for input files.
+ !>@{ Diagnostic IDs
integer :: id_TKE_itidal = -1, id_Nb = -1, id_N2_bot = -1
- character(len=200) :: inputdir
+ !!@}
end type int_tide_input_CS
+!> This type is used to exchange fields related to the internal tides.
type, public :: int_tide_input_type
real, allocatable, dimension(:,:) :: &
- TKE_itidal_input, & ! The internal tide TKE input at the bottom of
- ! the ocean, in W m-2.
- h2, & ! The squared topographic roughness height, in m2.
- tideamp, & ! The amplitude of the tidal velocities, in m s-1.
- Nb ! The bottom stratification, in s-1.
+ TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean, in W m-2.
+ h2, & !< The squared topographic roughness height, in Z2.
+ tideamp, & !< The amplitude of the tidal velocities, in m s-1.
+ Nb !< The bottom stratification, in s-1.
end type int_tide_input_type
contains
+!> Sets the model-state dependent internal tide energy sources.
subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, 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
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(thermo_var_ptrs), intent(in) :: tv
- type(forcing), intent(in) :: fluxes
- type(int_tide_input_type), intent(inout) :: itide
- real, intent(in) :: dt
- type(int_tide_input_CS), pointer :: CS
-
-! Arguments: u - Zonal velocity, in m s-1.
-! (in) v - Meridional velocity, in m s-1.
-! (in) h - Layer thickness, in m or kg m-2.
-! (in) tv - A structure containing pointers to any available
-! thermodynamic fields. Absent fields have NULL ptrs.
-! (in) fluxes - A structure of surface fluxes that may be used.
-! (inout) itide - A structure containing fields related to the internal
-! tide sources.
-! (in) dt - The time increment in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - This module's control structure.
-
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the
+ !! thermodynamic fields
+ type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes
+ type(int_tide_input_type), intent(inout) :: itide !< A structure containing fields related
+ !! to the internal tide sources.
+ real, intent(in) :: dt !< The time increment in s.
+ type(int_tide_input_CS), pointer :: CS !< This module's control structure.
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
N2_bot ! The bottom squared buoyancy frequency, in s-2.
@@ -116,8 +88,8 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, CS)
if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//&
"Module must be initialized before it is used.")
- kappa_fill = 1.e-3 ! m2 s-1
- dt_fill = 7200.
+ kappa_fill = 1.e-3*GV%m_to_Z**2 !### Dimensional constant in m2 s-1.
+ dt_fill = 7200. !### Dimensionalconstant in s.
use_EOS = associated(tv%eqn_of_state)
@@ -145,17 +117,23 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, CS)
end subroutine set_int_tide_input
+!> Estimates the near-bottom buoyancy frequency (N^2).
subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(thermo_var_ptrs), intent(in) :: tv
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f, S_f
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2
- type(forcing), intent(in) :: fluxes
- type(int_tide_input_CS), pointer :: CS
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot
-
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the
+ !! thermodynamic fields
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f !< Temperature after vertical filtering to
+ !! smooth out the values in thin layers, in degC.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_f !< Salinity after vertical filtering to
+ !! smooth out the values in thin layers, in PSU.
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness, in Z2
+ type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes
+ type(int_tide_input_CS), pointer :: CS !< This module's control structure.
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the
+ !! ocean bottom, in s-2.
+ ! Local variables
real, dimension(SZI_(G),SZK_(G)+1) :: &
dRho_int ! The unfiltered density differences across interfaces.
real, dimension(SZI_(G)) :: &
@@ -163,19 +141,19 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot)
Temp_int, & ! The temperature at each interface, in degC.
Salin_int, & ! The salinity at each interface, in PSU.
drho_bot, &
- h_amp, &
- hb, &
- z_from_bot, &
+ h_amp, & ! The amplitude of topographic roughness, in Z.
+ hb, & ! The depth below a layer, in Z.
+ z_from_bot, & ! The height of a layer center above the bottom, in Z.
dRho_dT, & ! The partial derivatives of density with temperature and
dRho_dS ! salinity, in kg m-3 degC-1 and kg m-3 PSU-1.
- real :: dz_int ! The thickness associated with an interface, in m.
+ real :: dz_int ! The thickness associated with an interface, in Z.
real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq
- ! density, in m4 s-2 kg-1.
+ ! density, in Z m3 s-2 kg-1.
logical :: do_i(SZI_(G)), do_any
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 = GV%g_Earth / GV%Rho0
+ G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0
! Find the (limited) density jump across each interface.
do i=is,ie
@@ -216,7 +194,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot)
! Find the bottom boundary layer stratification.
do i=is,ie
hb(i) = 0.0 ; dRho_bot(i) = 0.0
- z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz)
+ z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz)
do_i(i) = (G%mask2dT(i,j) > 0.5)
h_amp(i) = sqrt(h2(i,j))
enddo
@@ -224,7 +202,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot)
do k=nz,2,-1
do_any = .false.
do i=is,ie ; if (do_i(i)) then
- dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1))
+ dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1))
z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above
hb(i) = hb(i) + dz_int
@@ -233,7 +211,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot)
if (z_from_bot(i) > h_amp(i)) then
if (k>2) then
! Always include at least one full layer.
- hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2))
+ hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2))
dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1)
endif
do_i(i) = .false.
@@ -253,23 +231,17 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot)
end subroutine find_N2_bottom
+!> Initializes the data related to the internal tide input module
subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide)
- type(time_type), intent(in) :: Time
- 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(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- type(diag_ctrl), target, intent(inout) :: diag
- type(int_tide_input_CS), pointer :: CS
- type(int_tide_input_type), pointer :: itide
-! Arguments: Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-! (in) diag_to_Z_CSp - A pointer to the Z-diagnostics control structure.
+ type(time_type), intent(in) :: Time !< The current model time
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ type(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output.
+ type(int_tide_input_CS), pointer :: CS !< This module's control structure, which is initialized here.
+ type(int_tide_input_type), pointer :: itide !< A structure containing fields related
+ !! to the internal tide sources.
+ ! Local variables
type(vardesc) :: vd
logical :: read_tideamp
! This include declares and sets the variable "version".
@@ -283,8 +255,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide)
! tidal amplitude file is not present.
real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height.
real :: kappa_itides ! topographic wavenumber and non-dimensional scaling
- real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion,
- ! in m.
+ real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in Z.
integer :: i, j, is, ie, js, je, isd, ied, jsd, jed
if (associated(CS)) then
@@ -315,7 +286,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide)
call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", min_zbot_itides, &
"Turn off internal tidal dissipation when the total \n"//&
- "ocean depth is less than this value.", units="m", default=0.0)
+ "ocean depth is less than this value.", units="m", default=0.0, scale=GV%m_to_Z)
call get_param(param_file, mdl, "UTIDE", utide, &
"The constant tidal amplitude used with INT_TIDE_DISSIPATION.", &
@@ -358,7 +329,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide)
fail_if_missing=.true.)
filename = trim(CS%inputdir) // trim(h2_file)
call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename)
- call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1)
+ call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1, scale=GV%m_to_Z**2)
do j=js,je ; do i=is,ie
mask_itidal = 1.0
@@ -367,11 +338,12 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide)
itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j)
! Restrict rms topo to 10 percent of column depth.
+ !### Note the use here of a hard-coded nondimensional constant.
itide%h2(i,j) = min(0.01*G%bathyT(i,j)**2, itide%h2(i,j))
! Compute the fixed part of internal tidal forcing; units are [J m-2] here.
CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*&
- kappa_itides * itide%h2(i,j) * itide%tideamp(i,j)**2
+ kappa_itides * GV%Z_to_m**2*itide%h2(i,j) * itide%tideamp(i,j)**2
enddo ; enddo
@@ -386,8 +358,9 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide)
end subroutine int_tide_input_init
+!> Deallocates any memory related to the internal tide input module.
subroutine int_tide_input_end(CS)
- type(int_tide_input_CS), pointer :: CS
+ type(int_tide_input_CS), pointer :: CS !< This module's control structure, which is deallocated here.
if (associated(CS)) deallocate(CS)
diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90
index 3344f218bc..2ee8a0bdc6 100644
--- a/src/parameterizations/vertical/MOM_kappa_shear.F90
+++ b/src/parameterizations/vertical/MOM_kappa_shear.F90
@@ -1,34 +1,13 @@
+!> Shear-dependent mixing following Jackson et al. 2008.
module MOM_kappa_shear
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Laura Jackson and Robert Hallberg, 2006-2008 *
-!* *
-!* This file contains the subroutines that determine the diapycnal *
-!* diffusivity driven by resolved shears, as specified by the *
-!* parameterizations described in Jackson and Hallberg (JPO, 2008). *
-!* *
-!* The technique by which the 6 equations (for kappa, TKE, u, v, T, *
-!* and S) are solved simultaneously has been dramatically revised *
-!* from the previous version. The previous version was not converging *
-!* in some cases, especially near the surface mixed layer, while the *
-!* revised version does. The revised version solves for kappa and *
-!* TKE with shear and stratification fixed, then marches the density *
-!* and velocities forward with an adaptive (and aggressive) time step *
-!* in a predictor-corrector-corrector emulation of a trapezoidal *
-!* scheme. Run-time-settable parameters determine the tolerence to *
-!* which the kappa and TKE equations are solved and the minimum time *
-!* step that can be taken. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
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_debugging, only : hchksum
+use MOM_debugging, only : hchksum, Bchksum
use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
@@ -43,63 +22,68 @@ module MOM_kappa_shear
#include
#endif
-public Calculate_kappa_shear, kappa_shear_init, kappa_shear_is_used
+public Calculate_kappa_shear, Calc_kappa_shear_vertex, kappa_shear_init
+public kappa_shear_is_used, kappa_shear_at_vertex
+!> This control structure holds the parameters that regulate shear mixing
type, public :: Kappa_shear_CS ; private
- real :: RiNo_crit ! The critical shear Richardson number for
- ! shear-entrainment. The theoretical value is 0.25.
- ! The values found by Jackson et al. are 0.25-0.35.
- real :: Shearmix_rate ! A nondimensional rate scale for shear-driven
- ! entrainment. The value given by Jackson et al.
- ! is 0.085-0.089.
- real :: FRi_curvature ! A constant giving the curvature of the function
- ! of the Richardson number that relates shear to
- ! sources in the kappa equation, Nondim.
- ! The values found by Jackson et al. are -0.97 - -0.89.
- real :: C_N ! The coefficient for the decay of TKE due to
- ! stratification (i.e. proportional to N*tke), ND.
- ! The values found by Jackson et al. are 0.24-0.28.
- real :: C_S ! The coefficient for the decay of TKE due to
- ! shear (i.e. proportional to |S|*tke), ND.
- ! The values found by Jackson et al. are 0.14-0.12.
- real :: lambda ! The coefficient for the buoyancy length scale
- ! in the kappa equation. Nondimensional.
- ! The values found by Jackson et al. are 0.82-0.81.
- real :: lambda2_N_S ! The square of the ratio of the coefficients of
- ! the buoyancy and shear scales in the diffusivity
- ! equation, 0 to eliminate the shear scale. Nondim.
- real :: TKE_bg ! The background level of TKE, in m2 s-2.
- real :: kappa_0 ! The background diapycnal diffusivity, in m2 s-1.
- real :: kappa_tol_err ! The fractional error in kappa that is tolerated.
- real :: Prandtl_turb ! Prandtl number used to convert Kd_shear into viscosity.
- integer :: nkml ! The number of layers in the mixed layer, as
- ! treated in this routine. If the pieces of the
- ! mixed layer are not to be treated collectively,
- ! nkml is set to 1.
- integer :: max_RiNo_it ! The maximum number of iterations that may be used
- ! to estimate the instantaneous shear-driven mixing.
- integer :: max_KS_it ! The maximum number of iterations that may be used
- ! to estimate the time-averaged diffusivity.
- logical :: eliminate_massless ! If true, massless layers are merged with neighboring
- ! massive layers in this calculation. I can think of
- ! no good reason why this should be false.
- logical :: layer_stagger = .false.
- logical :: debug = .false.
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- integer :: id_Kd_shear = -1, id_TKE = -1
- integer :: id_ILd2 = -1, id_dz_Int = -1
+ real :: RiNo_crit !< The critical shear Richardson number for
+ !! shear-entrainment. The theoretical value is 0.25.
+ !! The values found by Jackson et al. are 0.25-0.35.
+ real :: Shearmix_rate !< A nondimensional rate scale for shear-driven
+ !! entrainment. The value given by Jackson et al.
+ !! is 0.085-0.089.
+ real :: FRi_curvature !< A constant giving the curvature of the function
+ !! of the Richardson number that relates shear to
+ !! sources in the kappa equation, Nondim.
+ !! The values found by Jackson et al. are -0.97 - -0.89.
+ real :: C_N !< The coefficient for the decay of TKE due to
+ !! stratification (i.e. proportional to N*tke), ND.
+ !! The values found by Jackson et al. are 0.24-0.28.
+ real :: C_S !< The coefficient for the decay of TKE due to
+ !! shear (i.e. proportional to |S|*tke), ND.
+ !! The values found by Jackson et al. are 0.14-0.12.
+ real :: lambda !< The coefficient for the buoyancy length scale
+ !! in the kappa equation. Nondimensional.
+ !! The values found by Jackson et al. are 0.82-0.81.
+ real :: lambda2_N_S !< The square of the ratio of the coefficients of
+ !! the buoyancy and shear scales in the diffusivity
+ !! equation, 0 to eliminate the shear scale. Nondim.
+ real :: TKE_bg !< The background level of TKE, in m2 s-2.
+ real :: kappa_0 !< The background diapycnal diffusivity, in Z2 s-1.
+ real :: kappa_tol_err !< The fractional error in kappa that is tolerated.
+ real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity.
+ integer :: nkml !< The number of layers in the mixed layer, as
+ !! treated in this routine. If the pieces of the
+ !! mixed layer are not to be treated collectively,
+ !! nkml is set to 1.
+ integer :: max_RiNo_it !< The maximum number of iterations that may be used
+ !! to estimate the instantaneous shear-driven mixing.
+ integer :: max_KS_it !< The maximum number of iterations that may be used
+ !! to estimate the time-averaged diffusivity.
+ logical :: KS_at_vertex !< If true, do the calculations of the shear-driven mixing
+ !! at the cell vertices (i.e., the vorticity points).
+ logical :: eliminate_massless !< If true, massless layers are merged with neighboring
+ !! massive layers in this calculation.
+ ! I can think of no good reason why this should be false. - RWH
+! logical :: layer_stagger = .false. ! If true, do the calculations centered at
+ ! layers, rather than the interfaces.
+ logical :: debug = .false. !< If true, write verbose debugging messages.
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ !>@{ Diagnostic IDs
+ integer :: id_Kd_shear = -1, id_TKE = -1, id_ILd2 = -1, id_dz_Int = -1
+ !!@}
end type Kappa_shear_CS
! integer :: id_clock_project, id_clock_KQ, id_clock_avg, id_clock_setup
- character(len=40) :: mdl = "MOM_kappa_shear" ! This module's name.
#undef DEBUG
#undef ADD_DIAGNOSTICS
contains
-!> Subroutine for calculating diffusivity and TKE
+!> Subroutine for calculating shear-driven diffusivity and TKE in tracer columns
subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
kv_io, dt, G, GV, CS, initialize_all)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
@@ -117,7 +101,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
!! (or NULL).
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface
- !! (not layer!) in m2 s-1. Initially this is the
+ !! (not layer!) in Z2 s-1. Initially this is the
!! value from the previous timestep, which may
!! accelerate the iteration toward convergence.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
@@ -128,71 +112,45 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
!! toward convergence.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
intent(inout) :: kv_io !< The vertical viscosity at each interface
- !! (not layer!) in m2 s-1. This discards any
- !! previous value i.e. intent(out) and simply
- !! sets Kv = Prandtl * Kd_shear
+ !! (not layer!) in Z2 s-1. This discards any
+ !! previous value (i.e. it is intent out) and
+ !! simply sets Kv = Prandtl * Kd_shear
real, intent(in) :: dt !< Time increment, in s.
type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous
!! call to kappa_shear_init.
logical, optional, intent(in) :: initialize_all !< If present and false, the previous
!! value of kappa is used to start the iterations
-!
-! ----------------------------------------------
-! Subroutine for calculating diffusivity and TKE
-! ----------------------------------------------
-! Arguments: u_in - Initial zonal velocity, in m s-1. (Intent in)
-! (in) v_in - Initial meridional velocity, in m s-1.
-! (in) h - Layer thickness, in m or kg m-2.
-! (in) tv - A structure containing pointers to any available
-! thermodynamic fields. Absent fields have NULL ptrs.
-! (in) p_surf - The pressure at the ocean surface in Pa (or NULL).
-! (in/out) kappa_io - The diapycnal diffusivity at each interface
-! (not layer!) in m2 s-1. Initially this is the value
-! from the previous timestep, which may accelerate the
-! iteration toward convergence.
-! (in/out) tke_io - The turbulent kinetic energy per unit mass at each
-! interface (not layer!) in m2 s-2. Initially this is the
-! value from the previous timestep, which may accelerate
-! the iteration toward convergence.
-! (in/out) kv_io - The vertical viscosity at each interface
-! (not layer!) in m2 s-1. This discards any previous value
-! i.e. intent(out) and simply sets Kv = Prandtl * Kd_shear
-! (in) dt - Time increment, in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! kappa_shear_init.
-! (in,opt) initialize_all - If present and false, the previous value of
-! kappa is used to start the iterations.
+
+ ! Local variables
real, dimension(SZI_(G),SZK_(GV)) :: &
h_2d, & ! A 2-D version of h, but converted to m.
u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho.
real, dimension(SZI_(G),SZK_(GV)+1) :: &
- kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io.
+ kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io.
real, dimension(SZK_(GV)) :: &
u, & ! The zonal velocity after a timestep of mixing, in m s-1.
v, & ! The meridional velocity after a timestep of mixing, in m s-1.
- Idz, & ! The inverse of the distance between TKE points, in m.
+ Idz, & ! The inverse of the distance between TKE points, in Z-1.
T, & ! The potential temperature after a timestep of mixing, in C.
Sal, & ! The salinity after a timestep of mixing, in psu.
- dz, & ! The layer thickness, in m.
- u0xdz, & ! The initial zonal velocity times dz, in m2 s-1.
- v0xdz, & ! The initial meridional velocity times dz, in m2 s-1.
- T0xdz, & ! The initial temperature times dz, in C m.
- S0xdz ! The initial salinity times dz, in PSU m.
+ dz, & ! The layer thickness, in Z.
+ u0xdz, & ! The initial zonal velocity times dz, in Z m s-1.
+ v0xdz, & ! The initial meridional velocity times dz, in Z m s-1.
+ T0xdz, & ! The initial temperature times dz, in C Z.
+ S0xdz ! The initial salinity times dz, in PSU Z.
real, dimension(SZK_(GV)+1) :: &
kappa, & ! The shear-driven diapycnal diffusivity at an interface, in
- ! units of m2 s-1.
+ ! units of Z2 s-1.
tke, & ! The Turbulent Kinetic Energy per unit mass at an interface,
! in units of m2 s-2.
- kappa_avg, & ! The time-weighted average of kappa, in m2 s-1.
+ kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1.
tke_avg ! The time-weighted average of TKE, in m2 s-2.
real :: f2 ! The squared Coriolis parameter of each column, in s-2.
real :: surface_pres ! The top surface pressure, in Pa.
- real :: dz_in_lay ! The running sum of the thickness in a layer, in m.
- real :: k0dt ! The background diffusivity times the timestep, in m2.
- real :: dz_massless ! A layer thickness that is considered massless, in m.
+ real :: dz_in_lay ! The running sum of the thickness in a layer, in Z.
+ real :: k0dt ! The background diffusivity times the timestep, in Z2.
+ real :: dz_massless ! A layer thickness that is considered massless, in Z.
logical :: use_temperature ! If true, temperature and salinity have been
! allocated and are being used as state variables.
logical :: new_kappa = .true. ! If true, ignore the value of kappa from the
@@ -218,7 +176,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
integer :: max_debug_itt ; parameter(max_debug_itt=20)
real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt
real, dimension(SZK_(GV)+1) :: &
- Ri_k, tke_prev, dtke, dkappa, dtke_norm, &
+ Ri_k, tke_prev, dtke, dkap, dtke_norm, &
ksrc_av ! The average through the iterations of k_src, in s-1.
real, dimension(SZK_(GV)+1,0:max_debug_itt) :: &
tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1
@@ -232,37 +190,20 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
#endif
is = G%isc ; ie = G%iec; js = G%jsc ; je = G%jec ; nz = GV%ke
- ! These are hard-coded for now. Perhaps these could be made dynamic later?
- ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ?
-! tol_dksrc = 10.0 ; tol_dksrc_low = 0.95 ; tol2 = 2.0*CS%kappa_tol_err
-! dt_refinements = 5 ! Selected so that 1/2^dt_refinements < 1-tol_dksrc_low
-
use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true.
new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all
-! Ri_crit = CS%Rino_crit
-! gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0
-
k0dt = dt*CS%kappa_0
dz_massless = 0.1*sqrt(k0dt)
-!$OMP parallel do default(none) shared(js,je,is,ie,nz,h,u_in,v_in,use_temperature,new_kappa, &
-!$OMP tv,G,GV,CS,kappa_io,dz_massless,k0dt,p_surf,dt, &
-#ifdef ADD_DIAGNOSTICS
-!$OMP I_Ld2_3d,dz_Int_3d, &
-#endif
-!$OMP tke_io,kv_io) &
-!$OMP private(h_2d,u_2d,v_2d,T_2d,S_2d,rho_2d,kappa_2d,nzc,dz, &
-!$OMP u0xdz,v0xdz,T0xdz,S0xdz,kc,Idz,kf,dz_in_lay, &
-!$OMP u,v,T,Sal,f2,kappa,kappa_avg,tke_avg,tke,surface_pres,&
+ !$OMP parallel do default(private) shared(js,je,is,ie,nz,h,u_in,v_in,use_temperature,new_kappa, &
#ifdef ADD_DIAGNOSTICS
-!$OMP I_Ld2_1d,I_Ld2_2d, dz_Int_2d, &
+ !$OMP I_Ld2_3d,dz_Int_3d, &
#endif
-!$OMP tke_2d)
-
+ !$OMP tv,G,GV,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io)
do j=js,je
do k=1,nz ; do i=is,ie
- h_2d(i,k) = h(i,j,k)*GV%H_to_m
+ h_2d(i,k) = h(i,j,k)*GV%H_to_Z
u_2d(i,k) = u_in(i,j,k) ; v_2d(i,k) = v_in(i,j,k)
enddo ; enddo
if (use_temperature) then ; do k=1,nz ; do i=is,ie
@@ -350,7 +291,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
! Set the initial guess for kappa, here defined at interfaces.
! ----------------------------------------------------
if (new_kappa) then
- do K=1,nzc+1 ; kappa(K) = 1.0 ; enddo
+ do K=1,nzc+1 ; kappa(K) = GV%m_to_Z**2*1.0 ; enddo
else
do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo
endif
@@ -383,8 +324,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
#ifdef ADD_DIAGNOSTICS
I_Ld2_2d(i,1) = 0.0 ; dz_Int_2d(i,1) = dz_Int(1)
do K=2,nzc
- I_Ld2_2d(i,K) = (N2(K) / CS%lambda**2 + f2) / &
- max(TKE(K),1e-30) + I_L2_bdry(K)
+ I_Ld2_2d(i,K) = I_L2_bdry(K) + &
+ (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30))
dz_Int_2d(i,K) = dz_Int(K)
enddo
I_Ld2_2d(i,nzc+1) = 0.0 ; dz_Int_2d(i,nzc+1) = dz_Int(nzc+1)
@@ -416,8 +357,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
enddo ! end of j-loop
if (CS%debug) then
- call hchksum(kappa_io,"kappa",G%HI)
- call hchksum(tke_io,"tke",G%HI)
+ call hchksum(kappa_io, "kappa", G%HI, scale=GV%Z_to_m**2)
+ call hchksum(tke_io, "tke", G%HI)
endif
if (CS%id_Kd_shear > 0) call post_data(CS%id_Kd_shear, kappa_io, CS%diag)
@@ -427,16 +368,347 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
if (CS%id_dz_Int > 0) call post_data(CS%id_dz_Int, dz_Int_3d, CS%diag)
#endif
- return
-
end subroutine Calculate_kappa_shear
+
+!> Subroutine for calculating shear-driven diffusivity and TKE in corner columns
+subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_io, tke_io, &
+ kv_io, dt, G, GV, CS, initialize_all)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: u_in !< Initial zonal velocity, in m s-1. (Intent in)
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(in) :: v_in !< Initial meridional velocity, in m s-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: T_in !< Layer potential temperatures in degC
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: S_in !< Layer salinities in ppt.
+ 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 in Pa
+ !! (or NULL).
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
+ intent(out) :: kappa_io !< The diapycnal diffusivity at each interface
+ !! (not layer!) in Z2 s-1.
+ real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), &
+ intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at
+ !! each interface (not layer!) in m2 s-2.
+ !! Initially this is the value from the previous
+ !! timestep, which may accelerate the iteration
+ !! toward convergence.
+ real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), &
+ intent(inout) :: kv_io !< The vertical viscosity at each interface in Z2 s-1.
+ !! The previous value is used to initialize kappa
+ !! in the vertex columes as Kappa = Kv/Prandtl
+ !! to accelerate the iteration toward covergence.
+ real, intent(in) :: dt !< Time increment, in s.
+ type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous
+ !! call to kappa_shear_init.
+ logical, optional, intent(in) :: initialize_all !< If present and false, the previous
+ !! value of kappa is used to start the iterations
+
+ ! Local variables
+ real, dimension(SZIB_(G),SZK_(GV)) :: &
+ h_2d, & ! A 2-D version of h, but converted to m.
+ u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho.
+ real, dimension(SZIB_(G),SZK_(GV)+1,2) :: &
+ kappa_2d ! Quasi 2-D versions of kappa_io, in Z2 s-1.
+ real, dimension(SZIB_(G),SZK_(GV)+1) :: &
+ tke_2d ! 2-D version tke_io in m2 s-2.
+ real, dimension(SZK_(GV)) :: &
+ u, & ! The zonal velocity after a timestep of mixing, in m s-1.
+ v, & ! The meridional velocity after a timestep of mixing, in m s-1.
+ Idz, & ! The inverse of the distance between TKE points, in Z-1.
+ T, & ! The potential temperature after a timestep of mixing, in C.
+ Sal, & ! The salinity after a timestep of mixing, in psu.
+ dz, & ! The layer thickness, in Z.
+ u0xdz, & ! The initial zonal velocity times dz, in m Z s-1.
+ v0xdz, & ! The initial meridional velocity times dz, in m Z s-1.
+ T0xdz, & ! The initial temperature times dz, in C Z.
+ S0xdz ! The initial salinity times dz, in PSU Z.
+ real, dimension(SZK_(GV)+1) :: &
+ kappa, & ! The shear-driven diapycnal diffusivity at an interface, in
+ ! units of m2 s-1.
+ tke, & ! The Turbulent Kinetic Energy per unit mass at an interface,
+ ! in units of m2 s-2.
+ kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1.
+ tke_avg ! The time-weighted average of TKE, in m2 s-2.
+ real :: f2 ! The squared Coriolis parameter of each column, in s-2.
+ real :: surface_pres ! The top surface pressure, in Pa.
+
+ real :: dz_in_lay ! The running sum of the thickness in a layer, in Z.
+ real :: k0dt ! The background diffusivity times the timestep, in Z2.
+ real :: dz_massless ! A layer thickness that is considered massless, in Z.
+ real :: I_hwt ! The inverse of the masked thickness weights, in H-1.
+ real :: I_Prandtl
+ logical :: use_temperature ! If true, temperature and salinity have been
+ ! allocated and are being used as state variables.
+ logical :: new_kappa = .true. ! If true, ignore the value of kappa from the
+ ! last call to this subroutine.
+ logical :: do_i ! If true, work on this column.
+
+ integer, dimension(SZK_(GV)+1) :: kc ! The index map between the original
+ ! interfaces and the interfaces with massless layers
+ ! merged into nearby massive layers.
+ real, dimension(SZK_(GV)+1) :: kf ! The fractional weight of interface kc+1 for
+ ! interpolating back to the original index space, ND.
+ integer :: IsB, IeB, JsB, JeB, i, j, k, nz, nzc, J2, J2m1
+
+ ! Diagnostics that should be deleted?
+#ifdef ADD_DIAGNOSTICS
+ real, dimension(SZK_(GV)+1) :: & ! Additional diagnostics.
+ I_Ld2_1d
+ real, dimension(SZI_(G),SZK_(GV)+1) :: & ! 2-D versions of diagnostics.
+ I_Ld2_2d, dz_Int_2d
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ! 3-D versions of diagnostics.
+ I_Ld2_3d, dz_Int_3d
+#endif
+#ifdef DEBUG
+ integer :: max_debug_itt ; parameter(max_debug_itt=20)
+ real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt
+ real, dimension(SZK_(GV)+1) :: &
+ Ri_k, tke_prev, dtke, dkappa, dtke_norm, &
+ ksrc_av ! The average through the iterations of k_src, in s-1.
+ real, dimension(SZK_(GV)+1,0:max_debug_itt) :: &
+ tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1
+ real, dimension(SZK_(GV)+1,1:max_debug_itt) :: &
+ dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm
+ real, dimension(SZK_(GV),0:max_debug_itt) :: &
+ u_it1, v_it1, rho_it1, T_it1, S_it1
+ real, dimension(0:max_debug_itt) :: &
+ dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag
+ real, dimension(max_debug_itt) :: dt_it1
+#endif
+ isB = G%isc-1 ; ieB = G%iecB ; jsB = G%jsc-1 ; jeB = G%jecB ; nz = GV%ke
+
+ use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true.
+ new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all
+
+ k0dt = dt*CS%kappa_0
+ dz_massless = 0.1*sqrt(k0dt)
+ I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb
+
+ !$OMP parallel do default(private) shared(jsB,jeB,isB,ieB,nz,h,u_in,v_in,use_temperature,new_kappa, &
+#ifdef ADD_DIAGNOSTICS
+ !$OMP I_Ld2_3d,dz_Int_3d, &
+#endif
+ !$OMP tv,G,GV,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io)
+ do J=JsB,JeB
+ J2 = mod(J,2)+1 ; J2m1 = 3-J2 ! = mod(J-1,2)+1
+
+ ! Interpolate the various quantities to the corners, using masks.
+ do k=1,nz ; do I=IsB,IeB
+ u_2d(I,k) = (u_in(I,j,k) * (G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k))) + &
+ u_in(I,j+1,k) * (G%mask2dCu(I,j+1) * (h(i,j+1,k) + h(i+1,j+1,k))) ) / &
+ ((G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k)) + &
+ G%mask2dCu(I,j+1) * (h(i,j+1,k) + h(i+1,j+1,k))) + GV%H_subroundoff)
+ v_2d(I,k) = (v_in(i,J,k) * (G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k))) + &
+ v_in(i+1,J,k) * (G%mask2dCv(i+1,J) * (h(i+1,j,k) + h(i+1,j+1,k))) ) / &
+ ((G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k)) + &
+ G%mask2dCv(i+1,J) * (h(i+1,j,k) + h(i+1,j+1,k))) + GV%H_subroundoff)
+ I_hwt = 1.0 / (((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + &
+ (G%mask2dT(i+1,j) * h(i+1,j,k) + G%mask2dT(i,j+1) * h(i,j+1,k))) + &
+ GV%H_subroundoff)
+ if (use_temperature) then
+ T_2d(I,k) = ( ((G%mask2dT(i,j) * h(i,j,k)) * T_in(i,j,k) + &
+ (G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) * T_in(i+1,j+1,k)) + &
+ ((G%mask2dT(i+1,j) * h(i+1,j,k)) * T_in(i+1,j,k) + &
+ (G%mask2dT(i,j+1) * h(i,j+1,k)) * T_in(i,j+1,k)) ) * I_hwt
+ S_2d(I,k) = ( ((G%mask2dT(i,j) * h(i,j,k)) * S_in(i,j,k) + &
+ (G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) * S_in(i+1,j+1,k)) + &
+ ((G%mask2dT(i+1,j) * h(i+1,j,k)) * S_in(i+1,j,k) + &
+ (G%mask2dT(i,j+1) * h(i,j+1,k)) * S_in(i,j+1,k)) ) * I_hwt
+ endif
+ h_2d(I,k) = GV%H_to_Z * ((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + &
+ (G%mask2dT(i+1,j) * h(i+1,j,k) + G%mask2dT(i,j+1) * h(i,j+1,k)) ) / &
+ ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + &
+ (G%mask2dT(i+1,j) + G%mask2dT(i,j+1)) + 1.0e-36 )
+! h_2d(I,k) = 0.25*((h(i,j,k) + h(i+1,j+1,k)) + (h(i+1,j,k) + h(i,j+1,k)))*GV%H_to_Z
+! h_2d(I,k) = ((h(i,j,k)**2 + h(i+1,j+1,k)**2) + &
+! (h(i+1,j,k)**2 + h(i,j+1,k)**2))*GV%H_to_Z * I_hwt
+ enddo ; enddo
+ if (.not.use_temperature) then ; do k=1,nz ; do I=IsB,IeB
+ rho_2d(I,k) = GV%Rlay(k)
+ enddo ; enddo ; endif
+ if (.not.new_kappa) then ; do K=1,nz+1 ; do I=IsB,IeB
+ kappa_2d(I,K,J2) = kv_io(I,J,K) * I_Prandtl
+ enddo ; enddo ; endif
+
+!---------------------------------------
+! Work on each column.
+!---------------------------------------
+ do I=IsB,IeB ; if ((G%mask2dCu(I,j) + G%mask2dCu(I,j+1)) + &
+ (G%mask2dCv(i,J) + G%mask2dCv(i+1,J)) > 0.0) then
+ ! call cpu_clock_begin(Id_clock_setup)
+ ! Store a transposed version of the initial arrays.
+ ! Any elimination of massless layers would occur here.
+ if (CS%eliminate_massless) then
+ nzc = 1
+ do k=1,nz
+ ! Zero out the thicknesses of all layers, even if they are unused.
+ dz(k) = 0.0 ; u0xdz(k) = 0.0 ; v0xdz(k) = 0.0
+ T0xdz(k) = 0.0 ; S0xdz(k) = 0.0
+
+ ! Add a new layer if this one has mass.
+! if ((dz(nzc) > 0.0) .and. (h_2d(I,k) > dz_massless)) nzc = nzc+1
+ if ((k>CS%nkml) .and. (dz(nzc) > 0.0) .and. &
+ (h_2d(I,k) > dz_massless)) nzc = nzc+1
+
+ ! Only merge clusters of massless layers.
+! if ((dz(nzc) > dz_massless) .or. &
+! ((dz(nzc) > 0.0) .and. (h_2d(I,k) > dz_massless))) nzc = nzc+1
+
+ kc(k) = nzc
+ dz(nzc) = dz(nzc) + h_2d(I,k)
+ u0xdz(nzc) = u0xdz(nzc) + u_2d(I,k)*h_2d(I,k)
+ v0xdz(nzc) = v0xdz(nzc) + v_2d(I,k)*h_2d(I,k)
+ if (use_temperature) then
+ T0xdz(nzc) = T0xdz(nzc) + T_2d(I,k)*h_2d(I,k)
+ S0xdz(nzc) = S0xdz(nzc) + S_2d(I,k)*h_2d(I,k)
+ else
+ T0xdz(nzc) = T0xdz(nzc) + rho_2d(I,k)*h_2d(I,k)
+ S0xdz(nzc) = S0xdz(nzc) + rho_2d(I,k)*h_2d(I,k)
+ endif
+ enddo
+ kc(nz+1) = nzc+1
+
+ ! Set up Idz as the inverse of layer thicknesses.
+ do k=1,nzc ; Idz(k) = 1.0 / dz(k) ; enddo
+
+ ! Now determine kf, the fractional weight of interface kc when
+ ! interpolating between interfaces kc and kc+1.
+ kf(1) = 0.0 ; dz_in_lay = h_2d(I,1)
+ do k=2,nz
+ if (kc(k) > kc(k-1)) then
+ kf(k) = 0.0 ; dz_in_lay = h_2d(I,k)
+ else
+ kf(k) = dz_in_lay*Idz(kc(k)) ; dz_in_lay = dz_in_lay + h_2d(I,k)
+ endif
+ enddo
+ kf(nz+1) = 0.0
+ else
+ do k=1,nz
+ dz(k) = h_2d(I,k)
+ u0xdz(k) = u_2d(I,k)*dz(k) ; v0xdz(k) = v_2d(I,k)*dz(k)
+ enddo
+ if (use_temperature) then
+ do k=1,nz
+ T0xdz(k) = T_2d(I,k)*dz(k) ; S0xdz(k) = S_2d(I,k)*dz(k)
+ enddo
+ else
+ do k=1,nz
+ T0xdz(k) = rho_2d(I,k)*dz(k) ; S0xdz(k) = rho_2d(I,k)*dz(k)
+ enddo
+ endif
+ nzc = nz
+ do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo
+ endif
+ f2 = G%CoriolisBu(I,J)**2
+ surface_pres = 0.0 ; if (associated(p_surf)) then
+ surface_pres = 0.25 * ((p_surf(i,j) + p_surf(i+1,j+1)) + &
+ (p_surf(i+1,j) + p_surf(i,j+1)))
+ endif
+
+ ! ----------------------------------------------------
+ ! Set the initial guess for kappa, here defined at interfaces.
+ ! ----------------------------------------------------
+ if (new_kappa) then
+ do K=1,nzc+1 ; kappa(K) = GV%m_to_Z**2*1.0 ; enddo
+ else
+ do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo
+ endif
+
+ call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
+ dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, &
+ tke_avg, tv, CS, GV)
+
+ ! call cpu_clock_begin(Id_clock_setup)
+ ! Extrapolate from the vertically reduced grid back to the original layers.
+ if (nz == nzc) then
+ do K=1,nz+1
+ kappa_2d(I,K,J2) = kappa_avg(K)
+ !### Should this be tke_avg?
+ tke_2d(I,K) = tke(K)
+ enddo
+ else
+ do K=1,nz+1
+ if (kf(K) == 0.0) then
+ kappa_2d(I,K,J2) = kappa_avg(kc(K))
+ tke_2d(I,K) = tke_avg(kc(K))
+ else
+ kappa_2d(I,K,J2) = (1.0-kf(K)) * kappa_avg(kc(K)) + &
+ kf(K) * kappa_avg(kc(K)+1)
+ tke_2d(I,K) = (1.0-kf(K)) * tke_avg(kc(K)) + &
+ kf(K) * tke_avg(kc(K)+1)
+ endif
+ enddo
+ endif
+#ifdef ADD_DIAGNOSTICS
+ I_Ld2_2d(I,1) = 0.0 ; dz_Int_2d(I,1) = dz_Int(1)
+ do K=2,nzc
+ I_Ld2_2d(I,K) = I_L2_bdry(K) + &
+ (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30))
+ dz_Int_2d(I,K) = dz_Int(K)
+ enddo
+ I_Ld2_2d(I,nzc+1) = 0.0 ; dz_Int_2d(I,nzc+1) = dz_Int(nzc+1)
+ do K=nzc+2,nz+1
+ I_Ld2_2d(I,K) = 0.0 ; dz_Int_2d(I,K) = 0.0
+ enddo
+#endif
+ ! call cpu_clock_end(Id_clock_setup)
+ else ! Land points, still inside the i-loop.
+ do K=1,nz+1
+ kappa_2d(I,K,J2) = 0.0 ; tke_2d(I,K) = 0.0
+#ifdef ADD_DIAGNOSTICS
+ I_Ld2_2d(I,K) = 0.0
+ dz_Int_2d(I,K) = dz_Int(K)
+#endif
+ enddo
+ endif ; enddo ! i-loop
+
+ do K=1,nz+1 ; do I=IsB,IeB
+ tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K)
+ kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb
+#ifdef ADD_DIAGNOSTICS
+ I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K)
+ dz_Int_3d(I,J,K) = dz_Int_2d(I,K)
+#endif
+ enddo ; enddo
+ if (J>=G%jsc) then ; do K=1,nz+1 ; do i=G%isc,G%iec
+ ! Set the diffusivities in tracer columns from the values at vertices.
+ kappa_io(i,j,K) = G%mask2dT(i,j) * 0.25 * &
+ ((kappa_2d(I-1,K,J2m1) + kappa_2d(I,K,J2)) + &
+ (kappa_2d(I-1,K,J2) + kappa_2d(I,K,J2m1)))
+ enddo ; enddo ; endif
+
+ enddo ! end of J-loop
+
+ if (CS%debug) then
+ call hchksum(kappa_io, "kappa", G%HI, scale=GV%Z_to_m**2)
+ call Bchksum(tke_io, "tke", G%HI)
+ endif
+
+ if (CS%id_Kd_shear > 0) call post_data(CS%id_Kd_shear, kappa_io, CS%diag)
+ if (CS%id_TKE > 0) call post_data(CS%id_TKE, tke_io, CS%diag)
+#ifdef ADD_DIAGNOSTICS
+ if (CS%id_ILd2 > 0) call post_data(CS%id_ILd2, I_Ld2_3d, CS%diag)
+ if (CS%id_dz_Int > 0) call post_data(CS%id_dz_Int, dz_Int_3d, CS%diag)
+#endif
+
+end subroutine Calc_kappa_shear_vertex
+
+
+!> This subroutine calculates shear-driven diffusivity and TKE in a single column
subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, &
tke_avg, tv, CS, GV)
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(SZK_(GV)+1), &
- intent(inout) :: kappa !< The time-weighted average of kappa, in m2 s-1.
+ intent(inout) :: kappa !< The time-weighted average of kappa, in Z2 s-1.
real, dimension(SZK_(GV)+1), &
intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at
!! an interface, in units of m2 s-2.
@@ -444,17 +716,17 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
real, intent(in) :: f2 !< The square of the Coriolis parameter, in s-2.
real, intent(in) :: surface_pres !< The surface pressure, in Pa.
real, dimension(SZK_(GV)), &
- intent(in) :: dz !< The layer thickness, in m.
+ intent(in) :: dz !< The layer thickness, in Z.
real, dimension(SZK_(GV)), &
- intent(in) :: u0xdz !< The initial zonal velocity times dz, in m2 s-1.
+ intent(in) :: u0xdz !< The initial zonal velocity times dz, in Z m s-1.
real, dimension(SZK_(GV)), &
- intent(in) :: v0xdz !< The initial meridional velocity times dz, in m2 s-1.
+ intent(in) :: v0xdz !< The initial meridional velocity times dz, in Z m s-1.
real, dimension(SZK_(GV)), &
- intent(in) :: T0xdz !< The initial temperature times dz, in C m.
+ intent(in) :: T0xdz !< The initial temperature times dz, in C Z.
real, dimension(SZK_(GV)), &
- intent(in) :: S0xdz !< The initial salinity times dz, in PSU m.
+ intent(in) :: S0xdz !< The initial salinity times dz, in PSU Z.
real, dimension(SZK_(GV)+1), &
- intent(out) :: kappa_avg !< The time-weighted average of kappa, in m2 s-1.
+ intent(out) :: kappa_avg !< The time-weighted average of kappa, in Z2 s-1.
real, dimension(SZK_(GV)+1), &
intent(out) :: tke_avg !< The time-weighted average of TKE, in m2 s-2.
real, intent(in) :: dt !< Time increment, in s.
@@ -467,7 +739,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
real, dimension(nzc) :: &
u, & ! The zonal velocity after a timestep of mixing, in m s-1.
v, & ! The meridional velocity after a timestep of mixing, in m s-1.
- Idz, & ! The inverse of the distance between TKE points, in m.
+ Idz, & ! The inverse of the distance between TKE points, in Z-1.
T, & ! The potential temperature after a timestep of mixing, in C.
Sal, & ! The salinity after a timestep of mixing, in psu.
u_test, v_test, T_test, S_test
@@ -475,46 +747,46 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
real, dimension(nzc+1) :: &
N2, & ! The squared buoyancy frequency at an interface, in s-2.
dz_Int, & ! The extent of a finite-volume space surrounding an interface,
- ! as used in calculating kappa and TKE, in m.
+ ! as used in calculating kappa and TKE, in Z.
I_dz_int, & ! The inverse of the distance between velocity & density points
- ! above and below an interface, in m-1. This is used to
+ ! above and below an interface, in Z-1. This is used to
! calculate N2, shear, and fluxes, and it might differ from
! 1/dz_Int, as they have different uses.
S2, & ! The squared shear at an interface, in s-2.
a1, & ! a1 is the coupling between adjacent interfaces in the TKE,
- ! velocity, and density equations, in m s-1 or m.
+ ! velocity, and density equations, in Z s-1 or Z.
c1, & ! c1 is used in the tridiagonal (and similar) solvers.
k_src, & ! The shear-dependent source term in the kappa equation, in s-1.
kappa_src, & ! The shear-dependent source term in the kappa equation in s-1.
- kappa_out, & ! The kappa that results from the kappa equation, in m2 s-1.
+ kappa_out, & ! The kappa that results from the kappa equation, in Z2 s-1.
kappa_mid, & ! The average of the initial and predictor estimates of kappa,
- ! in units of m2 s-1.
+ ! in units of Z2 s-1.
tke_pred, & ! The value of TKE from a predictor step, in m2 s-2.
- kappa_pred, & ! The value of kappa from a predictor step, in m2 s-1.
+ kappa_pred, & ! The value of kappa from a predictor step, in Z2 s-1.
pressure, & ! The pressure at an interface, in Pa.
T_int, & ! The temperature interpolated to an interface, in C.
Sal_int, & ! The salinity interpolated to an interface, in psu.
dbuoy_dT, & ! The partial derivatives of buoyancy with changes in
- dbuoy_dS, & ! temperature and salinity, in m s-2 K-1 and m s-2 psu-1.
+ dbuoy_dS, & ! temperature and salinity, in Z s-2 K-1 and Z s-2 psu-1.
I_L2_bdry, & ! The inverse of the square of twice the harmonic mean
- ! distance to the top and bottom boundaries, in m-2.
- K_Q, & ! Diffusivity divided by TKE, in s.
- K_Q_tmp, & ! Diffusivity divided by TKE, in s.
+ ! distance to the top and bottom boundaries, in Z-2.
+ K_Q, & ! Diffusivity divided by TKE, in Z2 m-2 s.
+ K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE, in Z2 m-2 s.
local_src_avg, & ! The time-integral of the local source, nondim.
tol_min, & ! Minimum tolerated ksrc for the corrector step, in s-1.
tol_max, & ! Maximum tolerated ksrc for the corrector step, in s-1.
tol_chg, & ! The tolerated change integrated in time, nondim.
- dist_from_top, & ! The distance from the top surface, in m.
+ dist_from_top, & ! The distance from the top surface, in Z.
local_src ! The sum of all sources of kappa, including kappa_src and
! sources from the elliptic term, in s-1.
- real :: dist_from_bot ! The distance from the bottom surface, in m.
+ real :: dist_from_bot ! The distance from the bottom surface, in Z.
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 ! Rho_0 times g in kg m-2 s-2.
- real :: g_R0 ! g_R0 is g/Rho in m4 kg-1 s-2.
- real :: Norm ! A factor that normalizes two weights to 1, in m-2.
+ real :: g_R0 ! g_R0 is g/Rho in Z m3 kg-1 s-2.
+ real :: Norm ! A factor that normalizes two weights to 1, in Z-2.
real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later.
real :: tol_dksrc_low ! The tolerance for the fractional decrease in ksrc
! within an iteration. 0 < tol_dksrc_low < 1.
@@ -528,7 +800,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
real :: Idtt ! Idtt = 1 / dt_test, in s-1.
real :: dt_inc ! An increment to dt_test that is being tested, in s.
- real :: k0dt ! The background diffusivity times the timestep, in m2.
+ real :: k0dt ! The background diffusivity times the timestep, in Z2.
logical :: valid_dt ! If true, all levels so far exhibit acceptably small
! changes in k_src.
logical :: use_temperature ! If true, temperature and salinity have been
@@ -543,7 +815,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
integer :: k, itt, itt_dt
Ri_crit = CS%Rino_crit
- gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0
+ gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z**2)/GV%Rho0
k0dt = dt*CS%kappa_0
! These are hard-coded for now. Perhaps these could be made dynamic later?
! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ?
@@ -568,7 +840,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
! layers and applying a time-step of background diffusion.
if (nzc > 1) then
a1(2) = k0dt*I_dz_int(2)
- b1 = 1.0 / (dz(1)+a1(2))
+ b1 = 1.0 / (dz(1) + a1(2))
u(1) = b1 * u0xdz(1) ; v(1) = b1 * v0xdz(1)
T(1) = b1 * T0xdz(1) ; Sal(1) = b1 * S0xdz(1)
c1(2) = a1(2) * b1 ; d1 = dz(1) * b1 ! = 1 - c1
@@ -626,14 +898,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
do K=nzc,2,-1
dist_from_bot = dist_from_bot + dz(k)
I_L2_bdry(K) = (dist_from_top(K) + dist_from_bot)**2 / &
- (dist_from_top(K) * dist_from_bot)**2
+ (dist_from_top(K) * dist_from_bot)**2
enddo
! Calculate thermodynamic coefficients and an initial estimate of N2.
if (use_temperature) then
pressure(1) = surface_pres
do K=2,nzc
- pressure(K) = pressure(K-1) + gR0*dz(k-1)
+ pressure(K) = pressure(K-1) + gR0*GV%Z_to_m*dz(k-1)
T_int(K) = 0.5*(T(k-1) + T(k))
Sal_int(K) = 0.5*(Sal(k-1) + Sal(k))
enddo
@@ -690,7 +962,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
! This call just calculates N2 and S2.
call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, &
dz, I_dz_int, dbuoy_dT, dbuoy_dS, &
- u, v, T, Sal, N2=N2, S2=S2)
+ u, v, T, Sal, GV, N2=N2, S2=S2)
! ----------------------------------------------------
! Iterate
! ----------------------------------------------------
@@ -721,7 +993,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
! call cpu_clock_begin(id_clock_KQ)
call find_kappa_tke(N2, S2, kappa, Idz, dz_Int, I_L2_bdry, f2, &
- nzc, CS, K_Q, tke, kappa_out, kappa_src, local_src)
+ nzc, CS, GV, K_Q, tke, kappa_out, kappa_src, local_src)
! call cpu_clock_end(id_clock_KQ)
! call cpu_clock_begin(id_clock_avg)
@@ -760,7 +1032,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
! enough.
call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, &
dz, I_dz_int, dbuoy_dT, dbuoy_dS, &
- u_test, v_test, T_test, S_test, N2, S2, &
+ u_test, v_test, T_test, S_test, GV, N2, S2, &
ks_int = ks_kappa, ke_int = ke_kappa)
valid_dt = .true.
Idtt = 1.0 / dt_test
@@ -787,7 +1059,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
do itt_dt=1,dt_refinements
call calculate_projected_state(kappa_out, u, v, T, Sal, &
0.5*(dt_test+dt_inc), nzc, dz, I_dz_int, dbuoy_dT, &
- dbuoy_dS, u_test, v_test, T_test, S_test, N2, S2, &
+ dbuoy_dS, u_test, v_test, T_test, S_test, GV, N2, S2, &
ks_int = ks_kappa, ke_int = ke_kappa)
valid_dt = .true.
Idtt = 1.0 / (dt_test+dt_inc)
@@ -841,14 +1113,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
! call cpu_clock_begin(id_clock_project)
call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, &
dz, I_dz_int, dbuoy_dT, dbuoy_dS, &
- u_test, v_test, T_test, S_test, N2=N2, S2=S2, &
+ u_test, v_test, T_test, S_test, GV, N2=N2, S2=S2, &
ks_int = ks_kappa, ke_int = ke_kappa)
! call cpu_clock_end(id_clock_project)
! call cpu_clock_begin(id_clock_KQ)
do K=1,nzc+1 ; K_Q_tmp(K) = K_Q(K) ; enddo
call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, &
- nzc, CS, K_Q_tmp, tke_pred, kappa_pred)
+ nzc, CS, GV, K_Q_tmp, tke_pred, kappa_pred)
! call cpu_clock_end(id_clock_KQ)
ks_kappa = GV%ke+1 ; ke_kappa = 0
@@ -861,13 +1133,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
! call cpu_clock_begin(id_clock_project)
call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, &
dz, I_dz_int, dbuoy_dT, dbuoy_dS, &
- u_test, v_test, T_test, S_test, N2=N2, S2=S2, &
+ u_test, v_test, T_test, S_test, GV, N2=N2, S2=S2, &
ks_int = ks_kappa, ke_int = ke_kappa)
! call cpu_clock_end(id_clock_project)
! call cpu_clock_begin(id_clock_KQ)
call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, &
- nzc, CS, K_Q, tke_pred, kappa_pred)
+ nzc, CS, GV, K_Q, tke_pred, kappa_pred)
! call cpu_clock_end(id_clock_KQ)
! call cpu_clock_begin(id_clock_avg)
@@ -886,7 +1158,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
! call cpu_clock_begin(id_clock_project)
call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, &
dz, I_dz_int, dbuoy_dT, dbuoy_dS, &
- u, v, T, Sal, N2, S2)
+ u, v, T, Sal, GV, N2, S2)
! call cpu_clock_end(id_clock_project)
endif
@@ -920,7 +1192,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
Ri_k(K) = 1e3 ; if (N2(K) < 1e3 * S2(K)) Ri_k(K) = N2(K) / S2(K)
dtke(K) = tke_pred(K) - tke(K)
dtke_norm(K) = dtke(K) / (0.5*(tke(K) + tke_pred(K)))
- dkappa(K) = kappa_pred(K) - kappa_out(K)
+ dkap(K) = kappa_pred(K) - kappa_out(K)
enddo
if (itt <= max_debug_itt) then
do k=1,nzc
@@ -937,7 +1209,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
if (abs(dkappa_it1(K,itt-1)) > 1e-20) &
d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1)
endif
- dkappa_norm(K,itt) = dkappa(K) / max(0.5*(Kappa_pred(K) + kappa_out(K)), 1e-100)
+ dkappa_norm(K,itt) = dkap(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), GV%m_to_Z**2*1e-100)
enddo
endif
#endif
@@ -948,32 +1220,33 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
end subroutine kappa_shear_column
-subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, &
- dz, I_dz_int, dbuoy_dT, dbuoy_dS, &
- u, v, T, Sal, N2, S2, ks_int, ke_int)
-!< This subroutine calculates the velocities, temperature and salinity that
+!> This subroutine calculates the velocities, temperature and salinity that
!! the water column will have after mixing for dt with diffusivities kappa. It
!! may also calculate the projected buoyancy frequency and shear.
+subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, &
+ dz, I_dz_int, dbuoy_dT, dbuoy_dS, &
+ u, v, T, Sal, GV, N2, S2, ks_int, ke_int)
integer, intent(in) :: nz !< The number of layers (after eliminating massless
!! layers?).
real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces,
- !! in m2 s-1.
+ !! in Z2 s-1.
real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity, in m s-1.
real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity, in m s-1.
real, dimension(nz), intent(in) :: T0 !< The initial temperature, in C.
real, dimension(nz), intent(in) :: S0 !< The initial salinity, in PSU.
- real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in m.
+ real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in Z.
real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses,
- !! in m-1.
+ !! in Z-1.
real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with
- !! temperature, in m s-2 C-1.
+ !! temperature, in Z s-2 C-1.
real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with
- !! salinity, in m s-2 PSU-1.
+ !! salinity, in Z s-2 PSU-1.
real, intent(in) :: dt !< The time step in s.
real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt, in m s-1.
real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt, in m s-1.
real, dimension(nz), intent(inout) :: T !< The temperature after dt, in C.
real, dimension(nz), intent(inout) :: Sal !< The salinity after dt, in PSU.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(nz+1), optional, &
intent(inout) :: N2 !< The buoyancy frequency squared at interfaces,
!! in s-2.
@@ -983,32 +1256,10 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, &
integer, optional, intent(in) :: ke_int !< The bottommost k-index with a non-zero
!! diffusivity.
- ! Arguments: kappa - The diapycnal diffusivity at interfaces, in m2 s-1.
- ! (in) Sh - The shear at interfaces, in s-1.
- ! (in) u0 - The initial zonal velocity, in m s-1.
- ! (in) v0 - The initial meridional velocity, in m s-1.
- ! (in) T0 - The initial temperature, in C.
- ! (in) S0 - The initial salinity, in PSU.
- ! (in) nz - The number of layers (after eliminating massless layers?).
- ! (in) dz - The grid spacing of layers, in m.
- ! (in) I_dz_int - The inverse of the layer's thicknesses, in m-1.
- ! (in) dbuoy_dT - The partial derivative of buoyancy with temperature,
- ! in m s-2 C-1.
- ! (in) dbuoy_dS - The partial derivative of buoyancy with salinity,
- ! in m s-2 PSU-1.
- ! (in) dt - The time step in s.
- ! (in) nz - The number of layers to work on.
- ! (out) u - The zonal velocity after dt, in m s-1.
- ! (out) v - The meridional velocity after dt, in m s-1.
- ! (in) T - The temperature after dt, in C.
- ! (in) Sal - The salinity after dt, in PSU.
- ! (out) N2 - The buoyancy frequency squared at interfaces, in s-2.
- ! (out) S2 - The squared shear at interfaces, in s-2.
- ! (in,opt) ks_int - The topmost k-index with a non-zero diffusivity.
- ! (in,opt) ke_int - The bottommost k-index with a non-zero diffusivity.
-
- ! UNCOMMENT THE FOLLOWING IF NOT CONTAINED IN THE OUTER SUBROUTINE.
+ ! Local variables
real, dimension(nz+1) :: c1
+ real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth
+ ! units squared, in Z2 m-2.
real :: a_a, a_b, b1, d1, bd1, b1nz_0
integer :: k, ks, ke
@@ -1071,14 +1322,15 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, &
endif
if (present(S2)) then
+ L2_to_Z2 = GV%m_to_Z**2
S2(1) = 0.0 ; S2(nz+1) = 0.0
if (ks > 1) &
- S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * I_dz_int(ks)**2
+ S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * L2_to_Z2*I_dz_int(ks)**2
do K=ks+1,ke
- S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * I_dz_int(K)**2
+ S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * L2_to_Z2*I_dz_int(K)**2
enddo
if (ke This subroutine calculates new, consistent estimates of TKE and kappa.
subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
- nz, CS, K_Q, tke, kappa, kappa_src, local_src)
+ nz, CS, GV, K_Q, tke, kappa, kappa_src, local_src)
integer, intent(in) :: nz !< The number of layers to work on.
real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces,
!! in s-2.
real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces, in s-2.
real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity,
- !! in m2 s-1.
- real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces,
- !! in m.
+ !! in Z2 s-1.
+ real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces,
+ !! in Z-1.
real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to
!! boundaries, m2.
- real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in m-1.
+ real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in Z-1.
real, intent(in) :: f2 !< The squared Coriolis parameter, in s-2.
type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by
!! the turbulent kinetic energy per unit mass at
!! interfaces, in s.
real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at
!! interfaces, in units of m2 s-2.
- real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces,
- !! in m2 s-1.
+ real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces,
+ !! in Z2 s-1.
real, dimension(nz+1), optional, &
intent(out) :: kappa_src !< The source term for kappa, in s-1.
real, dimension(nz+1), optional, &
@@ -1127,39 +1380,22 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
!! in s-1.
! This subroutine calculates new, consistent estimates of TKE and kappa.
-! Arguments: N2 - The buoyancy frequency squared at interfaces, in s-2.
-! (in) S2 - The squared shear at interfaces, in s-2.
-! (in) kappa_in - The initial guess at the diffusivity, in m2 s-1.
-! (in) Idz - The inverse grid spacing of layers, in m-1.
-! (in) dz_Int - The thicknesses associated with interfaces, in m.
-! (in) I_L2_bdry - The inverse of the squared distance to boundaries, m2.
-! (in) f2 - The squared Coriolis parameter, in s-2.
-! (in) nz - The number of layers to work on.
-! (in) CS - A pointer to this module's control structure.
-! (inout) K_Q - The shear-driven diapycnal diffusivity divided by the
-! turbulent kinetic energy per unit mass at interfaces, in s.
-! (out) tke - The turbulent kinetic energy per unit mass at interfaces,
-! in units of m2 s-2.
-! (out) kappa - The diapycnal diffusivity at interfaces, in m2 s-1.
-! (out,opt) kappa_src - The source term for kappa, in s-1.
-! (out,opt) local_src - The sum of all local sources for kappa, in s-1.
-
-! UNCOMMENT THE FOLLOWING IF NOT CONTAINED IN Calculate_kappa_shear
+ ! Local variables
real, dimension(nz) :: &
aQ, & ! aQ is the coupling between adjacent interfaces in the TKE
! equations, in m s-1.
dQdz ! Half the partial derivative of TKE with depth, m s-2.
real, dimension(nz+1) :: &
- dK, & ! The change in kappa, in m2 s-1.
- dQ, & ! The change in TKE, in m2 s-1.
+ dK, & ! The change in kappa, in Z2 s-1.
+ dQ, & ! The change in TKE, in m2 s-2.
cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and
! hexadiagonal solvers for the TKE and kappa equations, ND.
I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale
- ! for kappa, in units of m-2.
+ ! for kappa, in units of Z-2.
TKE_decay, & ! The local TKE decay rate in s-1.
k_src, & ! The source term in the kappa equation, in s-1.
- dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k), s.
- dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k), s-1.
+ dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k), m2 s Z-2.
+ dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k), Z2 m-2 s-1.
e1 ! The fractional change in a layer TKE due to a change in the
! TKE of the layer above when all the kappas below are 0.
! e1 is nondimensional, and 0 < e1 < 1.
@@ -1167,7 +1403,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
! and stratification, in m2 s-3. (For convenience,
! a term involving the non-dissipation of q0 is also
! included here.)
- real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations.
+ real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations, in Z-1.
real :: bd1 ! A term in the denominator of bQ or bK.
real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations.
real :: c_s2 ! The coefficient for the decay of TKE due to
@@ -1180,21 +1416,26 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
real :: Ilambda2 ! 1.0 / CS%lambda**2.
real :: TKE_min ! The minimum value of shear-driven TKE that can be
! solved for, in m2 s-2.
- real :: kappa0 ! The background diapycnal diffusivity, in m2 s-1.
+ real :: kappa0 ! The background diapycnal diffusivity, in Z2 s-1.
real :: max_err ! The maximum value of norm_err in a column, nondim.
- real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, m2 s-1.
+ real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, Z2 s-1.
real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1.
real :: diffusive_src ! The diffusive source in the kappa equation, in m s-1.
real :: chg_by_k0 ! The value of k_src that leads to an increase of
! kappa_0 if only the diffusive term is a sink, in s-1.
- real :: kappa_mean ! A mean value of kappa, in m2 s-1.
+ real :: kappa_mean ! A mean value of kappa, in Z2 s-1.
real :: Newton_test ! The value of relative error that will cause the next
! iteration to use Newton's method.
! Temporary variables used in the Newton's method iterations.
- real :: decay_term, I_Q, kap_src, v1, v2
-
+ real :: decay_term_k ! The decay term in the diffusivity equation
+ real :: decay_term_Q ! The decay term in the TKE equation
+ real :: I_Q ! The inverse of TKE, in s2 m-2
+ real :: kap_src
+ real :: v1, v2
+ real :: Z2_to_L2 ! A conversion factor from vertical depth units to horizontal length
+ ! units squared, in m2 Z-2.
real :: tol_err ! The tolerance for max_err that determines when to
! stop iterating.
real :: Newton_err ! The tolerance for max_err that determines when to
@@ -1219,7 +1460,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
integer :: max_debug_itt ; parameter(max_debug_itt=20)
real :: K_err_lin, Q_err_lin
real, dimension(nz+1) :: &
- kappa_prev, & ! The value of kappa at the start of the current iteration, in m2 s-1.
+ kappa_prev, & ! The value of kappa at the start of the current iteration, in Z2 s-1.
TKE_prev ! The value of TKE at the start of the current iteration, in m2 s-2.
real, dimension(nz+1,1:max_debug_itt) :: &
tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration.
@@ -1234,6 +1475,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 ; TKE_min = max(CS%TKE_bg,1.0E-20)
Ri_crit = CS%Rino_crit
Ilambda2 = 1.0 / CS%lambda**2
+ Z2_to_L2 = GV%Z_to_m**2
kappa_trunc = 0.01*kappa0 ! ### CHANGE THIS HARD-WIRING LATER?
do_Newton = .false. ; abort_Newton = .false.
tol_err = CS%kappa_tol_err
@@ -1317,13 +1559,13 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
! terms.
ke_tke = max(ke_kappa,ke_kappa_prev)+1
- ! aQ is the coupling between adjacent interfaces in m s-1.
+ ! aQ is the coupling between adjacent interfaces in Z s-1.
do k=1,min(ke_tke,nz)
- aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k)
+ aQ(k) = (0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k)
enddo
dQ(1) = -TKE(1)
if (tke_noflux_top_BC) then
- tke_src = kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0
+ tke_src = Z2_to_L2*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0
bd1 = dz_Int(1) * TKE_decay(1)
bQ = 1.0 / (bd1 + aQ(1))
tke(1) = bQ * (dz_Int(1)*tke_src)
@@ -1333,8 +1575,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
endif
do K=2,ke_tke-1
dQ(K) = -TKE(K)
- tke_src = (kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K)
- bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*K_Q(K)) + cQcomp*aQ(k-1)
+ tke_src = Z2_to_L2*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K)
+ bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*K_Q(K)) + cQcomp*aQ(k-1)
bQ = 1.0 / (bd1 + aQ(k))
tke(K) = bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1))
cQ(K+1) = aQ(k) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ
@@ -1344,7 +1586,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
dQ(nz+1) = 0.0
else
k = ke_tke
- tke_src = kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0
+ tke_src = Z2_to_L2*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0
if (K == nz+1) then
dQ(K) = -TKE(K)
bQ = 1.0 / (dz_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1))
@@ -1387,12 +1629,12 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
dK(1) = 0.0 ! kappa takes boundary values of 0.
cK(2) = 0.0 ; cKcomp = 1.0
if (itt == 1) then ; dO K=2,nz
- I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K)
+ I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K)
enddo ; endif
do K=2,nz
dK(K) = -kappa(K)
if (itt>1) &
- I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K)
+ I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K)
bd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1)
bK = 1.0 / (bd1 + Idz(k))
@@ -1436,7 +1678,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
aQ(1) = (0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1)
dQdz(1) = 0.5*(TKE(1) - TKE(2))*Idz(1)
if (tke_noflux_top_BC) then
- tke_src = dz_Int(1) * (kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - &
+ tke_src = dz_Int(1) * (Z2_to_L2*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - &
aQ(1) * (TKE(1) - TKE(2))
bQ = 1.0 / (aQ(1) + dz_Int(1)*TKE_decay(1))
@@ -1449,21 +1691,21 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
endif
do K=2,nz
I_Q = 1.0 / TKE(K)
- I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K)
+ I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K)
kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa(K)) + &
- Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1))
+ Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1))
! Ensure that the pivot is always positive, and that 0 <= cK <= 1.
! Otherwise do not use Newton's method.
- decay_term = -Idz(k-1)*dQmdK(K)*dKdQ(K-1) + dz_Int(K)*I_Ld2(K)
- if (decay_term < 0.0) then ; abort_Newton = .true. ; exit ; endif
- bK = 1.0 / (Idz(k) + Idz(k-1)*cKcomp + decay_term)
+ decay_term_k = -Idz(k-1)*dQmdK(K)*dKdQ(K-1) + dz_Int(K)*I_Ld2(K)
+ if (decay_term_k < 0.0) then ; abort_Newton = .true. ; exit ; endif
+ bK = 1.0 / (Idz(k) + Idz(k-1)*cKcomp + decay_term_k)
cK(K+1) = bK * Idz(k)
- cKcomp = bK * (Idz(k-1)*cKcomp + decay_term) ! = 1-cK(K+1)
+ cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1)
dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + &
- (N2(K)*Ilambda2 + f2)*I_Q**2*kappa(K))
+ GV%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) )
dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1))
! Truncate away negligibly small values of kappa.
@@ -1477,21 +1719,21 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
! Solve for dQ(K)...
aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k)
dQdz(k) = 0.5*(TKE(K) - TKE(K+1))*Idz(k)
- tke_src = dz_Int(K) * ((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k) - &
- (TKE(k) - q0)*TKE_decay(k)) - &
+ tke_src = dz_Int(K) * (Z2_to_L2*((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k)) - &
+ (TKE(k) - q0)*TKE_decay(k)) - &
(aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K)))
v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1)
v2 = (v1*dQmdK(K) + dQdz(k-1)*cK(K)) + &
- ((dQdz(k-1) - dQdz(k)) + dz_Int(K)*(S2(K) - N2(K)))
+ ((dQdz(k-1) - dQdz(k)) + Z2_to_L2*dz_Int(K)*(S2(K) - N2(K)))
! Ensure that the pivot is always positive, and that 0 <= cQ <= 1.
! Otherwise do not use Newton's method.
- decay_term = dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K) - v2*dKdQ(K)
- if (decay_term < 0.0) then ; abort_Newton = .true. ; exit ; endif
- bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term))
+ decay_term_Q = dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K) - v2*dKdQ(K)
+ if (decay_term_Q < 0.0) then ; abort_Newton = .true. ; exit ; endif
+ bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q))
cQ(K+1) = aQ(k) * bQ
- cQcomp = (cQcomp*aQ(k-1) + decay_term) * bQ
+ cQcomp = (cQcomp*aQ(k-1) + decay_term_Q) * bQ
dQmdK(K+1) = (v2 * cK(K+1) - dQdz(k)) * bQ
! Ensure that TKE+dQ will not drop below 0.5*TKE.
@@ -1509,15 +1751,15 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
dK(nz+1) = 0.0 ; dKdQ(nz+1) = 0.0
if (tke_noflux_bottom_BC) then
K = nz+1
- tke_src = dz_Int(K) * (kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + &
+ tke_src = dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + &
aQ(k-1) * (TKE(K-1) - TKE(K))
v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1)
- decay_term = max(0.0, dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K))
- if (decay_term < 0.0) then
+ decay_term_Q = max(0.0, dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K))
+ if (decay_term_Q < 0.0) then
abort_Newton = .true.
else
- bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term))
+ bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q))
! Ensure that TKE+dQ will not drop below 0.5*TKE.
dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(K-1)) + tke_src), &
-0.5*TKE(K))
@@ -1535,10 +1777,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
if (K < nz+1) then
! Ignore this source?
aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k)
- tke_src = (dz_Int(K) * (kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - &
- (aQ(k) * (TKE(K) - TKE(K+1)) - &
- aQ(k-1) * (TKE(K-1) - TKE(K))) ) / &
- (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K)))
+ tke_src = (dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - &
+ (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / &
+ (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K)))
endif
#endif
dK(K) = 0.0
@@ -1579,7 +1820,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
endif
#ifdef DEBUG
- ! Check these solutions for consistency.
+ ! Check these solutions for consistency.
+ ! The unit conversions here have not been carefully tested.
do K=2,nz
! In these equations, K_err_lin and Q_err_lin should be at round-off levels
! compared with the dominant terms, perhaps, dz_Int*I_Ld2*kappa and
@@ -1587,23 +1829,23 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
! been increased to ensure a positive pivot, or 2) negative TKEs have been
! truncated, or 3) small or negative kappas have been rounded toward 0.
I_Q = 1.0 / TKE(K)
- I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K)
+ I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K)
kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa_prev(K)) + &
- (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - &
- Idz(k)*(kappa_prev(k)-kappa_prev(k+1)))
- K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + &
+ (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - &
+ Idz(k)*(kappa_prev(k)-kappa_prev(k+1)))
+ K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + &
dz_Int(K)*I_Ld2(K)*dK(K) - kap_src - &
- (N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K)
+ GV%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K)
- tke_src = dz_Int(K) * ((kappa_prev(K) + kappa0)*S2(K) - &
- kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - &
+ tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - &
+ Z2_to_L2*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - &
(aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - &
aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K)))
Q_err_lin = (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - &
0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - &
0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + &
- dz_Int(K) * (dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src
+ dz_Int(K) * (Z2_to_L2*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src
enddo
#endif
endif ! End of the Newton's method solver.
@@ -1705,8 +1947,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
if (present(local_src)) then
local_src(1) = 0.0 ; local_src(nz+1) = 0.0
do K=2,nz
- diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + &
- Idz(k)*(kappa(K+1)-kappa(K))
+ diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + Idz(k)*(kappa(K+1)-kappa(K))
chg_by_k0 = kappa0 * ((Idz(k-1)+Idz(k)) / dz_Int(K) + I_Ld2(K))
if (diffusive_src <= 0.0) then
local_src(K) = k_src(K) + chg_by_k0
@@ -1724,8 +1965,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
end subroutine find_kappa_tke
-
-logical function kappa_shear_init(Time, G, GV, param_file, diag, CS)
+!> This subroutineinitializesthe parameters that regulate shear-driven mixing
+function kappa_shear_init(Time, G, GV, param_file, diag, CS)
type(time_type), intent(in) :: Time !< The current model time.
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -1735,20 +1976,16 @@ logical function kappa_shear_init(Time, G, GV, param_file, diag, CS)
!! output.
type(Kappa_shear_CS), pointer :: CS !< A pointer that is set to point to the control
!! structure for this module
-! Arguments: Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-! (returns) kappa_shear_init - True if module is to be used, False otherwise
+ logical :: kappa_shear_init !< True if module is to be used, False otherwise
+
+ ! Local variables
logical :: merge_mixedlayer
! This include declares and sets the variable "version".
#include "version_variable.h"
+ character(len=40) :: mdl = "MOM_kappa_shear" ! This module's name.
real :: KD_normal ! The KD of the main model, read here only as a parameter
! for setting the default of KD_SMOOTH
+
if (associated(CS)) then
call MOM_error(WARNING, "kappa_shear_init called with an associated "// &
"control structure.")
@@ -1771,6 +2008,10 @@ logical function kappa_shear_init(Time, G, GV, param_file, diag, CS)
call get_param(param_file, mdl, "USE_JACKSON_PARAM", kappa_shear_init, &
"If true, use the Jackson-Hallberg-Legg (JPO 2008) \n"//&
"shear mixing parameterization.", default=.false.)
+ call get_param(param_file, mdl, "VERTEX_SHEAR", CS%KS_at_vertex, &
+ "If true, do the calculations of the shear-driven mixing \n"//&
+ "at the cell vertices (i.e., the vorticity points).", &
+ default=.false.)
call get_param(param_file, mdl, "RINO_CRIT", CS%RiNo_crit, &
"The critical Richardson number for shear mixing.", &
units="nondim", default=0.25)
@@ -1786,7 +2027,8 @@ logical function kappa_shear_init(Time, G, GV, param_file, diag, CS)
call get_param(param_file, mdl, "KD_KAPPA_SHEAR_0", CS%kappa_0, &
"The background diffusivity that is used to smooth the \n"//&
"density and shear profiles before solving for the \n"//&
- "diffusivities. Defaults to value of KD.", units="m2 s-1", default=KD_normal)
+ "diffusivities. Defaults to value of KD.", &
+ units="m2 s-1", default=KD_normal, scale=GV%m_to_Z**2)
call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, &
"The nondimensional curvature of the function of the \n"//&
"Richardson number in the kappa source term in the \n"//&
@@ -1842,10 +2084,10 @@ logical function kappa_shear_init(Time, G, GV, param_file, diag, CS)
"be used in single-column mode!", &
default=.false., debuggingParam=.true.)
-! id_clock_KQ = cpu_clock_id('Ocean KS kappa_shear',grain=CLOCK_ROUTINE)
-! id_clock_avg = cpu_clock_id('Ocean KS avg',grain=CLOCK_ROUTINE)
-! id_clock_project = cpu_clock_id('Ocean KS project',grain=CLOCK_ROUTINE)
-! id_clock_setup = cpu_clock_id('Ocean KS setup',grain=CLOCK_ROUTINE)
+! id_clock_KQ = cpu_clock_id('Ocean KS kappa_shear', grain=CLOCK_ROUTINE)
+! id_clock_avg = cpu_clock_id('Ocean KS avg', grain=CLOCK_ROUTINE)
+! id_clock_project = cpu_clock_id('Ocean KS project', grain=CLOCK_ROUTINE)
+! id_clock_setup = cpu_clock_id('Ocean KS setup', grain=CLOCK_ROUTINE)
CS%nkml = 1
if (GV%nkml>0) then
@@ -1861,25 +2103,67 @@ logical function kappa_shear_init(Time, G, GV, param_file, diag, CS)
CS%diag => diag
CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear',diag%axesTi,Time, &
- 'Shear-driven Diapycnal Diffusivity', 'm2 s-1')
+ 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2)
CS%id_TKE = register_diag_field('ocean_model','TKE_shear',diag%axesTi,Time, &
'Shear-driven Turbulent Kinetic Energy', 'm2 s-2')
#ifdef ADD_DIAGNOSTICS
CS%id_ILd2 = register_diag_field('ocean_model','ILd2_shear',diag%axesTi,Time, &
- 'Inverse kappa decay scale at interfaces', 'm-2')
+ 'Inverse kappa decay scale at interfaces', 'm-2', conversion=GV%m_to_Z**2)
CS%id_dz_Int = register_diag_field('ocean_model','dz_Int_shear',diag%axesTi,Time, &
- 'Finite volume thickness of interfaces', 'm')
+ 'Finite volume thickness of interfaces', 'm', conversion=GV%Z_to_m)
#endif
end function kappa_shear_init
+!> This function indicates to other modules whether the Jackson et al shear mixing
+!! parameterization will be used without needing to duplicate the log entry.
logical function kappa_shear_is_used(param_file)
-! Reads the parameter "USE_JACKSON_PARAM" and returns state.
-! This function allows other modules to know whether this parameterization will
-! be used without needing to duplicate the log entry.
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+! Reads the parameter "USE_JACKSON_PARAM" and returns state.
+ character(len=40) :: mdl = "MOM_kappa_shear" ! This module's name.
+
call get_param(param_file, mdl, "USE_JACKSON_PARAM", kappa_shear_is_used, &
- default=.false., do_not_log = .true.)
+ default=.false., do_not_log=.true.)
end function kappa_shear_is_used
+!> This function indicates to other modules whether the Jackson et al shear mixing
+!! parameterization will be used without needing to duplicate the log entry.
+logical function kappa_shear_at_vertex(param_file)
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+! Reads the parameter "USE_JACKSON_PARAM" and returns state.
+ character(len=40) :: mdl = "MOM_kappa_shear" ! This module's name.
+
+ logical :: do_kappa_shear
+
+ call get_param(param_file, mdl, "USE_JACKSON_PARAM", do_kappa_shear, &
+ default=.false., do_not_log=.true.)
+ kappa_shear_at_vertex = .false.
+ if (do_Kappa_Shear) &
+ call get_param(param_file, mdl, "VERTEX_SHEAR", kappa_shear_at_vertex, &
+ "If true, do the calculations of the shear-driven mixing \n"//&
+ "at the cell vertices (i.e., the vorticity points).", &
+ default=.false., do_not_log=.true.)
+
+end function kappa_shear_at_vertex
+
+!> \namespace mom_kappa_shear
+!!
+!! By Laura Jackson and Robert Hallberg, 2006-2008
+!!
+!! This file contains the subroutines that determine the diapycnal
+!! diffusivity driven by resolved shears, as specified by the
+!! parameterizations described in Jackson and Hallberg (JPO, 2008).
+!!
+!! The technique by which the 6 equations (for kappa, TKE, u, v, T,
+!! and S) are solved simultaneously has been dramatically revised
+!! from the previous version. The previous version was not converging
+!! in some cases, especially near the surface mixed layer, while the
+!! revised version does. The revised version solves for kappa and
+!! TKE with shear and stratification fixed, then marches the density
+!! and velocities forward with an adaptive (and aggressive) time step
+!! in a predictor-corrector-corrector emulation of a trapezoidal
+!! scheme. Run-time-settable parameters determine the tolerence to
+!! which the kappa and TKE equations are solved and the minimum time
+!! step that can be taken.
+
end module MOM_kappa_shear
diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90
index ef6c160f9f..db90deeaca 100644
--- a/src/parameterizations/vertical/MOM_opacity.F90
+++ b/src/parameterizations/vertical/MOM_opacity.F90
@@ -1,43 +1,10 @@
+!> Routines used to calculate the opacity of the ocean.
module MOM_opacity
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* This module contains the routines used to calculate the opacity *
-!* of the ocean. *
-!* *
-!* CHL_from_file: *
-!* In this routine, the Morel (modified) and Manizza (modified) *
-!* schemes use the "blue" band in the paramterizations to determine *
-!* the e-folding depth of the incoming shortwave attenuation. The red *
-!* portion is lumped into the net heating at the surface. *
-!* *
-!* Morel, A., 1988: Optical modeling of the upper ocean in relation *
-!* to itsbiogenous matter content (case-i waters)., J. Geo. Res., *
-!* 93, 10,749-10,768. *
-!* *
-!* Manizza, M., C. LeQuere, A. J. Watson, and E. T. Buitenhuis, 2005: *
-!* Bio-optical feedbacks amoung phytoplankton, upper ocean physics *
-!* and sea-ice in a global model, Geophys. Res. Let., 32, L05603, *
-!* doi:10.1029/2004GL020778. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, buoy, Rml, eaml, ebml, etc. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_ptr, post_data
use MOM_diag_mediator, only : query_averaging_enabled, register_diag_field
-use MOM_time_manager, only : get_time
use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_string_functions, only : uppercase
@@ -55,50 +22,52 @@ module MOM_opacity
public set_opacity, opacity_init, opacity_end, opacity_manizza, opacity_morel
+!> The control structure with paramters for the MOM_opacity module
type, public :: opacity_CS ; private
- logical :: var_pen_sw ! If true, use one of the CHL_A schemes
- ! (specified below) to determine the e-folding
- ! depth of incoming short wave radiation.
- ! The default is false.
- integer :: opacity_scheme ! An integer indicating which scheme should be
- ! used to translate water properties into the
- ! opacity (i.e., the e-folding depth) and (perhaps)
- ! the number of bands of penetrating shortwave
- ! radiation to use.
- real :: pen_sw_scale ! The vertical absorption e-folding depth of the
- ! penetrating shortwave radiation, in m.
- real :: pen_sw_scale_2nd ! The vertical absorption e-folding depth of the
- ! (2nd) penetrating shortwave radiation, in m.
- real :: SW_1ST_EXP_RATIO ! Ratio for 1st exp decay in Two Exp decay opacity
- real :: pen_sw_frac ! The fraction of shortwave radiation that is
- ! penetrating with a constant e-folding approach.
- real :: blue_frac ! The fraction of the penetrating shortwave
- ! radiation that is in the blue band, ND.
- real :: opacity_land_value ! The value to use for opacity over land, in m-1.
- ! The default is 10 m-1 - a value for muddy water.
- integer :: sbc_chl ! An integer handle used in time interpolation of
- ! chlorophyll read from a file.
- logical :: chl_from_file ! If true, chl_a is read from a file.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
+ logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified below) to
+ !! determine the e-folding depth of incoming short wave radiation.
+ !! The default is false.
+ integer :: opacity_scheme !< An integer indicating which scheme should be used to translate
+ !! water properties into the opacity (i.e., the e-folding depth) and
+ !! (perhaps) the number of bands of penetrating shortwave radiation to use.
+ real :: pen_sw_scale !< The vertical absorption e-folding depth of the
+ !! penetrating shortwave radiation, in m.
+ real :: pen_sw_scale_2nd !< The vertical absorption e-folding depth of the
+ !! (2nd) penetrating shortwave radiation, in m.
+ real :: SW_1ST_EXP_RATIO !< Ratio for 1st exp decay in Two Exp decay opacity
+ real :: pen_sw_frac !< The fraction of shortwave radiation that is
+ !! penetrating with a constant e-folding approach.
+ real :: blue_frac !< The fraction of the penetrating shortwave
+ !! radiation that is in the blue band, ND.
+ real :: opacity_land_value !< The value to use for opacity over land, in m-1.
+ !! The default is 10 m-1 - a value for muddy water.
+ integer :: sbc_chl !< An integer handle used in time interpolation of
+ !! chlorophyll read from a file.
+ logical :: chl_from_file !< If true, chl_a is read from a file.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL()
- ! A pointer to the control structure of the tracer modules.
+ !< A pointer to the control structure of the tracer modules.
+ !>@{ Diagnostic IDs
integer :: id_sw_pen = -1, id_sw_vis_pen = -1, id_chl = -1
integer, pointer :: id_opacity(:) => NULL()
+ !!@}
end type opacity_CS
-integer, parameter :: NO_SCHEME = 0, MANIZZA_05 = 1, MOREL_88 = 2, &
- SINGLE_EXP = 3, DOUBLE_EXP = 4
+!>@{ Coded integers to specify the opacity scheme
+integer, parameter :: NO_SCHEME = 0, MANIZZA_05 = 1, MOREL_88 = 2, SINGLE_EXP = 3, DOUBLE_EXP = 4
+!!@}
-character*(10), parameter :: MANIZZA_05_STRING = "MANIZZA_05"
-character*(10), parameter :: MOREL_88_STRING = "MOREL_88"
-character*(10), parameter :: SINGLE_EXP_STRING = "SINGLE_EXP"
-character*(10), parameter :: DOUBLE_EXP_STRING = "DOUBLE_EXP"
+character*(10), parameter :: MANIZZA_05_STRING = "MANIZZA_05" !< String to specify the opacity scheme
+character*(10), parameter :: MOREL_88_STRING = "MOREL_88" !< String to specify the opacity scheme
+character*(10), parameter :: SINGLE_EXP_STRING = "SINGLE_EXP" !< String to specify the opacity scheme
+character*(10), parameter :: DOUBLE_EXP_STRING = "DOUBLE_EXP" !< String to specify the opacity scheme
contains
+!> This sets the opacity of sea water based based on one of several different schemes.
subroutine set_opacity(optics, fluxes, G, GV, CS)
type(optics_type), intent(inout) :: optics !< An optics structure that has values
!! set based on the opacities.
@@ -146,14 +115,14 @@ subroutine set_opacity(optics, fluxes, G, GV, CS)
else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif
! Make sure there is no division by 0.
- inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_z, &
+ inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_m, &
GV%H_to_m*GV%H_subroundoff)
if ( CS%Opacity_scheme == DOUBLE_EXP ) then
!$OMP parallel do default(shared)
do k=1,nz ; do j=js,je ; do i=is,ie
optics%opacity_band(1,i,j,k) = inv_sw_pen_scale
optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, &
- 0.1*GV%Angstrom_z,GV%H_to_m*GV%H_subroundoff)
+ 0.1*GV%Angstrom_m,GV%H_to_m*GV%H_subroundoff)
enddo ; enddo ; enddo
if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then
!$OMP parallel do default(shared)
@@ -227,6 +196,8 @@ subroutine set_opacity(optics, fluxes, G, GV, CS)
end subroutine set_opacity
+!> This sets the "blue" band opacity based on chloophyll A concencentrations
+!! The red portion is lumped into the net heating at the surface.
subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in)
type(optics_type), intent(inout) :: optics !< An optics structure that has values
!! set based on the opacities.
@@ -253,14 +224,13 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in)
! radiation, in W m-2.
type(time_type) :: day
character(len=128) :: mesg
- integer :: days, seconds
integer :: i, j, k, n, is, ie, js, je, nz, nbands
logical :: multiband_vis_input, multiband_nir_input
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
! In this model, the Morel (modified) and Manizza (modified) schemes
-! use the "blue" band in the paramterizations to determine the e-folding
+! use the "blue" band in the parameterizations to determine the e-folding
! depth of the incoming shortwave attenuation. The red portion is lumped
! into the net heating at the surface.
!
@@ -299,7 +269,6 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in)
else
! Only the 2-d surface chlorophyll can be read in from a file. The
! same value is assumed for all layers.
- call get_time(CS%Time,seconds,days)
call time_interp_external(CS%sbc_chl, CS%Time, chl_data)
do j=js,je ; do i=is,ie
if ((G%mask2dT(i,j) > 0.5) .and. (chl_data(i,j) < 0.0)) then
@@ -413,8 +382,10 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in)
end subroutine opacity_from_chl
+!> This sets the blue-wavelength opacity according to the scheme proposed by
+!! Morel and Antoine (1994).
function opacity_morel(chl_data)
- real, intent(in) :: chl_data
+ real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3.
real :: opacity_morel
! Argument : chl_data - The chlorophyll-A concentration in mg m-3.
! The following are coefficients for the optical model taken from Morel and
@@ -431,8 +402,10 @@ function opacity_morel(chl_data)
((Z2_coef(3) + Chl*Z2_coef(4)) + Chl2*(Z2_coef(5) + Chl*Z2_coef(6))) )
end function
+!> This sets the penetrating shortwave fraction according to the scheme proposed by
+!! Morel and Antoine (1994).
function SW_pen_frac_morel(chl_data)
- real, intent(in) :: chl_data
+ real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3.
real :: SW_pen_frac_morel
! Argument : chl_data - The chlorophyll-A concentration in mg m-3.
! The following are coefficients for the optical model taken from Morel and
@@ -449,8 +422,10 @@ function SW_pen_frac_morel(chl_data)
((V1_coef(3) + Chl*V1_coef(4)) + Chl2*(V1_coef(5) + Chl*V1_coef(6))) )
end function SW_pen_frac_morel
+!> This sets the blue-wavelength opacity according to the scheme proposed by
+!! Manizza, M. et al, 2005.
function opacity_manizza(chl_data)
- real, intent(in) :: chl_data
+ real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3.
real :: opacity_manizza
! Argument : chl_data - The chlorophyll-A concentration in mg m-3.
! This sets the blue-wavelength opacity according to the scheme proposed by
@@ -467,7 +442,8 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics)
type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic
!! output.
type(tracer_flow_control_CS), &
- target, intent(in) :: tracer_flow
+ target, intent(in) :: tracer_flow !< A pointer to the tracer flow control
+ !! module's control structure
type(opacity_CS), pointer :: CS !< A pointer that is set to point to the control
!! structure for this module.
type(optics_type), pointer :: optics !< An optics structure that has parameters
@@ -682,4 +658,21 @@ subroutine opacity_end(CS, optics)
end subroutine opacity_end
+!> \namespace mom_opacity
+!!
+!! CHL_from_file:
+!! In this routine, the Morel (modified) and Manizza (modified)
+!! schemes use the "blue" band in the paramterizations to determine
+!! the e-folding depth of the incoming shortwave attenuation. The red
+!! portion is lumped into the net heating at the surface.
+!!
+!! Morel, A., 1988: Optical modeling of the upper ocean in relation
+!! to itsbiogenous matter content (case-i waters)., J. Geo. Res.,
+!! 93, 10,749-10,768.
+!!
+!! Manizza, M., C. LeQuere, A. J. Watson, and E. T. Buitenhuis, 2005:
+!! Bio-optical feedbacks amoung phytoplankton, upper ocean physics
+!! and sea-ice in a global model, Geophys. Res. Let., 32, L05603,
+!! doi:10.1029/2004GL020778.
+
end module MOM_opacity
diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90
index a06c25b8f3..5bf74bf66c 100644
--- a/src/parameterizations/vertical/MOM_regularize_layers.F90
+++ b/src/parameterizations/vertical/MOM_regularize_layers.F90
@@ -1,36 +1,8 @@
+!> Provides regularization of layers in isopycnal mode
module MOM_regularize_layers
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg and Alistair Adcroft, 2011. *
-!* *
-!* This file contains the code to do vertical remapping of mass, *
-!* temperature and salinity in MOM. Other tracers and the horizontal *
-!* velocity components will be remapped outside of this subroutine *
-!* using the values that are stored in ea and eb. *
-!* The code that is here now only applies in very limited cases *
-!* where the mixed- and buffer-layer structures are problematic, but *
-!* future additions will include the ability to emulate arbitrary *
-!* vertical coordinates. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, T, S, ea, eb, etc. *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
use MOM_diag_mediator, only : time_type, diag_ctrl
@@ -49,34 +21,38 @@ module MOM_regularize_layers
public regularize_layers, regularize_layers_init
+!> This control structure holds parameters used by the MOM_regularize_layers module
type, public :: regularize_layers_CS ; private
- logical :: regularize_surface_layers ! If true, vertically restructure the
- ! near-surface layers when they have too much
- ! lateral variations to allow for sensible lateral
- ! barotropic transports.
- logical :: reg_sfc_detrain
- real :: h_def_tol1 ! The value of the relative thickness deficit at
- ! which to start modifying the structure, 0.5 by
- ! default (or a thickness ratio of 5.83).
- real :: h_def_tol2 ! The value of the relative thickness deficit at
- ! which to the structure modification is in full
- ! force, now 20% of the way from h_def_tol1 to 1.
- real :: h_def_tol3 ! The values of the relative thickness defitic at
- real :: h_def_tol4 ! which to start detrainment from the buffer layers
- ! to the interior, and at which to do this at full
- ! intensity. Now 30% and 50% of the way from
- ! h_def_tol1 to 1.
- real :: Hmix_min ! The minimum mixed layer thickness in m.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- logical :: debug ! If true, do more thorough checks for debugging purposes.
-
- integer :: id_def_rat = -1
- logical :: allow_clocks_in_omp_loops ! If true, clocks can be called
- ! from inside loops that can be threaded.
- ! To run with multiple threads, set to False.
+ logical :: regularize_surface_layers !< If true, vertically restructure the
+ !! near-surface layers when they have too much
+ !! lateral variations to allow for sensible lateral
+ !! barotropic transports.
+ logical :: reg_sfc_detrain !< If true, allow the buffer layers to detrain into the
+ !! interior as a part of the restructuring when
+ !! regularize_surface_layers is true
+ real :: h_def_tol1 !< The value of the relative thickness deficit at
+ !! which to start modifying the structure, 0.5 by
+ !! default (or a thickness ratio of 5.83).
+ real :: h_def_tol2 !< The value of the relative thickness deficit at
+ !! which to the structure modification is in full
+ !! force, now 20% of the way from h_def_tol1 to 1.
+ real :: h_def_tol3 !< The value of the relative thickness deficit at which to start
+ !! detrainment from the buffer layers to the interior, now 30% of
+ !! the way from h_def_tol1 to 1.
+ real :: h_def_tol4 !< The value of the relative thickness deficit at which to do
+ !! detrainment from the buffer layers to the interior at full
+ !! force, now 50% of the way from h_def_tol1 to 1.
+ real :: Hmix_min !< The minimum mixed layer thickness in H.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ logical :: debug !< If true, do more thorough checks for debugging purposes.
+
+ integer :: id_def_rat = -1 !< A diagnostic ID
+ logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that
+ !! can be threaded. To run with multiple threads, set to False.
#ifdef DEBUG_CODE
+ !>@{ Diagnostic IDs
integer :: id_def_rat_2 = -1, id_def_rat_3 = -1
integer :: id_def_rat_u = -1, id_def_rat_v = -1
integer :: id_e1 = -1, id_e2 = -1, id_e3 = -1
@@ -85,10 +61,14 @@ module MOM_regularize_layers
integer :: id_def_rat_v_2 = -1, id_def_rat_v_2b = -1
integer :: id_def_rat_u_3 = -1, id_def_rat_u_3b = -1
integer :: id_def_rat_v_3 = -1, id_def_rat_v_3b = -1
+ !!@}
#endif
end type regularize_layers_CS
+!>@{ Clock IDs
+!! \todo Should these be global?
integer :: id_clock_pass, id_clock_EOS
+!!@}
contains
@@ -115,26 +95,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS)
!! m or kg m-2 (i.e., H).
type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous
!! call to regularize_layers_init.
-
-! This subroutine partially steps the bulk mixed layer model.
-! The following processes are executed, in the order listed.
-
-! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out)
-! The units of h are referred to as H below.
-! (in/out) tv - A structure containing pointers to any available
-! thermodynamic fields. Absent fields have NULL ptrs.
-! (in) dt - Time increment, in s.
-! (in/out) ea - The amount of fluid moved downward into a layer; this should
-! be increased due to mixed layer detrainment, in the same units
-! as h - usually m or kg m-2 (i.e., H).
-! (in/out) eb - The amount of fluid moved upward into a layer; this should
-! be increased due to mixed layer entrainment, in the same units
-! as h - usually m or kg m-2 (i.e., H).
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! regularize_layers_init.
-
+ ! Local variables
integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
@@ -174,26 +135,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS)
!! m or kg m-2 (i.e., H).
type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous
!! call to regularize_layers_init.
-
-! This subroutine ensures that there is a degree of horizontal smoothness
-! in the depths of the near-surface interfaces.
-
-! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out)
-! The units of h are referred to as H below.
-! (in/out) tv - A structure containing pointers to any available
-! thermodynamic fields. Absent fields have NULL ptrs.
-! (in) dt - Time increment, in s.
-! (in/out) ea - The amount of fluid moved downward into a layer; this should
-! be increased due to mixed layer detrainment, in the same units
-! as h - usually m or kg m-2 (i.e., H).
-! (in/out) eb - The amount of fluid moved upward into a layer; this should
-! be increased due to mixed layer entrainment, in the same units
-! as h - usually m or kg m-2 (i.e., H).
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! regularize_layers_init.
-
+ ! Local variables
real, dimension(SZIB_(G),SZJ_(G)) :: &
def_rat_u ! The ratio of the thickness deficit to the minimum depth, ND.
real, dimension(SZI_(G),SZJB_(G)) :: &
@@ -395,20 +337,20 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS)
do K=1,nz_filt ; do i=is,ie ; if (do_i(i)) then
if (G%mask2dCu(I,j) <= 0.0) then ; e_e = e(i,j,K) ; else
e_e = max(e(i+1,j,K) + min(e(i,j,K) - e(i+1,j,nz+1), 0.0), &
- e(i,j,nz+1) + (nz+1-k)*GV%Angstrom)
+ e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H)
endif
if (G%mask2dCu(I-1,j) <= 0.0) then ; e_w = e(i,j,K) ; else
e_w = max(e(i-1,j,K) + min(e(i,j,K) - e(i-1,j,nz+1), 0.0), &
- e(i,j,nz+1) + (nz+1-k)*GV%Angstrom)
+ e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H)
endif
if (G%mask2dCv(i,J) <= 0.0) then ; e_n = e(i,j,K) ; else
e_n = max(e(i,j+1,K) + min(e(i,j,K) - e(i,j+1,nz+1), 0.0), &
- e(i,j,nz+1) + (nz+1-k)*GV%Angstrom)
+ e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H)
endif
if (G%mask2dCv(i,J-1) <= 0.0) then ; e_s = e(i,j,K) ; else
e_s = max(e(i,j-1,K) + min(e(i,j,K) - e(i,j-1,nz+1), 0.0), &
- e(i,j,nz+1) + (nz+1-k)*GV%Angstrom)
+ e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H)
endif
wt = max(0.0, min(1.0, I_dtol*(def_rat_h(i,j)-CS%h_def_tol1)))
@@ -444,10 +386,10 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS)
do k=nkmb+1,nz
cols_left = .false.
do i=is,ie ; if (more_ent_i(i)) then
- if (h_2d(i,k) - GV%Angstrom > h_neglect) then
- if (e_2d(i,nkmb+1)-e_filt(i,nkmb+1) > h_2d(i,k) - GV%Angstrom) then
- h_add = h_2d(i,k) - GV%Angstrom
- h_2d(i,k) = GV%Angstrom
+ if (h_2d(i,k) - GV%Angstrom_H > h_neglect) then
+ if (e_2d(i,nkmb+1)-e_filt(i,nkmb+1) > h_2d(i,k) - GV%Angstrom_H) then
+ h_add = h_2d(i,k) - GV%Angstrom_H
+ h_2d(i,k) = GV%Angstrom_H
else
h_add = e_2d(i,nkmb+1)-e_filt(i,nkmb+1)
h_2d(i,k) = h_2d(i,k) - h_add
@@ -702,7 +644,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS)
h_predicted = h_2d_init(i,k) + ((d_ea(i,k) - d_eb(i,k-1)) + &
(d_eb(i,k) - d_ea(i,k+1)))
endif
- if (abs(h(i,j,k) - h_predicted) > MAX(1e-9*abs(h_predicted),GV%Angstrom)) &
+ if (abs(h(i,j,k) - h_predicted) > MAX(1e-9*abs(h_predicted),GV%Angstrom_H)) &
call MOM_error(FATAL, "regularize_surface: d_ea mismatch.")
endif ; enddo ; enddo
do i=is,ie ; if (do_i(i)) then
@@ -808,25 +750,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, &
!! m-2); if h is not present, vertical
!! differences in interface heights are used
!! instead.
-
-! This subroutine determines the amount by which the harmonic mean
-! thickness at velocity points differ from the arithmetic means, relative to
-! the the arithmetic means, after eliminating thickness variations that are
-! solely due to topography and aggregating all interior layers into one.
-
-! Arguments: e - Interface depths, in m or kg m-2.
-! (out) def_rat_u - The thickness deficit ratio at u points, nondim.
-! (out) def_rat_v - The thickness deficit ratio at v points, nondim.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! regularize_layers_init.
-! (out,opt) def_rat_u_2lay - The thickness deficit ratio at u points when the
-! mixed and buffer layers are aggregated into 1 layer, nondim.
-! (out,opt) def_rat_v_2lay - The thickness deficit ratio at v pointswhen the
-! mixed and buffer layers are aggregated into 1 layer, nondim.
-! (in,opt) halo - An extra-wide halo size, 0 by default.
-! (in,opt) h - The layer thicknesse; if not present take vertical differences of e.
+ ! Local variables
real, dimension(SZIB_(G),SZJ_(G)) :: &
h_def_u, & ! The vertically summed thickness deficits at u-points, in H.
h_norm_u, & ! The vertically summed arithmetic mean thickness by which
@@ -849,7 +773,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, &
endif
nkmb = GV%nk_rho_varies
h_neglect = GV%H_subroundoff
- Hmix_min = CS%Hmix_min * GV%m_to_H
+ Hmix_min = CS%Hmix_min
! Determine which zonal faces are problematic.
do j=js,je ; do I=is-1,ie
@@ -951,23 +875,17 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, &
end subroutine find_deficit_ratios
-subroutine regularize_layers_init(Time, G, param_file, diag, CS)
+!> Initializes the regularize_layers control structure
+subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS)
type(time_type), target, intent(in) :: Time !< The current model time.
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(param_file_type), intent(in) :: param_file !< A structure to parse for
!! run-time parameters.
type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate
!! diagnostic output.
type(regularize_layers_CS), pointer :: CS !< A pointer that is set to point to the
!! control structure for this module.
-! Arguments: Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name.
logical :: use_temperature
@@ -999,7 +917,7 @@ subroutine regularize_layers_init(Time, G, param_file, diag, CS)
call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, &
"The minimum mixed layer depth if the mixed layer depth \n"//&
- "is determined dynamically.", units="m", default=0.0)
+ "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H)
call get_param(param_file, mdl, "REG_SFC_DEFICIT_TOLERANCE", CS%h_def_tol1, &
"The value of the relative thickness deficit at which \n"//&
"to start modifying the layer structure when \n"//&
diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90
index abdd27881b..e5e55ec590 100644
--- a/src/parameterizations/vertical/MOM_set_diffusivity.F90
+++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90
@@ -1,3 +1,4 @@
+!> Calculate vertical diffusivity from all mixing processes
module MOM_set_diffusivity
! This file is part of MOM6. See LICENSE.md for the license.
@@ -7,13 +8,14 @@ module MOM_set_diffusivity
use MOM_diag_mediator, only : diag_ctrl, time_type
use MOM_diag_mediator, only : post_data, register_diag_field
use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags
-use MOM_debugging, only : hchksum, uvchksum
+use MOM_debugging, only : hchksum, uvchksum, Bchksum
use MOM_EOS, only : calculate_density, calculate_density_derivs
use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE
use MOM_error_handler, only : callTree_showQuery
use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_forcing_type, only : forcing, optics_type
+use MOM_full_convection, only : full_convection
use MOM_grid, only : ocean_grid_type
use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss
use MOM_tidal_mixing, only : tidal_mixing_CS, calculate_tidal_mixing
@@ -21,6 +23,7 @@ module MOM_set_diffusivity
use MOM_intrinsic_functions, only : invcosh
use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data
use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS
+use MOM_kappa_shear, only : calc_kappa_shear_vertex, kappa_shear_at_vertex
use MOM_CVMix_shear, only : calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_cs
use MOM_CVMix_shear, only : CVMix_shear_end
use MOM_CVMix_ddiff, only : CVMix_ddiff_init, CVMix_ddiff_end, CVMix_ddiff_cs
@@ -34,7 +37,6 @@ module MOM_set_diffusivity
use user_change_diffusivity, only : user_change_diff, user_change_diff_init
use user_change_diffusivity, only : user_change_diff_end, user_change_diff_CS
-
implicit none ; private
#include
@@ -44,12 +46,12 @@ module MOM_set_diffusivity
public set_diffusivity_init
public set_diffusivity_end
+!> This control structure contains parameters for MOM_set_diffusivity.
type, public :: set_diffusivity_CS ; private
logical :: debug !< If true, write verbose checksums for debugging.
logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with
- !! GV%nk_rho_varies variable density mixed & buffer
- !! layers.
+ !! GV%nk_rho_varies variable density mixed & buffer layers.
real :: FluxRi_max !< The flux Richardson number where the stratification is
!! large enough that N2 > omega2. The full expression for
!! the Flux Richardson number is usually
@@ -66,27 +68,27 @@ module MOM_set_diffusivity
!! by bottom drag drives BBL diffusion (nondim)
real :: cdrag !< quadratic drag coefficient (nondim)
real :: IMax_decay !< inverse of a maximum decay scale for
- !! bottom-drag driven turbulence, (1/m)
- real :: Kv !< The interior vertical viscosity (m2/s)
- real :: Kd !< interior diapycnal diffusivity (m2/s)
- real :: Kd_min !< minimum diapycnal diffusivity (m2/s)
- real :: Kd_max !< maximum increment for diapycnal diffusivity (m2/s)
+ !! bottom-drag driven turbulence, (1/Z)
+ real :: Kv !< The interior vertical viscosity (Z2/s)
+ real :: Kd !< interior diapycnal diffusivity (Z2/s)
+ real :: Kd_min !< minimum diapycnal diffusivity (Z2/s)
+ real :: Kd_max !< maximum increment for diapycnal diffusivity (Z2/s)
!! Set to a negative value to have no limit.
real :: Kd_add !< uniform diffusivity added everywhere without
- !! filtering or scaling (m2/s)
- real :: Kdml !< mixed layer diapycnal diffusivity (m2/s)
+ !! filtering or scaling (Z2/s)
+ real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s)
!! when bulkmixedlayer==.false.
real :: Hmix !< mixed layer thickness (meter) when
!! bulkmixedlayer==.false.
- type(diag_ctrl), pointer :: diag ! structure to regulate diagn output timing
+ type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing
logical :: limit_dissipation !< If enabled, dissipation is limited to be larger
!! than the following:
- real :: dissip_min !< Minimum dissipation (W/m3)
- real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (W/m3)
- real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (J/m3)
- real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (W m-3 s2)
- real :: dissip_Kd_min !< Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2
+ real :: dissip_min !< Minimum dissipation (Z2 m-2 W m-3)
+ real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (Z2 m-2 W m-3)
+ real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (Z2 m-2 W m-3 s)
+ real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (Z2 m-2 W m-3 s2)
+ real :: dissip_Kd_min !< Minimum Kd (Z2/s) with dissipation Rho0*Kd_min*N^2
real :: TKE_itide_max !< maximum internal tide conversion (W m-2)
!! available to mix above the BBL
@@ -105,7 +107,7 @@ module MOM_set_diffusivity
!! where N2 is the squared buoyancy frequency (s-2) and OMEGA2
!! is the rotation rate of the earth squared.
real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence
- !! radiated from the base of the mixed layer (m2/s)
+ !! radiated from the base of the mixed layer (Z2/s)
real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth
real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to
!! obtain energy available for mixing below
@@ -117,7 +119,7 @@ module MOM_set_diffusivity
!! problems (m/s). If the value is small enough,
!! this parameter should not affect the solution.
real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale (nondim)
- real :: mstar !! ratio of friction velocity cubed to
+ real :: mstar !< ratio of friction velocity cubed to
!! TKE input to the mixed layer (nondim)
logical :: ML_use_omega !< If true, use absolute rotation rate instead
!! of the vertical component of rotation when
@@ -128,6 +130,8 @@ module MOM_set_diffusivity
logical :: user_change_diff !< If true, call user-defined code to change diffusivity.
logical :: useKappaShear !< If true, use the kappa_shear module to find the
!! shear-driven diapycnal diffusivity.
+ logical :: Vertex_Shear !< If true, do the calculations of the shear-driven mixing
+ !! at the cell vertices (i.e., the vorticity points).
logical :: use_CVMix_shear !< If true, use one of the CVMix modules to find
!! shear-driven diapycnal diffusivity.
logical :: double_diffusion !< If true, enable double-diffusive mixing using an old method.
@@ -138,56 +142,61 @@ module MOM_set_diffusivity
real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers (m2/s)
real :: Kv_molecular !< molecular visc for double diff convect (m2/s)
- character(len=200) :: inputdir
- type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL()
- type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL()
- type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL()
- type(CVMix_shear_cs), pointer :: CVMix_shear_csp => NULL()
- type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL()
- type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL()
- type(int_tide_CS), pointer :: int_tide_CSp => NULL()
- type(tidal_mixing_cs), pointer :: tm_csp => NULL()
-
+ character(len=200) :: inputdir !< The directory in which input files are found
+ type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() !< Control structure for a child module
+ type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() !< Control structure for a child module
+ type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() !< Control structure for a child module
+ type(CVMix_shear_cs), pointer :: CVMix_shear_csp => NULL() !< Control structure for a child module
+ type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() !< Control structure for a child module
+ type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() !< Control structure for a child module
+ type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module
+ type(tidal_mixing_cs), pointer :: tm_csp => NULL() !< Control structure for a child module
+
+ !>@{ Diagnostic IDs
integer :: id_maxTKE = -1, id_TKE_to_Kd = -1, id_Kd_user = -1
integer :: id_Kd_layer = -1, id_Kd_BBL = -1, id_Kd_BBL_z = -1
integer :: id_Kd_user_z = -1, id_N2 = -1, id_N2_z = -1
integer :: id_Kd_Work = -1, id_KT_extra = -1, id_KS_extra = -1
integer :: id_KT_extra_z = -1, id_KS_extra_z = -1
+ !!@}
end type set_diffusivity_CS
+!> This structure has memory for used in calculating diagnostics of diffusivity
type diffusivity_diags
real, pointer, dimension(:,:,:) :: &
- N2_3d => NULL(),& ! squared buoyancy frequency at interfaces (1/s2)
- Kd_user => NULL(),& ! user-added diffusivity at interfaces (m2/s)
- Kd_BBL => NULL(),& ! BBL diffusivity at interfaces (m2/s)
- Kd_work => NULL(),& ! layer integrated work by diapycnal mixing (W/m2)
- maxTKE => NULL(),& ! energy required to entrain to h_max (m3/s3)
- TKE_to_Kd => NULL(),& ! conversion rate (~1.0 / (G_Earth + dRho_lay))
- ! between TKE dissipated within a layer and Kd
- ! in that layer, in m2 s-1 / m3 s-3 = s2 m-1
- KT_extra => NULL(),& ! double diffusion diffusivity for temp (m2/s)
- KS_extra => NULL() ! double diffusion diffusivity for saln (m2/s)
+ N2_3d => NULL(),& !< squared buoyancy frequency at interfaces (1/s2)
+ Kd_user => NULL(),& !< user-added diffusivity at interfaces (m2/s)
+ Kd_BBL => NULL(),& !< BBL diffusivity at interfaces (m2/s)
+ Kd_work => NULL(),& !< layer integrated work by diapycnal mixing (W/m2)
+ maxTKE => NULL(),& !< energy required to entrain to h_max (m3/s3)
+ KT_extra => NULL(),& !< double diffusion diffusivity for temp (Z2/s)
+ KS_extra => NULL() !< double diffusion diffusivity for saln (Z2/s)
+ real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL()
+ !< conversion rate (~1.0 / (G_Earth + dRho_lay))
+ !! between TKE dissipated within a layer and Kd
+ !! in that layer, in Z2 s-1 / m3 s-3 = Z2 s2 m-3
end type diffusivity_diags
-! Clocks
+!>@{ CPU time clocks
integer :: id_clock_kappaShear, id_clock_CVMix_ddiff
+!!@}
contains
!> Sets the interior vertical diffusion of scalars due to the following processes:
-!! 1) Shear-driven mixing: two options, Jackson et at. and KPP interior;
-!! 2) Background mixing via CVMix (Bryan-Lewis profile) or the scheme described by
-!! Harrison & Hallberg, JPO 2008;
-!! 3) Double-diffusion, old method and new method via CVMix;
-!! 4) Tidal mixing: many options available, see MOM_tidal_mixing.F90;
+!! 1. Shear-driven mixing: two options, Jackson et at. and KPP interior;
+!! 2. Background mixing via CVMix (Bryan-Lewis profile) or the scheme described by
+!! Harrison & Hallberg, JPO 2008;
+!! 3. Double-diffusion, old method and new method via CVMix;
+!! 4. Tidal mixing: many options available, see MOM_tidal_mixing.F90;
!! In addition, this subroutine has the option to set the interior vertical
!! viscosity associated with processes 1,2 and 4 listed above, which is stored in
!! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via
!! visc%Kv_shear
subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
- G, GV, CS, Kd, Kd_int)
+ G, GV, CS, Kd_lay, Kd_int)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
@@ -197,24 +206,22 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- intent(in) :: u_h !< zonal thickness transport m^2/s.
+ intent(in) :: u_h !< Zonal velocity interpolated to h points, in m s-1.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- intent(in) :: v_h !< meridional thickness transport m^2/s.
+ intent(in) :: v_h !< Meridional velocity interpolated to h points, in m s-1.
type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic
!! fields. Out is for tv%TempxPmE.
- type(forcing), intent(in) :: fluxes !< Structure of surface fluxes that may be
- !! used.
- type(optics_type), pointer :: optics
- type(vertvisc_type), intent(inout) :: visc !< Structure containing vertical viscosities,
- !! bottom boundary layer properies, and related
- !! fields.
+ type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes
+ type(optics_type), pointer :: optics !< A structure describing the optical
+ !! properties of the ocean.
+ type(vertvisc_type), intent(inout) :: visc !< Structure containing vertical viscosities, bottom
+ !! boundary layer properies, and related fields.
real, intent(in) :: dt !< Time increment (sec).
type(set_diffusivity_CS), pointer :: CS !< Module control structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- intent(out) :: Kd !< Diapycnal diffusivity of each layer (m2/sec).
+ intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer (m2/sec).
real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), &
- optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface
- !! (m2/sec).
+ optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface (m2/sec).
! local variables
real, dimension(SZI_(G)) :: &
@@ -223,8 +230,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
type(diffusivity_diags) :: dd ! structure w/ arrays of pointers to avail diags
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
- T_f, S_f ! temperature and salinity (deg C and ppt)
+ T_f, S_f ! Temperature and salinity (in deg C and ppt) with
! massless layers filled vertically by diffusion.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
+ T_adj, S_adj ! Temperature and salinity (in deg C and ppt)
+ ! after full convective adjustment.
real, dimension(SZI_(G),SZK_(G)) :: &
N2_lay, & !< squared buoyancy frequency associated with layers (1/s2)
@@ -235,18 +245,18 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
real, dimension(SZI_(G),SZK_(G)+1) :: &
N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2)
- dRho_int, & !< locally ref potential density difference across interfaces (in s-2) smg: or kg/m3?
- KT_extra, & !< double difusion diffusivity on temperature (m2/sec)
- KS_extra ! double difusion diffusivity on salinity (m2/sec)
+ dRho_int, & !< locally ref potential density difference across interfaces (kg/m3)
+ KT_extra, & !< double difusion diffusivity of temperature (Z2/sec)
+ KS_extra !< double difusion diffusivity of salinity (Z2/sec)
real :: I_Rho0 ! inverse of Boussinesq density (m3/kg)
- real :: dissip ! local variable for dissipation calculations (W/m3)
+ real :: dissip ! local variable for dissipation calculations (Z2 W/m5)
real :: Omega2 ! squared absolute rotation rate (1/s2)
logical :: use_EOS ! If true, compute density from T/S using equation of state.
type(p3d) :: z_ptrs(6) ! pointers to diagns to be interpolated into depth space
integer :: kb(SZI_(G)) ! The index of the lightest layer denser than the
- ! buffer layer.
+ ! buffer layer, or -1 without a bulk mixed layer.
integer :: num_z_diags ! number of diagns to be interpolated to depth space
integer :: z_ids(6) ! id numbers of diagns to be interpolated to depth space
logical :: showCallTree ! If true, show the call tree.
@@ -266,8 +276,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
"Module must be initialized before it is used.")
I_Rho0 = 1.0/GV%Rho0
- kappa_fill = 1.e-3 ! m2 s-1
- dt_fill = 7200.
+ kappa_fill = 1.e-3*GV%m_to_Z**2 !### Dimensional constant in m2 s-1.
+ dt_fill = 7200. !### Dimensionalconstant in s.
Omega2 = CS%Omega*CS%Omega
use_EOS = associated(tv%eqn_of_state)
@@ -277,9 +287,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
call MOM_error(FATAL, "set_diffusivity: both visc%Kd_extra_T and "//&
"visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.")
- ! Set Kd, Kd_int and Kv_slow to constant values.
+ ! Set Kd_lay, Kd_int and Kv_slow to constant values.
! If nothing else is specified, this will be the value used.
- Kd(:,:,:) = CS%Kd
+ Kd_lay(:,:,:) = CS%Kd
Kd_int(:,:,:) = CS%Kd
if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv
@@ -334,42 +344,51 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
call hchksum(v_h, "before calc_KS v_h",G%HI)
endif
call cpu_clock_begin(id_clock_kappaShear)
- ! Changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????)
- ! Sets visc%Kv_shear
- call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, &
- visc%Kv_shear, dt, G, GV, CS%kappaShear_CSp)
- call cpu_clock_end(id_clock_kappaShear)
- if (CS%debug) then
- call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear",G%HI)
- call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear",G%HI)
- call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb",G%HI)
+ if (CS%Vertex_shear) then
+ call full_convection(G, GV, h, tv, T_adj, S_adj, fluxes%p_surf, &
+ GV%Z_to_H**2*kappa_fill*dt_fill, halo=1)
+
+ call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, &
+ visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, CS%kappaShear_CSp)
+ if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations
+ if (CS%debug) then
+ call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=GV%Z_to_m**2)
+ call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=GV%Z_to_m**2)
+ call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI)
+ endif
+ else
+ ! Changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????)
+ ! Sets visc%Kv_shear
+ call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, &
+ visc%Kv_shear, dt, G, GV, CS%kappaShear_CSp)
+ if (CS%debug) then
+ call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=GV%Z_to_m**2)
+ call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=GV%Z_to_m**2)
+ call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI)
+ endif
endif
+ call cpu_clock_end(id_clock_kappaShear)
if (showCallTree) call callTree_waypoint("done with calculate_kappa_shear (set_diffusivity)")
elseif (CS%use_CVMix_shear) then
!NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside.
- call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear,G,GV,CS%CVMix_shear_csp)
+ call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, CS%CVMix_shear_CSp)
if (CS%debug) then
- call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear",G%HI)
- call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear",G%HI)
+ call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=GV%Z_to_m**2)
+ call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=GV%Z_to_m**2)
endif
elseif (associated(visc%Kv_shear)) then
- visc%Kv_shear(:,:,:) = 0. ! needed if calculate_kappa_shear is not enabled
+ visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled
endif
- ! Calculate the diffusivity, Kd, for each layer. This would be
+ ! Calculate the diffusivity, Kd_lay, for each layer. This would be
! the appropriate place to add a depth-dependent parameterization or
! another explicit parameterization of Kd.
! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc)
- call sfc_bkgnd_mixing(G, CS%bkgnd_mixing_csp)
-
-!$OMP parallel do default(none) shared(is,ie,js,je,nz,G,GV,CS,h,tv,T_f,S_f,fluxes,dd, &
-!$OMP Kd,visc, &
-!$OMP Kd_int,dt,u,v,Omega2) &
-!$OMP private(dRho_int, &
-!$OMP N2_lay, N2_int, N2_bot, &
-!$OMP KT_extra, KS_extra, &
-!$OMP TKE_to_Kd,maxTKE,dissip,kb)
+ call sfc_bkgnd_mixing(G, GV, CS%bkgnd_mixing_csp)
+
+ !$OMP parallel do default(shared) private(dRho_int, N2_lay, N2_int, N2_bot, KT_extra, &
+ !$OMP KS_extra, TKE_to_Kd,maxTKE, dissip, kb)
do j=js,je
! Set up variables related to the stratification.
@@ -380,21 +399,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
endif
! Add background mixing
- call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp)
+ call calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp)
! Double-diffusion (old method)
if (CS%double_diffusion) then
call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra)
do K=2,nz ; do i=is,ie
if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering
- Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K)
- Kd(i,j,k) = Kd(i,j,k) + 0.5*KT_extra(i,K)
- visc%Kd_extra_S(i,j,k) = KS_extra(i,K)-KT_extra(i,K)
+ Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*KT_extra(i,K)
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*KT_extra(i,K)
+ visc%Kd_extra_S(i,j,k) = (KS_extra(i,K) - KT_extra(i,K))
visc%Kd_extra_T(i,j,k) = 0.0
elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection
- Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K)
- Kd(i,j,k) = Kd(i,j,k) + 0.5*KS_extra(i,K)
- visc%Kd_extra_T(i,j,k) = KT_extra(i,K)-KS_extra(i,K)
+ Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5**KS_extra(i,K)
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5**KS_extra(i,K)
+ visc%Kd_extra_T(i,j,k) = (KT_extra(i,K) - KS_extra(i,K))
visc%Kd_extra_S(i,j,k) = 0.0
else ! There is no double diffusion at this interface.
visc%Kd_extra_T(i,j,k) = 0.0
@@ -422,7 +441,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
if (CS%useKappaShear .or. CS%use_CVMix_shear) then
if (present(Kd_int)) then
do K=2,nz ; do i=is,ie
- Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k))
+ Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k))
enddo ; enddo
do i=is,ie
Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0.
@@ -430,15 +449,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
enddo
endif
do k=1,nz ; do i=is,ie
- Kd(i,j,k) = Kd(i,j,k) + 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1))
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1))
enddo ; enddo
else
if (present(Kd_int)) then
do i=is,ie
- Kd_int(i,j,1) = Kd(i,j,1) ; Kd_int(i,j,nz+1) = 0.0
+ Kd_int(i,j,1) = Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0
enddo
do K=2,nz ; do i=is,ie
- Kd_int(i,j,K) = 0.5*(Kd(i,j,k-1) + Kd(i,j,k))
+ Kd_int(i,j,K) = 0.5*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k))
enddo ; enddo
endif
endif
@@ -454,21 +473,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
! Add the ML_Rad diffusivity.
if (CS%ML_radiation) &
- call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int)
+ call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_int)
! Add the Nikurashin and / or tidal bottom-driven mixing
call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS%tm_csp, &
- N2_lay, N2_int, Kd, Kd_int, CS%Kd_max, visc%Kv_slow)
+ N2_lay, N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow)
! This adds the diffusion sustained by the energy extracted from the flow
! by the bottom drag.
if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then
if (CS%use_LOTW_BBL_diffusivity) then
call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, CS, &
- Kd, Kd_int, dd%Kd_BBL)
+ Kd_lay, Kd_int, dd%Kd_BBL)
else
call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
- maxTKE, kb, G, GV, CS, Kd, Kd_int, dd%Kd_BBL)
+ maxTKE, kb, G, GV, CS, Kd_lay, Kd_int, dd%Kd_BBL)
endif
endif
@@ -482,8 +501,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
dissip = max( CS%dissip_min, & ! Const. floor on dissip.
CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett
CS%dissip_N2 * N2_lay(i,k) ) ! Floor of Kd_min*rho0/F_Ri
- Kd(i,j,k) = max( Kd(i,j,k) , & ! Apply floor to Kd
- dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) )
+ Kd_lay(i,j,k) = max( Kd_lay(i,j,k) , & ! Apply floor to Kd
+ dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) )
enddo ; enddo
if (present(Kd_int)) then ; do K=2,nz ; do i=is,ie
@@ -496,61 +515,61 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett
CS%dissip_N2 * N2_int(i,K) ) ! Floor of Kd_min*rho0/F_Ri
Kd_int(i,j,K) = max( Kd_int(i,j,K) , & ! Apply floor to Kd
- dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) )
+ dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) )
enddo ; enddo ; endif
endif
if (associated(dd%Kd_work)) then
do k=1,nz ; do i=is,ie
- dd%Kd_Work(i,j,k) = GV%Rho0 * Kd(i,j,k) * N2_lay(i,k) * &
- GV%H_to_m*h(i,j,k) ! Watt m-2 s or kg s-3
+ dd%Kd_Work(i,j,k) = GV%Rho0 * GV%Z_to_m**3*Kd_lay(i,j,k) * N2_lay(i,k) * &
+ GV%H_to_Z*h(i,j,k) ! Watt m-2 s or kg s-3
enddo ; enddo
endif
enddo ! j-loop
if (CS%debug) then
- call hchksum(Kd ,"Kd",G%HI,haloshift=0)
+ call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2)
- if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0)
+ if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=GV%Z_to_m**2)
if (CS%use_CVMix_ddiff) then
- call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0)
- call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0)
+ call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=GV%Z_to_m**2)
+ call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=GV%Z_to_m**2)
endif
if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then
call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, &
- G%HI, 0, symmetric=.true.)
+ G%HI, 0, symmetric=.true., scale=GV%Z_to_m**2)
endif
if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then
call uvchksum("BBL bbl_thick_[uv]", visc%bbl_thick_u, &
- visc%bbl_thick_v, G%HI, 0, symmetric=.true.)
+ visc%bbl_thick_v, G%HI, 0, symmetric=.true., scale=GV%Z_to_m)
endif
if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then
- call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true.)
+ call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=GV%Z_to_m)
endif
endif
if (CS%Kd_add > 0.0) then
if (present(Kd_int)) then
-!$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd)
+ !$OMP parallel do default(shared)
do k=1,nz ; do j=js,je ; do i=is,ie
Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add
- Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add
enddo ; enddo ; enddo
else
-!$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,Kd)
+ !$OMP parallel do default(shared)
do k=1,nz ; do j=js,je ; do i=is,ie
- Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add
enddo ; enddo ; enddo
endif
endif
if (CS%user_change_diff) then
- call user_change_diff(h, tv, G, CS%user_change_diff_CSp, Kd, Kd_int, &
+ call user_change_diff(h, tv, G, GV, CS%user_change_diff_CSp, Kd_lay, Kd_int, &
T_f, S_f, dd%Kd_user)
endif
@@ -570,7 +589,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
if (CS%CVMix_ddiff_csp%id_R_rho > 0) &
call post_data(CS%CVMix_ddiff_csp%id_R_rho, CS%CVMix_ddiff_csp%R_rho, CS%CVMix_ddiff_csp%diag)
- if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag)
+ if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd_lay, CS%diag)
! tidal mixing
call post_tidal_diagnostics(G,GV,h,CS%tm_csp)
@@ -604,21 +623,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, dd%Kd_BBL, CS%diag)
if (CS%id_KT_extra_z > 0) then
- num_z_diags = num_z_diags + 1
- z_ids(num_z_diags) = CS%id_KT_extra_z
- z_ptrs(num_z_diags)%p => dd%KT_extra
+ num_z_diags = num_z_diags + 1
+ z_ids(num_z_diags) = CS%id_KT_extra_z
+ z_ptrs(num_z_diags)%p => dd%KT_extra
endif
if (CS%id_KS_extra_z > 0) then
- num_z_diags = num_z_diags + 1
- z_ids(num_z_diags) = CS%id_KS_extra_z
- z_ptrs(num_z_diags)%p => dd%KS_extra
+ num_z_diags = num_z_diags + 1
+ z_ids(num_z_diags) = CS%id_KS_extra_z
+ z_ptrs(num_z_diags)%p => dd%KS_extra
endif
if (CS%id_Kd_BBL_z > 0) then
- num_z_diags = num_z_diags + 1
- z_ids(num_z_diags) = CS%id_Kd_BBL_z
- z_ptrs(num_z_diags)%p => dd%KS_extra
+ num_z_diags = num_z_diags + 1
+ z_ids(num_z_diags) = CS%id_Kd_BBL_z
+ z_ptrs(num_z_diags)%p => dd%Kd_BBL
endif
if (num_z_diags > 0) &
@@ -637,20 +656,32 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, &
end subroutine set_diffusivity
+!> Convert turbulent kinetic energy to diffusivity
subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, &
TKE_to_Kd, maxTKE, kb)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(thermo_var_ptrs), intent(in) :: tv
- real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: dRho_int
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay
- integer, intent(in) :: j
- real, intent(in) :: dt
- type(set_diffusivity_CS), pointer :: CS
- real, dimension(SZI_(G),SZK_(G)), intent(out) :: TKE_to_Kd, maxTKE
- integer, dimension(SZI_(G)), intent(out) :: kb
-
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available
+ !! thermodynamic fields.
+ real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: dRho_int !< Change in locally referenced potential density
+ !! across each interface, in kg m-3.
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the
+ !! layers, in s-2.
+ integer, intent(in) :: j !< j-index of row to work on
+ real, intent(in) :: dt !< Time increment (sec).
+ type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure
+ real, dimension(SZI_(G),SZK_(G)), intent(out) :: TKE_to_Kd !< The conversion rate between the TKE
+ !! TKE dissipated within a layer and the
+ !! diapycnal diffusivity witin that layer,
+ !! usually (~Rho_0 / (G_Earth * dRho_lay)),
+ !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3
+ real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain
+ !! to its maximum realizable thickness, in m3 s-3
+ integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer
+ !! layer, or -1 without a bulk mixed layer.
+ ! Local variables
real, dimension(SZI_(G),SZK_(G)) :: &
ds_dsp1, & ! coordinate variable (sigma-2) difference across an
! interface divided by the difference across the interface
@@ -662,26 +693,26 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, &
maxEnt ! maxEnt is the maximum value of entrainment from below (with
! compensating entrainment from above to keep the layer
! density from changing) that will not deplete all of the
- ! layers above or below a layer within a timestep (meter)
+ ! layers above or below a layer within a timestep (Z)
real, dimension(SZI_(G)) :: &
htot, & ! total thickness above or below a layer, or the
- ! integrated thickness in the BBL (meter)
+ ! integrated thickness in the BBL (Z)
mFkb, & ! total thickness in the mixed and buffer layers
- ! times ds_dsp1 (meter)
+ ! times ds_dsp1 (Z)
p_ref, & ! array of tv%P_Ref pressures
Rcv_kmb, & ! coordinate density in the lowest buffer layer
p_0 ! An array of 0 pressures
real :: dh_max ! maximum amount of entrainment a layer could
! undergo before entraining all fluid in the layers
- ! above or below (meter)
+ ! above or below (Z)
real :: dRho_lay ! density change across a layer (kg/m3)
real :: Omega2 ! rotation rate squared (1/s2)
real :: G_Rho0 ! gravitation accel divided by Bouss ref density (m4 s-2 kg-1)
real :: I_Rho0 ! inverse of Boussinesq reference density (m3/kg)
real :: I_dt ! 1/dt (1/sec)
real :: H_neglect ! negligibly small thickness (units as h)
- real :: hN2pO2 ! h * (N^2 + Omega^2), in m s-2.
+ real :: hN2pO2 ! h * (N^2 + Omega^2), in m3 s-2 Z-2.
logical :: do_i(SZI_(G))
integer :: i, k, is, ie, nz, i_rem, kmb, kb_min
@@ -689,16 +720,16 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, &
I_dt = 1.0/dt
Omega2 = CS%Omega**2
- G_Rho0 = GV%g_Earth / GV%Rho0
+ G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0
H_neglect = GV%H_subroundoff
I_Rho0 = 1.0/GV%Rho0
! Simple but coordinate-independent estimate of Kd/TKE
if (CS%simple_TKE_to_Kd) then
do k=1,nz ; do i=is,ie
- hN2pO2 = ( GV%H_to_m * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m s-2.
+ hN2pO2 = GV%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2.
if (hN2pO2>0.) then
- TKE_to_Kd(i,k) = 1./ hN2pO2 ! Units of s2 m-1.
+ TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3.
else; TKE_to_Kd(i,k) = 0.; endif
! The maximum TKE conversion we allow is really a statement
! about the upper diffusivity we allow. Kd_max must be set.
@@ -730,7 +761,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, &
! in sigma-0.
do k=kb(i)-1,kmb+1,-1
if (rho_0(i,kmb) > rho_0(i,k)) exit
- if (h(i,j,k)>2.0*GV%Angstrom) kb(i) = k
+ if (h(i,j,k)>2.0*GV%Angstrom_H) kb(i) = k
enddo
enddo
@@ -751,32 +782,32 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, &
if (CS%bulkmixedlayer) then
kmb = GV%nk_rho_varies
do i=is,ie
- htot(i) = GV%H_to_m*h(i,j,kmb)
+ htot(i) = GV%H_to_Z*h(i,j,kmb)
mFkb(i) = 0.0
if (kb(i) < nz) &
- mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_m*(h(i,j,kmb) - GV%Angstrom))
+ mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_Z*(h(i,j,kmb) - GV%Angstrom_H))
enddo
do k=1,kmb-1 ; do i=is,ie
- htot(i) = htot(i) + GV%H_to_m*h(i,j,k)
- mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_m*(h(i,j,k) - GV%Angstrom))
+ htot(i) = htot(i) + GV%H_to_Z*h(i,j,k)
+ mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H))
enddo ; enddo
else
do i=is,i
- maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_m*(h(i,j,1) - GV%Angstrom)
+ maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_Z*(h(i,j,1) - GV%Angstrom_H)
enddo
endif
do k=kb_min,nz-1 ; do i=is,ie
if (k == kb(i)) then
- maxEnt(i,kb(i))= mFkb(i)
+ maxEnt(i,kb(i)) = mFkb(i)
elseif (k > kb(i)) then
maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i))
! maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) ! BITWISE CHG
- htot(i) = htot(i) + GV%H_to_m*(h(i,j,k) - GV%Angstrom)
+ htot(i) = htot(i) + GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H)
endif
enddo ; enddo
do i=is,ie
- htot(i) = GV%H_to_m*(h(i,j,nz) - GV%Angstrom) ; maxEnt(i,nz) = 0.0
+ htot(i) = GV%H_to_Z*(h(i,j,nz) - GV%Angstrom_H) ; maxEnt(i,nz) = 0.0
do_i(i) = (G%mask2dT(i,j) > 0.5)
enddo
do k=nz-1,kb_min,-1
@@ -785,7 +816,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, &
if (k Calculate Brunt-Vaisala frequency, N^2.
subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, &
N2_lay, N2_int, N2_bot)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(thermo_var_ptrs), intent(in) :: tv
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f, S_f
- type(forcing), intent(in) :: fluxes
- integer, intent(in) :: j
- type(set_diffusivity_CS), pointer :: CS
- real, dimension(SZI_(G),SZK_(G)+1), intent(out) :: dRho_int, N2_int
- real, dimension(SZI_(G),SZK_(G)), intent(out) :: N2_lay
- real, dimension(SZI_(G)), intent(out) :: N2_bot
-
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available
+ !! thermodynamic fields.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: T_f !< layer temp in C with the values in massless layers
+ !! filled vertically by diffusion.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: S_f !< Layer salinities in PPT with values in massless
+ !! layers filled vertically by diffusion.
+ type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes
+ integer, intent(in) :: j !< j-index of row to work on
+ type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure
+ real, dimension(SZI_(G),SZK_(G)+1), &
+ intent(out) :: dRho_int !< Change in locally referenced potential density
+ !! across each interface, in kg m-3.
+ real, dimension(SZI_(G),SZK_(G)+1), &
+ intent(out) :: N2_int !< The squared buoyancy frequency at the interfaces, in s-2.
+ real, dimension(SZI_(G),SZK_(G)), &
+ intent(out) :: N2_lay !< The squared buoyancy frequency of the layers, in s-2.
+ real, dimension(SZI_(G)), intent(out) :: N2_bot !< The near-bottom squared buoyancy frequency, in s-2.
+ ! Local variables
real, dimension(SZI_(G),SZK_(G)+1) :: &
dRho_int_unfilt, & ! unfiltered density differences across interfaces
dRho_dT, & ! partial derivative of density wrt temp (kg m-3 degC-1)
@@ -852,20 +896,21 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, &
Temp_int, & ! temperature at each interface (degC)
Salin_int, & ! salinity at each interface (PPT)
drho_bot, &
- h_amp, &
- hb, &
- z_from_bot
+ h_amp, & ! The topographic roughness amplitude, in Z.
+ hb, & ! The thickness of the bottom layer in Z
+ z_from_bot ! The hieght above the bottom in Z
real :: Rml_base ! density of the deepest variable density layer
- real :: dz_int ! thickness associated with an interface (meter)
- real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density (m4 s-2 kg-1)
+ real :: dz_int ! thickness associated with an interface (Z)
+ real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density
+ ! times some unit conversion factors, in (Z m3 s-2 kg-1)
real :: H_neglect ! negligibly small thickness, in the same units as h.
logical :: do_i(SZI_(G)), do_any
integer :: i, k, is, ie, nz
is = G%isc ; ie = G%iec ; nz = G%ke
- G_Rho0 = GV%g_Earth / GV%Rho0
+ G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0
H_neglect = GV%H_subroundoff
! Find the (limited) density jump across each interface.
@@ -903,18 +948,18 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, &
! Set the buoyancy frequencies.
do k=1,nz ; do i=is,ie
N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / &
- (GV%H_to_m*(h(i,j,k) + H_neglect))
+ (GV%H_to_Z*(h(i,j,k) + H_neglect))
enddo ; enddo
do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo
do K=2,nz ; do i=is,ie
N2_int(i,K) = G_Rho0 * dRho_int(i,K) / &
- (0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k) + H_neglect))
+ (0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k) + H_neglect))
enddo ; enddo
! Find the bottom boundary layer stratification, and use this in the deepest layers.
do i=is,ie
hb(i) = 0.0 ; dRho_bot(i) = 0.0
- z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz)
+ z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz)
do_i(i) = (G%mask2dT(i,j) > 0.5)
if ( (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation) .and. &
@@ -928,7 +973,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, &
do k=nz,2,-1
do_any = .false.
do i=is,ie ; if (do_i(i)) then
- dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1))
+ dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1))
z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above
hb(i) = hb(i) + dz_int
@@ -937,7 +982,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, &
if (z_from_bot(i) > h_amp(i)) then
if (k>2) then
! Always include at least one full layer.
- hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2))
+ hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2))
dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1)
endif
do_i(i) = .false.
@@ -952,14 +997,14 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, &
if (hb(i) > 0.0) then
N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i)
else ; N2_bot(i) = 0.0 ; endif
- z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz)
+ z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz)
do_i(i) = (G%mask2dT(i,j) > 0.5)
enddo
do k=nz,2,-1
do_any = .false.
do i=is,ie ; if (do_i(i)) then
- dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1))
+ dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1))
z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above
N2_int(i,K) = N2_bot(i)
@@ -994,8 +1039,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd)
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(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available
- !! thermodynamic fields; absent fields have NULL
- !! ptrs.
+ !! thermodynamic fields; absent fields have NULL ptrs.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
@@ -1008,10 +1052,10 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd)
type(set_diffusivity_CS), pointer :: CS !< Module control structure.
real, dimension(SZI_(G),SZK_(G)+1), &
intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal
- !! diffusivity for temp (m2/sec).
+ !! diffusivity for temp (Z2/sec).
real, dimension(SZI_(G),SZK_(G)+1), &
intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal
- !! diffusivity for saln (m2/sec).
+ !! diffusivity for saln (Z2/sec).
real, dimension(SZI_(G)) :: &
dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1)
@@ -1023,18 +1067,22 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd)
real :: alpha_dT ! density difference between layers due to temp diffs (kg/m3)
real :: beta_dS ! density difference between layers due to saln diffs (kg/m3)
- real :: Rrho ! vertical density ratio
- real :: diff_dd ! factor for double-diffusion
- real :: prandtl ! flux ratio for diffusive convection regime
+ real :: Rrho ! vertical density ratio
+ real :: diff_dd ! factor for double-diffusion (nondim)
+ real :: Kd_dd ! The dominant double diffusive diffusivity in Z2/sec
+ real :: prandtl ! flux ratio for diffusive convection regime
- real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio
- real, parameter :: dsfmax = 1.e-4 ! max diffusivity in case of salt fingering
- real, parameter :: Kv_molecular = 1.5e-6 ! molecular viscosity (m2/sec)
+ real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio
+ real :: dsfmax ! max diffusivity in case of salt fingering (Z2/sec)
+ real :: Kv_molecular ! molecular viscosity (Z2/sec)
integer :: i, k, is, ie, nz
is = G%isc ; ie = G%iec ; nz = G%ke
if (associated(tv%eqn_of_state)) then
+ dsfmax = GV%m_to_Z**2 * 1.e-4 ! max salt fingering diffusivity rescaled to (Z2/sec)
+ Kv_molecular = GV%m_to_Z**2 * 1.5e-6 ! molecular viscosity rescaled to (Z2/sec)
+
do i=is,ie
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
@@ -1053,18 +1101,18 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd)
beta_dS = dRho_dS(i) * (S_f(i,j,k-1) - S_f(i,j,k))
if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case
- Rrho = min(alpha_dT/beta_dS,Rrho0)
+ Rrho = min(alpha_dT / beta_dS, Rrho0)
diff_dd = 1.0 - ((RRho-1.0)/(RRho0-1.0))
- diff_dd = dsfmax*diff_dd*diff_dd*diff_dd
- Kd_T_dd(i,K) = 0.7*diff_dd
- Kd_S_dd(i,K) = diff_dd
+ Kd_dd = dsfmax * diff_dd*diff_dd*diff_dd
+ Kd_T_dd(i,K) = 0.7*Kd_dd
+ Kd_S_dd(i,K) = Kd_dd
elseif ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection
- Rrho = alpha_dT/beta_dS
- diff_dd = Kv_molecular*0.909*exp(4.6*exp(-0.54*(1/Rrho-1)))
+ Rrho = alpha_dT / beta_dS
+ Kd_dd = Kv_molecular * 0.909*exp(4.6*exp(-0.54*(1/Rrho-1)))
prandtl = 0.15*Rrho
if (Rrho > 0.5) prandtl = (1.85-0.85/Rrho)*Rrho
- Kd_T_dd(i,K) = diff_dd
- Kd_S_dd(i,K) = prandtl*diff_dd
+ Kd_T_dd(i,K) = Kd_dd
+ Kd_S_dd(i,K) = prandtl*Kd_dd
else
Kd_T_dd(i,K) = 0.0 ; Kd_S_dd(i,K) = 0.0
endif
@@ -1076,22 +1124,36 @@ end subroutine double_diffusion
!> This routine adds diffusion sustained by flow energy extracted by bottom drag.
subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
- maxTKE, kb, G, GV, CS, Kd, Kd_int, Kd_BBL)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(thermo_var_ptrs), intent(in) :: tv
- type(forcing), intent(in) :: fluxes
- type(vertvisc_type), intent(in) :: visc
- integer, intent(in) :: j
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd, maxTKE
- integer, dimension(SZI_(G)), intent(in) :: kb
- type(set_diffusivity_CS), pointer :: CS
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kd_int
- real, dimension(:,:,:), pointer :: Kd_BBL
+ maxTKE, kb, G, GV, CS, Kd_lay, Kd_int, Kd_BBL)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: u !< The zonal velocity, in m s-1
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: v !< The meridional velocity, in m s-1
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available
+ !! thermodynamic fields.
+ type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes
+ type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom
+ !! boundary layer properies, and related fields
+ integer, intent(in) :: j !< j-index of row to work on
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE
+ !! TKE dissipated within a layer and the
+ !! diapycnal diffusivity witin that layer,
+ !! usually (~Rho_0 / (G_Earth * dRho_lay)),
+ !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain
+ !! to its maximum realizable thickness, in m3 s-3
+ integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer
+ !! layer, or -1 without a bulk mixed layer
+ type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), &
+ intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1
+ real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity, in m2 s-1
! This routine adds diffusion sustained by flow energy extracted by bottom drag.
@@ -1099,25 +1161,25 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
Rint ! coordinate density of an interface (kg/m3)
real, dimension(SZI_(G)) :: &
htot, & ! total thickness above or below a layer, or the
- ! integrated thickness in the BBL (meter)
- rho_htot, & ! running integral with depth of density (kg/m2)
+ ! integrated thickness in the BBL (Z)
+ rho_htot, & ! running integral with depth of density (Z kg/m3)
gh_sum_top, & ! BBL value of g'h that can be supported by
! the local ustar, times R0_g (kg/m2)
Rho_top, & ! density at top of the BBL (kg/m3)
TKE, & ! turbulent kinetic energy available to drive
! bottom-boundary layer mixing in a layer (m3/s3)
- I2decay ! inverse of twice the TKE decay scale (1/m)
+ I2decay ! inverse of twice the TKE decay scale (1/Z)
real :: TKE_to_layer ! TKE used to drive mixing in a layer (m3/s3)
real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer (m3/s3)
real :: TKE_here ! TKE that goes into mixing in this layer (m3/s3)
real :: dRl, dRbot ! temporaries holding density differences (kg/m3)
real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional)
- real :: ustar_h ! value of ustar at a thickness point (m/s)
+ real :: ustar_h ! value of ustar at a thickness point (Z/s)
real :: absf ! average absolute Coriolis parameter around a thickness point (1/s)
- real :: R0_g ! Rho0 / G_Earth (kg s2 m-2)
+ real :: R0_g ! Rho0 / G_Earth (kg s2 Z-1 m-4)
real :: I_rho0 ! 1 / RHO0
- real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing (m2/s)
+ real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing (Z2/s)
logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities
! defined in visc, on the assumption that this
! extracted energy also drives diapycnal mixing.
@@ -1137,7 +1199,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true.
I_Rho0 = 1.0/GV%Rho0
- R0_g = GV%Rho0/GV%g_Earth
+ R0_g = GV%Rho0 / (GV%m_to_Z**2*GV%g_Earth)
do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo
@@ -1149,7 +1211,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
do i=is,ie
ustar_h = visc%ustar_BBL(i,j)
if (associated(fluxes%ustar_tidal)) &
- ustar_h = ustar_h + fluxes%ustar_tidal(i,j)
+ ustar_h = ustar_h + GV%m_to_Z*fluxes%ustar_tidal(i,j)
absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + &
(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))))
if ((ustar_h > 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then
@@ -1160,12 +1222,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
I2decay(i) = 0.5*CS%IMax_decay
endif
TKE(i) = ((CS%BBL_effic * cdrag_sqrt) * &
- exp(-I2decay(i)*(GV%H_to_m*h(i,j,nz))) ) * &
+ exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz))) ) * &
visc%TKE_BBL(i,j)
if (associated(fluxes%TKE_tidal)) &
TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * I_Rho0 * &
- (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_m*h(i,j,nz))))
+ (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz))))
! Distribute the work over a BBL of depth 20^2 ustar^2 / g' following
! Killworth & Edwards (1999) and Zilitikevich & Mironov (1996).
@@ -1175,16 +1237,16 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
gh_sum_top(i) = R0_g * 400.0 * ustar_h**2
do_i(i) = (G%mask2dT(i,j) > 0.5)
- htot(i) = GV%H_to_m*h(i,j,nz)
- rho_htot(i) = GV%Rlay(nz)*(GV%H_to_m*h(i,j,nz))
+ htot(i) = GV%H_to_Z*h(i,j,nz)
+ rho_htot(i) = GV%Rlay(nz)*(GV%H_to_Z*h(i,j,nz))
Rho_top(i) = GV%Rlay(1)
if (CS%bulkmixedlayer .and. do_i(i)) Rho_top(i) = GV%Rlay(kb(i)-1)
enddo
do k=nz-1,2,-1 ; domore = .false.
do i=is,ie ; if (do_i(i)) then
- htot(i) = htot(i) + GV%H_to_m*h(i,j,k)
- rho_htot(i) = rho_htot(i) + GV%Rlay(k)*(GV%H_to_m*h(i,j,k))
+ htot(i) = htot(i) + GV%H_to_Z*h(i,j,k)
+ rho_htot(i) = rho_htot(i) + GV%Rlay(k)*(GV%H_to_Z*h(i,j,k))
if (htot(i)*GV%Rlay(k-1) <= (rho_htot(i) - gh_sum_top(i))) then
! The top of the mixing is in the interface atop the current layer.
Rho_top(i) = (rho_htot(i) - gh_sum_top(i)) / htot(i)
@@ -1203,7 +1265,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
i_rem = i_rem + 1 ! Count the i-rows that are still being worked on.
! Apply vertical decay of the turbulent energy. This energy is
! simply lost.
- TKE(i) = TKE(i) * exp(-I2decay(i) * (GV%H_to_m*(h(i,j,k) + h(i,j,k+1))))
+ TKE(i) = TKE(i) * exp(-I2decay(i) * (GV%H_to_Z*(h(i,j,k) + h(i,j,k+1))))
! if (maxEnt(i,k) <= 0.0) cycle
if (maxTKE(i,k) <= 0.0) cycle
@@ -1221,7 +1283,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
else ; TKE_to_layer = 0.0 ; endif
! TKE_Ray has been initialized to 0 above.
- if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * &
+ if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * GV%Z_to_m * G%IareaT(i,j) * &
((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + &
G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + &
(G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + &
@@ -1234,15 +1296,15 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
TKE(i) = TKE(i) - TKE_to_layer
- if (Kd(i,j,k) < (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)) then
- delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - Kd(i,j,k)
+ if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)) then
+ delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - Kd_lay(i,j,k)
if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then
- delta_Kd = CS%Kd_Max
- Kd(i,j,k) = Kd(i,j,k) + delta_Kd
+ delta_Kd = CS%Kd_max
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd
else
- Kd(i,j,k) = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)
+ Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)
endif
- Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd
+ Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd
Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd
if (do_diag_Kd_BBL) then
Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd
@@ -1250,12 +1312,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
endif
endif
else
- if (Kd(i,j,k) >= maxTKE(i,k)*TKE_to_Kd(i,k)) then
+ if (Kd_lay(i,j,k) >= maxTKE(i,k)*TKE_to_Kd(i,k)) then
TKE_here = 0.0
TKE(i) = TKE(i) + TKE_Ray
- elseif (Kd(i,j,k) + (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) > &
+ elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) > &
maxTKE(i,k)*TKE_to_Kd(i,k)) then
- TKE_here = ((TKE_to_layer+TKE_Ray) + Kd(i,j,k)/TKE_to_Kd(i,k)) - &
+ TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/TKE_to_Kd(i,k) ) - &
maxTKE(i,k)
TKE(i) = TKE(i) - TKE_here + TKE_Ray
else
@@ -1265,10 +1327,10 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
if (TKE(i) < 0.0) TKE(i) = 0.0 ! This should be unnecessary?
if (TKE_here > 0.0) then
- delta_Kd = TKE_here*TKE_to_Kd(i,k)
+ delta_Kd = TKE_here * TKE_to_Kd(i,k)
if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max)
- Kd(i,j,k) = Kd(i,j,k) + delta_Kd
- Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd
+ Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd
Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd
if (do_diag_Kd_BBL) then
Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd
@@ -1296,21 +1358,29 @@ end subroutine add_drag_diffusivity
!! wall turbulent viscosity, up to a BBL height where the energy used for mixing has
!! consumed the mechanical TKE input.
subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, &
- G, GV, CS, Kd, Kd_int, Kd_BBL)
- type(ocean_grid_type), intent(in) :: G !< Grid structure
- type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< u component of flow (m s-1)
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< v component of flow (m s-1)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg m-2)
- type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure
- type(forcing), intent(in) :: fluxes !< Surface fluxes structure
- type(vertvisc_type), intent(in) :: visc !< Vertical viscosity structure
- integer, intent(in) :: j !< j-index of row to work on
- real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces (s-2)
- type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd !< Layer net diffusivity (m2 s-1)
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kd_int !< Interface net diffusivity (m2 s-1)
- real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity (m2 s-1)
+ G, GV, CS, Kd_lay, Kd_int, Kd_BBL)
+ type(ocean_grid_type), intent(in) :: G !< Grid structure
+ type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: u !< u component of flow (m s-1)
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: v !< v component of flow (m s-1)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thickness (m or kg m-2)
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available
+ !! thermodynamic fields.
+ type(forcing), intent(in) :: fluxes !< Surface fluxes structure
+ type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom
+ !! boundary layer properies, and related fields.
+ integer, intent(in) :: j !< j-index of row to work on
+ real, dimension(SZI_(G),SZK_(G)+1), &
+ intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces (s-2)
+ type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: Kd_lay !< Layer net diffusivity (m2 s-1)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), &
+ intent(inout) :: Kd_int !< Interface net diffusivity (m2 s-1)
+ real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity (m2 s-1)
! Local variables
real :: TKE_column ! net TKE input into the column (m3 s-3)
@@ -1320,17 +1390,17 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, &
real :: TKE_consumed ! TKE used for mixing in this layer (m3 s-3)
real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing (m3 s-3)
real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional)
- real :: ustar ! value of ustar at a thickness point (m/s)
- real :: ustar2 ! square of ustar, for convenience (m2/s2)
+ real :: ustar ! value of ustar at a thickness point (Z/s)
+ real :: ustar2 ! square of ustar, for convenience (Z2/s2)
real :: absf ! average absolute value of Coriolis parameter around a thickness point (1/sec)
- real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (meter)
- real :: z ! distance to interface k from bottom (meter)
- real :: D_minus_z ! distance to interface k from surface (meter)
- real :: total_thickness ! total thickness of water column (meter)
- real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/m)
- real :: Kd_wall ! Law of the wall diffusivity (m2/s)
- real :: Kd_lower ! diffusivity for lower interface (m2/sec)
- real :: ustar_D ! u* x D (m2/s)
+ real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (Z)
+ real :: z_bot ! distance to interface k from bottom (Z)
+ real :: D_minus_z ! distance to interface k from surface (Z)
+ real :: total_thickness ! total thickness of water column (Z)
+ real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/Z)
+ real :: Kd_wall ! Law of the wall diffusivity (Z2/s)
+ real :: Kd_lower ! diffusivity for lower interface (Z2/sec)
+ real :: ustar_D ! u* x D (Z2/s)
real :: I_Rho0 ! 1 / rho0
real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall (1/s2)
logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on
@@ -1363,7 +1433,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, &
ustar2 = ustar**2
! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting
! since ustar_BBL should already include all contributions to u*? -AJA
- if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j)
+ if (associated(fluxes%ustar_tidal)) ustar = ustar + GV%m_to_Z*fluxes%ustar_tidal(i,j)
! The maximum decay scale should be something of order 200 m. We use the smaller of u*/f and
! (IMax_decay)^-1 as the decay scale. If ustar = 0, this is land so this value doesn't matter.
@@ -1380,20 +1450,21 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, &
TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing.
TKE_remaining = TKE_column
- total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_m ! Total column thickness, in m.
+ total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_Z ! Total column thickness, in m.
ustar_D = ustar * total_thickness
- z = 0.
+ z_bot = 0.
Kd_lower = 0. ! Diffusivity on bottom boundary.
! Work upwards from the bottom, accumulating work used until it exceeds the available TKE input
! at the bottom.
do k=G%ke,2,-1
- dh = GV%H_to_m * h(i,j,k) ! Thickness of this level in m.
+ dh = GV%H_to_Z * h(i,j,k) ! Thickness of this level in Z.
km1 = max(k-1, 1)
- dhm1 = GV%H_to_m * h(i,j,km1) ! Thickness of level above in m.
+ dhm1 = GV%H_to_Z * h(i,j,km1) ! Thickness of level above in Z.
! Add in additional energy input from bottom-drag against slopes (sides)
- if (Rayleigh_drag) TKE_remaining = TKE_remaining + 0.5*CS%BBL_effic * G%IareaT(i,j) * &
+ if (Rayleigh_drag) TKE_remaining = TKE_remaining + &
+ 0.5*CS%BBL_effic * GV%Z_to_m * G%IareaT(i,j) * &
((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + &
G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + &
(G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + &
@@ -1403,28 +1474,29 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, &
! This is energy loss in addition to work done as mixing, apparently to Joule heating.
TKE_remaining = exp(-Idecay*dh) * TKE_remaining
- z = z + h(i,j,k)*GV%H_to_m ! Distance between upper interface of layer and the bottom, in m.
- D_minus_z = max(total_thickness - z, 0.) ! Thickness above layer, m.
+ z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom, in Z.
+ D_minus_z = max(total_thickness - z_bot, 0.) ! Thickness above layer, Z.
! Diffusivity using law of the wall, limited by rotation, at height z, in m2/s.
! This calculation is at the upper interface of the layer
- if ( ustar_D + absf * ( z * D_minus_z ) == 0.) then
+ if ( ustar_D + absf * ( z_bot * D_minus_z ) == 0.) then
Kd_wall = 0.
else
- Kd_wall = ( ( von_karm * ustar2 ) * ( z * D_minus_z ) )/( ustar_D + absf * ( z * D_minus_z ) )
+ Kd_wall = ( ( von_karm * ustar2 ) * ( z_bot * D_minus_z ) ) / &
+ ( ustar_D + absf * ( z_bot * D_minus_z ) )
endif
! TKE associated with Kd_wall, in m3 s-2.
! This calculation if for the volume spanning the interface.
- TKE_Kd_wall = Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min)
+ TKE_Kd_wall = GV%Z_to_m**3*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min)
! Now bound Kd such that the associated TKE is no greater than available TKE for mixing.
- if (TKE_Kd_wall>0.) then
+ if (TKE_Kd_wall > 0.) then
TKE_consumed = min(TKE_Kd_wall, TKE_remaining)
Kd_wall = (TKE_consumed/TKE_Kd_wall) * Kd_wall ! Scale Kd so that only TKE_consumed is used.
else
! Either N2=0 or dh = 0.
- if (TKE_remaining>0.) then
+ if (TKE_remaining > 0.) then
Kd_wall = CS%Kd_max
else
Kd_wall = 0.
@@ -1436,41 +1508,50 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, &
TKE_remaining = TKE_remaining - TKE_consumed ! Note this will be non-negative
! Add this BBL diffusivity to the model net diffusivity.
- Kd_int(i,j,k) = Kd_int(i,j,k) + Kd_wall
- Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_wall + Kd_lower)
+ Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_wall
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(Kd_wall + Kd_lower)
Kd_lower = Kd_wall ! Store for next level up.
- if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = Kd_wall
+ if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = Kd_wall
enddo ! k
enddo ! i
end subroutine add_LOTW_BBL_diffusivity
+
!> This routine adds effects of mixed layer radiation to the layer diffusivities.
-subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(forcing), intent(in) :: fluxes
- integer, intent(in) :: j
- type(set_diffusivity_CS), pointer :: CS
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int
+subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_int)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(forcing), intent(in) :: fluxes !< Surface fluxes structure
+ type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1.
+ integer, intent(in) :: j !< The j-index to work on
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE
+ !! TKE dissipated within a layer and the
+ !! diapycnal diffusivity witin that layer,
+ !! usually (~Rho_0 / (G_Earth * dRho_lay)),
+ !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), &
+ optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1.
! This routine adds effects of mixed layer radiation to the layer diffusivities.
- real, dimension(SZI_(G)) :: &
- h_ml, &
- TKE_ml_flux, &
- I_decay, &
- Kd_mlr_ml
+ real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness, in Z.
+ real, dimension(SZI_(G)) :: TKE_ml_flux
+ real, dimension(SZI_(G)) :: I_decay ! A decay rate in Z-1.
+ real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation, in Z2 s-1.
- real :: f_sq, h_ml_sq, ustar_sq, Kd_mlr, C1_6
+ real :: f_sq, h_ml_sq, ustar_sq
+ real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation, in Z2 s-1.
+ real :: C1_6 ! 1/6
real :: Omega2 ! rotation rate squared (1/s2)
real :: z1 ! layer thickness times I_decay (nondim)
- real :: dzL ! thickness converted to meter
+ real :: dzL ! thickness converted to Z
real :: I_decay_len2_TKE ! squared inverse decay lengthscale for
- ! TKE, as used in the mixed layer code (1/m2)
- real :: h_neglect ! negligibly small thickness (meter)
+ ! TKE, as used in the mixed layer code (1/Z2)
+ real :: h_neglect ! negligibly small thickness (Z)
logical :: do_any, do_i(SZI_(G))
integer :: i, k, is, ie, nz, kml
@@ -1479,12 +1560,12 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int)
Omega2 = CS%Omega**2
C1_6 = 1.0 / 6.0
kml = GV%nkml
- h_neglect = GV%H_subroundoff*GV%H_to_m
+ h_neglect = GV%H_subroundoff*GV%H_to_Z
if (.not.CS%ML_radiation) return
do i=is,ie ; h_ml(i) = 0.0 ; do_i(i) = (G%mask2dT(i,j) > 0.5) ; enddo
- do k=1,kml ; do i=is,ie ; h_ml(i) = h_ml(i) + GV%H_to_m*h(i,j,k) ; enddo ; enddo
+ do k=1,kml ; do i=is,ie ; h_ml(i) = h_ml(i) + GV%H_to_Z*h(i,j,k) ; enddo ; enddo
do i=is,ie ; if (do_i(i)) then
if (CS%ML_omega_frac >= 1.0) then
@@ -1499,7 +1580,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int)
ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2
TKE_ml_flux(i) = (CS%mstar*CS%ML_rad_coeff)*(ustar_sq*fluxes%ustar(i,j))
- I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq)
+ I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / (GV%m_to_Z**2*ustar_sq))
if (CS%ML_rad_TKE_decay) &
TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-h_ml(i) * sqrt(I_decay_len2_TKE))
@@ -1510,7 +1591,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int)
! Average the dissipation layer kml+1, using
! a more accurate Taylor series approximations for very thin layers.
- z1 = (GV%H_to_m*h(i,j,kml+1)) * I_decay(i)
+ z1 = (GV%H_to_Z*h(i,j,kml+1)) * I_decay(i)
if (z1 > 1e-5) then
Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * &
(1.0 - exp(-z1))
@@ -1518,12 +1599,12 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int)
Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * &
(z1 * (1.0 - z1 * (0.5 - C1_6*z1)))
endif
- Kd_mlr_ml(i) = min(Kd_mlr,CS%ML_rad_kd_max)
+ Kd_mlr_ml(i) = min(Kd_mlr, CS%ML_rad_kd_max)
TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1)
endif ; enddo
do k=1,kml+1 ; do i=is,ie ; if (do_i(i)) then
- Kd(i,j,k) = Kd(i,j,k) + Kd_mlr_ml(i)
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr_ml(i)
endif ; enddo ; enddo
if (present(Kd_int)) then
do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then
@@ -1537,23 +1618,23 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int)
do k=kml+2,nz-1
do_any = .false.
do i=is,ie ; if (do_i(i)) then
- dzL = GV%H_to_m*h(i,j,k) ; z1 = dzL*I_decay(i)
+ dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i)
if (z1 > 1e-5) then
Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * &
- ((1.0 - exp(-z1)) / dzL)
+ GV%m_to_Z * ((1.0 - exp(-z1)) / dzL)
else
Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * &
- (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1)))
+ GV%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1)))
endif
- Kd_mlr = min(Kd_mlr,CS%ML_rad_kd_max)
- Kd(i,j,k) = Kd(i,j,k) + Kd_mlr
+ Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max)
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr
if (present(Kd_int)) then
- Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr
+ Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr
Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_mlr
endif
TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1)
- if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*Omega2) then
+ if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*GV%Z_to_m**3*Omega2) then
do_i(i) = .false.
else ; do_any = .true. ; endif
endif ; enddo
@@ -1565,35 +1646,39 @@ end subroutine add_MLrad_diffusivity
!> This subroutine calculates several properties related to bottom
!! boundary layer turbulence.
subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, 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
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- type(forcing), intent(in) :: fluxes
- type(vertvisc_type), intent(inout) :: visc
- type(set_diffusivity_CS), pointer :: 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
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: u !< The zonal velocity, in m s-1
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: v !< The meridional velocity, in m s-1
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes
+ type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom
+ !! boundary layer properies, and related fields.
+ type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure
! This subroutine calculates several properties related to bottom
! boundary layer turbulence.
real, dimension(SZI_(G)) :: &
htot ! total thickness above or below a layer, or the
- ! integrated thickness in the BBL (meter)
+ ! integrated thickness in the BBL (Z)
real, dimension(SZIB_(G)) :: &
- uhtot, & ! running integral of u in the BBL (m2/s)
- ustar, & ! bottom boundary layer turbulence speed (m/s)
+ uhtot, & ! running integral of u in the BBL (Z m/s)
+ ustar, & ! bottom boundary layer turbulence speed (Z/s)
u2_bbl ! square of the mean zonal velocity in the BBL (m2/s2)
- real :: vhtot(SZI_(G)) ! running integral of v in the BBL (m2/sec)
+ real :: vhtot(SZI_(G)) ! running integral of v in the BBL (Z m/sec)
real, dimension(SZI_(G),SZJB_(G)) :: &
- vstar, & ! ustar at at v-points in 2 j-rows (m/s)
+ vstar, & ! ustar at at v-points (Z/s)
v2_bbl ! square of average meridional velocity in BBL (m2/s2)
real :: cdrag_sqrt ! square root of the drag coefficient (nondim)
- real :: hvel ! thickness at velocity points (meter)
+ real :: hvel ! thickness at velocity points (Z)
logical :: domore, do_i(SZI_(G))
integer :: i, j, k, is, ie, js, je, nz
@@ -1624,14 +1709,14 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS)
! vertical decay scale.
do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then
do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0
- vstar(i,J) = visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J))
+ vstar(i,J) = visc%kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J))
else
do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0
endif ; enddo
do k=nz,1,-1
domore = .false.
do i=is,ie ; if (do_i(i)) then
- hvel = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j+1,k))
+ hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j+1,k))
if ((htot(i) + hvel) >= visc%bbl_thick_v(i,J)) then
vhtot(i) = vhtot(i) + (visc%bbl_thick_v(i,J) - htot(i))*v(i,J,k)
htot(i) = visc%bbl_thick_v(i,J)
@@ -1654,13 +1739,13 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS)
do j=js,je
do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then
do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0
- ustar(I) = visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j))
+ ustar(I) = visc%kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j))
else
do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0
endif ; enddo
do k=nz,1,-1 ; domore = .false.
do I=is-1,ie ; if (do_i(I)) then
- hvel = 0.5*GV%H_to_m*(h(i,j,k) + h(i+1,j,k))
+ hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i+1,j,k))
if ((htot(I) + hvel) >= visc%bbl_thick_u(I,j)) then
uhtot(I) = uhtot(I) + (visc%bbl_thick_u(I,j) - htot(I))*u(I,j,k)
htot(I) = visc%bbl_thick_u(I,j)
@@ -1685,10 +1770,11 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS)
G%areaCu(I,j)*(ustar(I)*ustar(I))) + &
(G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + &
G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) )
- visc%TKE_BBL(i,j) = (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + &
+ visc%TKE_BBL(i,j) = GV%Z_to_m * &
+ (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + &
G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + &
(G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + &
- G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))))*G%IareaT(i,j))
+ G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*G%IareaT(i,j))
enddo
enddo
!$OMP end parallel
@@ -1704,8 +1790,8 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0)
type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any
!! available thermodynamic fields; absent
!! fields have NULL ptrs.
- integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the
- !! buffer layer.
+ integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer
+ !! layer, or -1 without a bulk mixed layer.
type(set_diffusivity_CS), pointer :: CS !< Control structure returned by previous
!! call to diabatic_entrain_init.
integer, intent(in) :: j !< Meridional index upon which to work.
@@ -1731,7 +1817,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0)
! below it (nondimensional)
! (in) rho_0 - layer potential densities relative to surface press (kg/m3)
- real :: g_R0 ! g_R0 is g/Rho (m4 kg-1 s-2)
+ real :: g_R0 ! g_R0 is g/Rho (m5 Z-1 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
@@ -1814,13 +1900,13 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0)
end subroutine set_density_ratios
subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp, int_tide_CSp, &
- tm_CSp)
- type(time_type), intent(in) :: Time
+ tm_CSp, halo_TS)
+ type(time_type), intent(in) :: Time !< The current model time
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
!! parameters.
- type(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output.
+ type(diag_ctrl), target, intent(inout) :: diag !< A structure used to regulate diagnostic output.
type(set_diffusivity_CS), pointer :: CS !< pointer set to point to the module control
!! structure.
type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control
@@ -1829,6 +1915,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
!! structure (BDM)
type(tidal_mixing_cs), pointer :: tm_csp !< pointer to tidal mixing control
!! structure
+ integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be
+ !! valid for the calculations in set_diffusivity.
! local variables
real :: decay_length
@@ -1886,7 +1974,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
"length scale.", default=.false.)
if (CS%ML_radiation) then
! This give a minimum decay scale that is typically much less than Angstrom.
- CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_subroundoff*GV%H_to_m)
+ CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_subroundoff*GV%H_to_m)
call get_param(param_file, mdl, "ML_RAD_EFOLD_COEFF", CS%ML_rad_efold_coeff, &
"A coefficient that is used to scale the penetration \n"//&
@@ -1896,8 +1984,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
call get_param(param_file, mdl, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, &
"The maximum diapycnal diffusivity due to turbulence \n"//&
"radiated from the base of the mixed layer. \n"//&
- "This is only used if ML_RADIATION is true.", units="m2 s-1", &
- default=1.0e-3)
+ "This is only used if ML_RADIATION is true.", &
+ units="m2 s-1", default=1.0e-3, scale=GV%m_to_Z**2)
call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, &
"The coefficient which scales MSTAR*USTAR^3 to obtain \n"//&
"the energy available for mixing below the base of the \n"//&
@@ -1949,10 +2037,10 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
"The maximum decay scale for the BBL diffusion, or 0 \n"//&
"to allow the mixing to penetrate as far as \n"//&
"stratification and rotation permit. The default is 0. \n"//&
- "This is only used if BOTTOMDRAGLAW is true.", units="m", &
- default=0.0)
+ "This is only used if BOTTOMDRAGLAW is true.", &
+ units="m", default=0.0, scale=GV%m_to_Z)
- CS%IMax_decay = 1.0/200.0
+ CS%IMax_decay = 1.0 / (200.0*GV%m_to_Z) !### This is inconsistent with the description above.
if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length
call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, &
"If true, take the maximum of the diffusivity from the \n"//&
@@ -1972,7 +2060,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
CS%use_LOTW_BBL_diffusivity = .false. ! This parameterization depends on a u* from viscous BBL
endif
CS%id_Kd_BBL = register_diag_field('ocean_model','Kd_BBL',diag%axesTi,Time, &
- 'Bottom Boundary Layer Diffusivity', 'm2 s-1')
+ 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2)
call get_param(param_file, mdl, "SIMPLE_TKE_TO_KD", CS%simple_TKE_to_Kd, &
"If true, uses a simple estimate of Kd/TKE that will\n"//&
"work for arbitrary vertical coordinates. If false,\n"//&
@@ -1986,25 +2074,25 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
call get_param(param_file, mdl, "KV", CS%Kv, &
"The background kinematic viscosity in the interior. \n"//&
"The molecular value, ~1e-6 m2 s-1, may be used.", &
- units="m2 s-1", fail_if_missing=.true.)
+ units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.)
call get_param(param_file, mdl, "KD", CS%Kd, &
"The background diapycnal diffusivity of density in the \n"//&
"interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//&
- "may be used.", units="m2 s-1", fail_if_missing=.true.)
+ "may be used.", units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.)
call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, &
"The minimum diapycnal diffusivity.", &
- units="m2 s-1", default=0.01*CS%Kd)
+ units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2)
call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, &
"The maximum permitted increment for the diapycnal \n"//&
"diffusivity from TKE-based parameterizations, or a \n"//&
- "negative value for no limit.", units="m2 s-1", default=-1.0)
+ "negative value for no limit.", units="m2 s-1", default=-1.0, scale=GV%m_to_Z**2)
if (CS%simple_TKE_to_Kd .and. CS%Kd_max<=0.) call MOM_error(FATAL, &
"set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.")
call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, &
"A uniform diapycnal diffusivity that is added \n"//&
"everywhere without any filtering or scaling.", &
- units="m2 s-1", default=0.0)
+ units="m2 s-1", default=0.0, scale=GV%m_to_Z**2)
if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, &
"set_diffusivity_init: KD_MAX must be set (positive) when "// &
"USE_LOTW_BBL_DIFFUSIVITY=True.")
@@ -2022,7 +2110,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
"If BULKMIXEDLAYER is false, KDML is the elevated \n"//&
"diapycnal diffusivity in the topmost HMIX of fluid. \n"//&
"KDML is only used if BULKMIXEDLAYER is false.", &
- units="m2 s-1", default=CS%Kd)
+ units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2)
call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, &
"The prescribed depth over which the near-surface \n"//&
"viscosity and diffusivity are elevated when the bulk \n"//&
@@ -2038,20 +2126,20 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, &
"The minimum dissipation by which to determine a lower \n"//&
- "bound of Kd (a floor).", units="W m-3", default=0.0)
+ "bound of Kd (a floor).", units="W m-3", default=0.0, scale=GV%m_to_Z**2)
call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, &
"The intercept when N=0 of the N-dependent expression \n"//&
"used to set a minimum dissipation by which to determine \n"//&
"a lower bound of Kd (a floor): A in eps_min = A + B*N.", &
- units="W m-3", default=0.0)
+ units="W m-3", default=0.0, scale=GV%m_to_Z**2)
call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, &
"The coefficient multiplying N, following Gargett, used to \n"//&
"set a minimum dissipation by which to determine a lower \n"//&
"bound of Kd (a floor): B in eps_min = A + B*N", &
- units="J m-3", default=0.0)
+ units="J m-3", default=0.0, scale=GV%m_to_Z**2)
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)
+ units="m2 s-1", default=0.0, scale=GV%m_to_Z**2)
CS%limit_dissipation = (CS%dissip_min>0.) .or. (CS%dissip_N1>0.) .or. &
(CS%dissip_N0>0.) .or. (CS%dissip_Kd_min>0.)
@@ -2060,7 +2148,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max
CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, &
- 'Diapycnal diffusivity of layers (as set)', 'm2 s-1')
+ 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=GV%Z_to_m**2)
if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. &
@@ -2071,7 +2159,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
CS%id_maxTKE = register_diag_field('ocean_model','maxTKE',diag%axesTL,Time, &
'Maximum layer TKE', 'm3 s-3')
CS%id_TKE_to_Kd = register_diag_field('ocean_model','TKE_to_Kd',diag%axesTL,Time, &
- 'Convert TKE to Kd', 's2 m')
+ 'Convert TKE to Kd', 's2 m', conversion=GV%Z_to_m**2)
CS%id_N2 = register_diag_field('ocean_model','N2',diag%axesTi,Time, &
'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', &
cmor_long_name='Square of seawater buoyancy frequency',&
@@ -2108,23 +2196,23 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults.
CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, &
- 'Double-diffusive diffusivity for temperature', 'm2 s-1')
+ 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2)
CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, &
- 'Double-diffusive diffusivity for salinity', 'm2 s-1')
+ 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2)
if (associated(diag_to_Z_CSp)) then
vd = var_desc("KT_extra", "m2 s-1", &
"Double-Diffusive Temperature Diffusivity, interpolated to z", &
z_grid='z')
- CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time)
+ CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2)
vd = var_desc("KS_extra", "m2 s-1", &
"Double-Diffusive Salinity Diffusivity, interpolated to z",&
z_grid='z')
- CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time)
+ CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2)
vd = var_desc("Kd_BBL", "m2 s-1", &
"Bottom Boundary Layer Diffusivity", z_grid='z')
- CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time)
+ CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2)
endif
endif ! old double-diffusion
@@ -2137,6 +2225,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
"Bryan-Lewis and internal tidal dissipation are both enabled. Choose one.")
CS%useKappaShear = kappa_shear_init(Time, G, GV, param_file, CS%diag, CS%kappaShear_CSp)
+ if (CS%useKappaShear) CS%Vertex_Shear = kappa_shear_at_vertex(param_file)
+
if (CS%useKappaShear) &
id_clock_kappaShear = cpu_clock_id('(Ocean kappa_shear)', grain=CLOCK_MODULE)
@@ -2148,6 +2238,11 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp
if (CS%use_CVMix_ddiff) &
id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion via CVMix)', grain=CLOCK_MODULE)
+ if (present(halo_TS)) then
+ halo_TS = 0
+ if (CS%Vertex_Shear) halo_TS = 1
+ endif
+
end subroutine set_diffusivity_init
!> Clear pointers and dealocate memory
diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90
index 427a0284ba..d4261b6523 100644
--- a/src/parameterizations/vertical/MOM_set_viscosity.F90
+++ b/src/parameterizations/vertical/MOM_set_viscosity.F90
@@ -1,3 +1,5 @@
+!> Calculates various values related to the bottom boundary layer, such as the viscosity and
+!! thickness of the BBL (set_viscous_BBL).
module MOM_set_visc
! This file is part of MOM6. See LICENSE.md for the license.
@@ -6,17 +8,18 @@ module MOM_set_visc
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, 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_domains, only : pass_var, CORNER
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_forcing_type, only : forcing, mech_forcing
use MOM_grid, only : ocean_grid_type
use MOM_hor_index, only : hor_index_type
-use MOM_kappa_shear, only : kappa_shear_is_used
+use MOM_kappa_shear, only : kappa_shear_is_used, kappa_shear_at_vertex
use MOM_cvmix_shear, only : cvmix_shear_is_used
use MOM_cvmix_conv, only : cvmix_conv_is_used
use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used
-use MOM_io, only : vardesc, var_desc
-use MOM_restart, only : register_restart_field, MOM_restart_CS
+use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS
+use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc
use MOM_variables, only : thermo_var_ptrs
use MOM_variables, only : vertvisc_type
use MOM_verticalGrid, only : verticalGrid_type
@@ -31,65 +34,65 @@ module MOM_set_visc
public set_viscous_BBL, set_viscous_ML, set_visc_init, set_visc_end
public set_visc_register_restarts
+!> Control structure for MOM_set_visc
type, public :: set_visc_CS ; private
- real :: Hbbl ! The static bottom boundary layer thickness, in
- ! the same units as thickness (m or kg m-2).
- real :: cdrag ! The quadratic drag coefficient.
- real :: c_Smag ! The Laplacian Smagorinsky coefficient for
- ! calculating the drag in channels.
- real :: drag_bg_vel ! An assumed unresolved background velocity for
- ! calculating the bottom drag, in m s-1.
- real :: BBL_thick_min ! The minimum bottom boundary layer thickness in
- ! the same units as thickness (m or kg m-2).
- ! This might be Kv / (cdrag * drag_bg_vel) to give
- ! Kv as the minimum near-bottom viscosity.
- real :: Htbl_shelf ! A nominal thickness of the surface boundary layer
- ! for use in calculating the near-surface velocity,
- ! in units of m.
- real :: Htbl_shelf_min ! The minimum surface boundary layer thickness in m.
- real :: KV_BBL_min ! The minimum viscosities in the bottom and top
- real :: KV_TBL_min ! boundary layers, both in m2 s-1.
-
- logical :: bottomdraglaw ! If true, the bottom stress is calculated with a
- ! drag law c_drag*|u|*u. The velocity magnitude
- ! may be an assumed value or it may be based on the
- ! actual velocity in the bottommost HBBL, depending
- ! on whether linear_drag is true.
- logical :: BBL_use_EOS ! If true, use the equation of state in determining
- ! the properties of the bottom boundary layer.
- logical :: linear_drag ! If true, the drag law is cdrag*DRAG_BG_VEL*u.
- logical :: Channel_drag ! If true, the drag is exerted directly on each
- ! layer according to what fraction of the bottom
- ! they overlie.
- logical :: RiNo_mix ! If true, use Richardson number dependent mixing.
- logical :: dynamic_viscous_ML ! If true, use a bulk Richardson number criterion to
- ! determine the mixed layer thickness for viscosity.
- real :: bulk_Ri_ML ! The bulk mixed layer used to determine the
- ! thickness of the viscous mixed layer. Nondim.
- real :: omega ! The Earth's rotation rate, in s-1.
- real :: ustar_min ! A minimum value of ustar to avoid numerical
- ! problems, in m s-1. If the value is small enough,
- ! this should not affect the solution.
- real :: TKE_decay ! The ratio of the natural Ekman depth to the TKE
- ! decay scale, nondimensional.
- real :: omega_frac ! When setting the decay scale for turbulence, use
- ! this fraction of the absolute rotation rate blended
- ! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).
- logical :: debug ! If true, write verbose checksums for debugging purposes.
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
+ real :: Hbbl !< The static bottom boundary layer thickness, in
+ !! the same units as thickness (m or kg m-2).
+ real :: cdrag !< The quadratic drag coefficient.
+ real :: c_Smag !< The Laplacian Smagorinsky coefficient for
+ !! calculating the drag in channels.
+ real :: drag_bg_vel !< An assumed unresolved background velocity for
+ !! calculating the bottom drag, in m s-1.
+ real :: BBL_thick_min !< The minimum bottom boundary layer thickness in
+ !! the same units as thickness (H, often m or kg m-2).
+ !! This might be Kv / (cdrag * drag_bg_vel) to give
+ !! Kv as the minimum near-bottom viscosity.
+ real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use
+ !! in calculating the near-surface velocity, in units of H.
+ real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in H.
+ real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer, in Z2 s-1.
+ real :: KV_TBL_min !< The minimum viscosity in the top boundary layer, in Z2 s-1.
+ logical :: bottomdraglaw !< If true, the bottom stress is calculated with a
+ !! drag law c_drag*|u|*u. The velocity magnitude
+ !! may be an assumed value or it may be based on the
+ !! actual velocity in the bottommost HBBL, depending
+ !! on whether linear_drag is true.
+ logical :: BBL_use_EOS !< If true, use the equation of state in determining
+ !! the properties of the bottom boundary layer.
+ logical :: linear_drag !< If true, the drag law is cdrag*DRAG_BG_VEL*u.
+ logical :: Channel_drag !< If true, the drag is exerted directly on each
+ !! layer according to what fraction of the bottom
+ !! they overlie.
+ logical :: RiNo_mix !< If true, use Richardson number dependent mixing.
+ logical :: dynamic_viscous_ML !< If true, use a bulk Richardson number criterion to
+ !! determine the mixed layer thickness for viscosity.
+ real :: bulk_Ri_ML !< The bulk mixed layer used to determine the
+ !! thickness of the viscous mixed layer. Nondim.
+ real :: omega !< The Earth's rotation rate, in s-1.
+ real :: ustar_min !< A minimum value of ustar to avoid numerical
+ !! problems, in Z s-1. If the value is small enough,
+ !! this should not affect the solution.
+ real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE
+ !! decay scale, nondimensional.
+ real :: omega_frac !< When setting the decay scale for turbulence, use
+ !! this fraction of the absolute rotation rate blended
+ !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).
+ logical :: debug !< If true, write verbose checksums for debugging purposes.
+ type(ocean_OBC_type), pointer :: OBC => NULL() !< Open boundaries control structure
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ !>@{ Diagnostics handles
integer :: id_bbl_thick_u = -1, id_kv_bbl_u = -1
integer :: id_bbl_thick_v = -1, id_kv_bbl_v = -1
integer :: id_Ray_u = -1, id_Ray_v = -1
integer :: id_nkml_visc_u = -1, id_nkml_visc_v = -1
- type(ocean_OBC_type), pointer :: OBC => NULL()
+ !!@}
end type set_visc_CS
contains
-!> The following subroutine calculates the thickness of the bottom
-!! boundary layer and the viscosity within that layer. A drag law is
-!! used, either linearized about an assumed bottom velocity or using
+!> Calculates the thickness of the bottom boundary layer and the viscosity within that layer.
+!! A drag law is used, either linearized about an assumed bottom velocity or using
!! the actual near-bottom velocities combined with an assumed
!! unresolved velocity. The bottom boundary layer thickness is
!! limited by a combination of stratification and rotation, as in the
@@ -156,11 +159,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
real :: Rhtot ! Running sum of thicknesses times the
! layer potential densities in H kg m-3.
real, dimension(SZIB_(G),SZJ_(G)) :: &
- D_u, & ! Bottom depth interpolated to u points, in m.
+ D_u, & ! Bottom depth interpolated to u points, in depth units (m).
mask_u ! A mask that disables any contributions from u points that
! are land or past open boundary conditions, nondim., 0 or 1.
real, dimension(SZI_(G),SZJB_(G)) :: &
- D_v, & ! Bottom depth interpolated to v points, in m.
+ D_v, & ! Bottom depth interpolated to v points, in depth units (m).
mask_v ! A mask that disables any contributions from v points that
! are land or past open boundary conditions, nondim., 0 or 1.
real, dimension(SZIB_(G),SZK_(G)) :: &
@@ -181,6 +184,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
real :: ustarsq ! 400 times the square of ustar, times
! Rho0 divided by G_Earth and the conversion
! from m to thickness units, in kg m-2 or kg2 m-5.
+ real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion
+ ! factor from lateral lengths to vertical depths, in Z m-1.
real :: cdrag_sqrt ! Square root of the drag coefficient, nd.
real :: oldfn ! The integrated energy required to
! entrain up to the bottom of the layer,
@@ -189,13 +194,14 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
! the layer, in H kg m-3.
real :: Dh ! The increment in layer thickness from
! the present layer, in H.
- real :: bbl_thick ! The thickness of the bottom boundary layer in m.
+ real :: bbl_thick ! The thickness of the bottom boundary layer in H.
+ real :: bbl_thick_Z ! The thickness of the bottom boundary layer in Z.
real :: C2f ! C2f = 2*f at velocity points.
real :: U_bg_sq ! The square of an assumed background
! velocity, for calculating the mean
! magnitude near the bottom for use in the
- ! quadratic bottom drag, in m2.
+ ! quadratic bottom drag, in m2 s-2.
real :: hwtot ! Sum of the thicknesses used to calculate
! the near-bottom velocity magnitude, in H.
real :: hutot ! Running sum of thicknesses times the
@@ -205,8 +211,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
real :: hweight ! The thickness of a layer that is within Hbbl
! of the bottom, in H.
real :: v_at_u, u_at_v ! v at a u point or vice versa, m s-1.
- real :: Rho0x400_G ! 400*Rho0/G_Earth, in kg s2 m-4. The 400 is a
- ! constant proposed by Killworth and Edwards, 1999.
+ real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2.
+ ! The 400 is a constant proposed by Killworth and Edwards, 1999.
real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: &
Rml ! The mixed layer coordinate density, in kg m-3.
real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate
@@ -252,12 +258,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
! in roundoff and can be neglected, in H.
real :: ustH ! ustar converted to units of H s-1.
real :: root ! A temporary variable with units of H s-1.
- real :: H_to_m, m_to_H ! Local copies of unit conversion factors.
real :: Cell_width ! The transverse width of the velocity cell, in m.
- real :: Rayleigh ! A nondimensional value that is multiplied by the
- ! layer's velocity magnitude to give the Rayleigh
- ! drag velocity.
+ real :: Rayleigh ! A nondimensional value that is multiplied by the layer's
+ ! velocity magnitude to give the Rayleigh drag velocity,
+ ! times a lateral to vertical distance conversion factor, in Z L-1.
real :: gam ! The ratio of the change in the open interface width
! to the open interface width atop a cell, nondim.
real :: BBL_frac ! The fraction of a layer's drag that goes into the
@@ -277,9 +282,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
nkmb = GV%nk_rho_varies ; nkml = GV%nkml
h_neglect = GV%H_subroundoff
- Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth)*GV%m_to_H
- Vol_quit = 0.9*GV%Angstrom + h_neglect
- H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H
+ Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H
+ Vol_quit = 0.9*GV%Angstrom_H + h_neglect
C2pi_3 = 8.0*atan(1.0)/3.0
if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(BBL): "//&
@@ -301,11 +305,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
OBC => CS%OBC
U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel
- cdrag_sqrt=sqrt(CS%cdrag)
+ cdrag_sqrt = sqrt(CS%cdrag)
+ cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag)
K2 = max(nkmb+1, 2)
! With a linear drag law, the friction velocity is already known.
-! if (CS%linear_drag) ustar(:) = cdrag_sqrt*CS%drag_bg_vel
+! 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
@@ -370,20 +375,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
if (.not.use_BBL_EOS) Rml_vel(:,:) = 0.0
-!$OMP parallel do default(none) shared(u, v, h, tv, visc, G, GV, CS, Rml, is, ie, js, je, &
-!$OMP nz, Isq, Ieq, Jsq, Jeq, nkmb, h_neglect, Rho0x400_G,&
-!$OMP C2pi_3, U_bg_sq, cdrag_sqrt,K2,use_BBL_EOS,OBC, &
-!$OMP maxitt,nkml,m_to_H,H_to_m,Vol_quit,D_u,D_v,mask_u,mask_v) &
-!$OMP private(do_i,h_at_vel,htot_vel,hwtot,hutot,Thtot,Shtot, &
-!$OMP hweight,v_at_u,u_at_v,ustar,T_EOS,S_EOS,press, &
-!$OMP dR_dT, dR_dS,ustarsq,htot,T_vel,S_vel,Rml_vel, &
-!$OMP oldfn,Dfn,Dh,Rhtot,C2f,ustH,root,bbl_thick, &
-!$OMP D_vel,tmp,Dp,Dm,a_3,a,a_12,slope,Vol_open,Vol_2_reg,&
-!$OMP C24_a,apb_4a,Iapb,a2x48_apb3,ax2_3apb,Vol_direct, &
-!$OMP L_direct,Ibma_2,L,vol,vol_below,Vol_err,h_vel_pos, &
-!$OMP BBL_visc_frac,h_vel,L0,Vol_0,dV_dL2,dVol,L_max, &
-!$OMP L_min,Vol_err_min,Vol_err_max,BBL_frac,Cell_width, &
-!$OMP gam,Rayleigh, Vol_tol, tmp_val_m1_to_p1)
+ !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,CS,Rml,is,ie,js,je,nz,nkmb, &
+ !$OMP nkml,Isq,Ieq,Jsq,Jeq,h_neglect,Rho0x400_G,C2pi_3, &
+ !$OMP U_bg_sq,cdrag_sqrt_Z,cdrag_sqrt,K2,use_BBL_EOS, &
+ !$OMP OBC,maxitt,Vol_quit,D_u,D_v,mask_u,mask_v)
do j=Jsq,Jeq ; do m=1,2
if (m==1) then
@@ -517,7 +512,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
if (htot_vel>=CS%Hbbl) exit ! terminate the k loop
hweight = MIN(CS%Hbbl - htot_vel, h_at_vel(i,k))
- if (hweight < 1.5*GV%Angstrom + h_neglect) cycle
+ if (hweight < 1.5*GV%Angstrom_H + h_neglect) cycle
htot_vel = htot_vel + h_at_vel(i,k)
hwtot = hwtot + hweight
@@ -539,9 +534,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
enddo ! end of k loop
if (.not.CS%linear_drag .and. (hwtot > 0.0)) then
- ustar(i) = cdrag_sqrt*hutot/hwtot
+ ustar(i) = cdrag_sqrt_Z*hutot/hwtot
else
- ustar(i) = cdrag_sqrt*CS%drag_bg_vel
+ ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel
endif
if (use_BBL_EOS) then ; if (hwtot > 0.0) then
@@ -551,7 +546,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
endif ; endif
endif ; enddo
else
- do i=is,ie ; ustar(i) = cdrag_sqrt*CS%drag_bg_vel ; enddo
+ do i=is,ie ; ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel ; enddo
endif ! Not linear_drag
if (use_BBL_EOS) then
@@ -653,7 +648,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
if (CS%cdrag * U_bg_sq <= 0.0) then
! This avoids NaNs and overflows, and could be used in all cases,
! but is not bitwise identical to the current code.
- ustH = ustar(i)*m_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2)
+ ustH = ustar(i)*GV%Z_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2)
if (htot*ustH <= (CS%BBL_thick_min+h_neglect) * (0.5*ustH + root)) then
bbl_thick = CS%BBL_thick_min
else
@@ -661,7 +656,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
endif
else
bbl_thick = htot / (0.5 + sqrt(0.25 + htot*htot*C2f*C2f/ &
- ((ustar(i)*ustar(i)) * (m_to_H**2) )))
+ ((ustar(i)*ustar(i)) * (GV%Z_to_H**2) )))
if (bbl_thick < CS%BBL_thick_min) bbl_thick = CS%BBL_thick_min
endif
@@ -692,7 +687,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
if (Dm > Dp) then ; tmp = Dp ; Dp = Dm ; Dm = tmp ; endif
! Convert the D's to the units of thickness.
- Dp = m_to_H*Dp ; Dm = m_to_H*Dm ; D_vel = m_to_H*D_vel
+ Dp = GV%Z_to_H*Dp ; Dm = GV%Z_to_H*Dm ; D_vel = GV%Z_to_H*D_vel
a_3 = (Dp + Dm - 2.0*D_vel) ; a = 3.0*a_3 ; a_12 = 0.25*a_3
slope = Dp - Dm
@@ -791,18 +786,18 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = (vol-Vol_0)
! dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = max(vol-Vol_0, 0.0)
- !### The following code is more robust when GV%Angstrom=0, but it
+ !### The following code is more robust when GV%Angstrom_H=0, but it
!### changes answers.
- ! Vol_tol = max(0.5*GV%Angstrom + GV%H_subroundoff, 1e-14*vol)
- ! Vol_quit = max(0.9*GV%Angstrom + GV%H_subroundoff, 1e-14*vol)
+ ! Vol_tol = max(0.5*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol)
+ ! Vol_quit = max(0.9*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol)
! if (dVol <= 0.0) then
! L(K) = L0
! Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol
! elseif (a*a*dVol**3 < Vol_tol*dV_dL2**2 * &
! (dV_dL2*Vol_tol - 2.0*a*L0*dVol)) then
- if (a*a*dVol**3 < GV%Angstrom*dV_dL2**2 * &
- (0.25*dV_dL2*GV%Angstrom - a*L0*dVol)) then
+ if (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * &
+ (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol)) then
! One iteration of Newton's method should give an estimate
! that is accurate to within Vol_tol.
L(K) = sqrt(L0*L0 + dVol / dV_dL2)
@@ -851,9 +846,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
if (m==1) then ; Cell_width = G%dy_Cu(I,j)
else ; Cell_width = G%dx_Cv(i,J) ; endif
gam = 1.0 - L(K+1)/L(K)
- Rayleigh = CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * &
- (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + m_to_H * &
- CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width)
+ Rayleigh = GV%m_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * &
+ (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + &
+ GV%m_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width)
else ! This layer feels no drag.
Rayleigh = 0.0
endif
@@ -874,27 +869,27 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
enddo ! k loop to determine L(K).
- bbl_thick = bbl_thick * H_to_m
+ bbl_thick_Z = bbl_thick * GV%H_to_Z
if (m==1) then
visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, &
- cdrag_sqrt*ustar(i)*bbl_thick*BBL_visc_frac)
- visc%bbl_thick_u(I,j) = bbl_thick
+ cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac)
+ visc%bbl_thick_u(I,j) = bbl_thick_Z
else
visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, &
- cdrag_sqrt*ustar(i)*bbl_thick*BBL_visc_frac)
- visc%bbl_thick_v(i,J) = bbl_thick
+ cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac)
+ visc%bbl_thick_v(i,J) = bbl_thick_Z
endif
else ! Not Channel_drag.
! Here the near-bottom viscosity is set to a value which will give
! the correct stress when the shear occurs over bbl_thick.
- bbl_thick = bbl_thick * H_to_m
+ bbl_thick_Z = bbl_thick * GV%H_to_Z
if (m==1) then
- visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick)
- visc%bbl_thick_u(I,j) = bbl_thick
+ visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z)
+ visc%bbl_thick_u(I,j) = bbl_thick_Z
else
- visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick)
- visc%bbl_thick_v(i,J) = bbl_thick
+ visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z)
+ visc%bbl_thick_v(i,J) = bbl_thick_Z
endif
endif
endif ; enddo ! end of i loop
@@ -916,25 +911,30 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize)
if (CS%debug) then
if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) &
- call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI,haloshift=0)
+ call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=GV%Z_to_m)
if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) &
- call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI,haloshift=0)
+ call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=GV%Z_to_m**2)
if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) &
call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, &
- visc%bbl_thick_v, G%HI,haloshift=0)
+ visc%bbl_thick_v, G%HI, haloshift=0, scale=GV%Z_to_m)
endif
end subroutine set_viscous_BBL
!> This subroutine finds a thickness-weighted value of v at the u-points.
function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- integer, intent(in) :: i, j, k
- real, dimension(SZI_(G),SZJB_(G)), intent(in) :: mask2dCv
- type(ocean_OBC_type), pointer :: OBC
- real :: set_v_at_u
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: v !< The meridional velocity, in m s-1
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ integer, intent(in) :: i !< The i-index of the u-location to work on.
+ integer, intent(in) :: j !< The j-index of the u-location to work on.
+ integer, intent(in) :: k !< The k-index of the u-location to work on.
+ real, dimension(SZI_(G),SZJB_(G)),&
+ intent(in) :: mask2dCv !< A multiplicative mask of the v-points
+ type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure
+ real :: set_v_at_u !< The retur value of v at u points, in m s-1.
! This subroutine finds a thickness-weighted value of v at the u-points.
real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v, in H.
@@ -967,12 +967,17 @@ end function set_v_at_u
!> This subroutine finds a thickness-weighted value of u at the v-points.
function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- integer, intent(in) :: i, j, k
- real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: mask2dCu
- type(ocean_OBC_type), pointer :: OBC
- real :: set_u_at_v
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: u !< The zonal velocity, in m s-1
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ integer, intent(in) :: i !< The i-index of the u-location to work on.
+ integer, intent(in) :: j !< The j-index of the u-location to work on.
+ integer, intent(in) :: k !< The k-index of the u-location to work on.
+ real, dimension(SZIB_(G),SZJ_(G)), &
+ intent(in) :: mask2dCu !< A multiplicative mask of the u-points
+ type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure
+ real :: set_u_at_v !< The return value of u at v points, in m s-1.
! This subroutine finds a thickness-weighted value of u at the v-points.
real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v, in H.
@@ -1002,11 +1007,11 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC)
end function set_u_at_v
-!> The following subroutine calculates the thickness of the surface boundary
-!! layer for applying an elevated viscosity. A bulk Richardson criterion or
-!! the thickness of the topmost NKML layers (with a bulk mixed layer) are
-!! currently used. The thicknesses are given in terms of fractional layers, so
-!! that this thickness will move as the thickness of the topmost layers change.
+!> Calculates the thickness of the surface boundary layer for applying an elevated viscosity.
+!!
+!! A bulk Richardson criterion or the thickness of the topmost NKML layers (with a bulk mixed layer)
+!! are currently used. The thicknesses are given in terms of fractional layers, so that this
+!! thickness will move as the thickness of the topmost layers change.
subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -1028,29 +1033,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations
!! of those values in visc that would be
!! calculated with symmetric memory.
-
-! The following subroutine calculates the thickness of the surface boundary
-! layer for applying an elevated viscosity. A bulk Richardson criterion or
-! the thickness of the topmost NKML layers (with a bulk mixed layer) are
-! currently used. The thicknesses are given in terms of fractional layers, so
-! that this thickness will move as the thickness of the topmost layers change.
-!
-! Arguments: u - Zonal velocity, in m s-1.
-! (in) v - Meridional velocity, in m s-1.
-! (in) h - Layer thickness, in m or kg m-2. In the comments below,
-! the units of h are denoted as H.
-! (in) tv - A structure containing pointers to any available
-! thermodynamic fields. Absent fields have NULL ptrs.
-! (in) forces - A structure containing pointers to mechanical
-! forcing fields. Unused fields have NULL ptrs.
-! (out) visc - A structure containing vertical viscosities and related
-! fields.
-! (in) dt - Time increment in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! vertvisc_init.
-
+ ! Local variables
real, dimension(SZIB_(G)) :: &
htot, & ! The total depth of the layers being that are within the
! surface mixed layer, in H.
@@ -1070,7 +1053,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
dR_dS, & ! Partial derivative of the density at the base of layer nkml
! (roughly the base of the mixed layer) with salinity, in units
! of kg m-3 psu-1.
- ustar, & ! The surface friction velocity under ice shelves, in m s-1.
+ ustar, & ! The surface friction velocity under ice shelves, in Z s-1.
press, & ! The pressure at which dR_dT and dR_dS are evaluated, in Pa.
T_EOS, & ! T_EOS and S_EOS are the potential temperature and salnity at which dR_dT and dR_dS
S_EOS ! which dR_dT and dR_dS are evaluated, in degC and PSU.
@@ -1098,6 +1081,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
! velocity magnitudes, in H m s-1.
real :: hweight ! The thickness of a layer that is within Hbbl
! of the bottom, in H.
+ real :: tbl_thick_Z ! The thickness of the top boundary layer in Z.
real :: hlay ! The layer thickness at velocity points, in H.
real :: I_2hlay ! 1 / 2*hlay, in H-1.
@@ -1120,7 +1104,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
real :: ustarsq ! 400 times the square of ustar, times
! Rho0 divided by G_Earth and the conversion
! from m to thickness units, in kg m-2 or kg2 m-5.
- real :: cdrag_sqrt ! Square root of the drag coefficient, nd.
+ real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion
+ ! factor from lateral lengths to vertical depths, in Z m-1.
+ real :: cdrag_sqrt ! Square root of the drag coefficient, ND.
real :: oldfn ! The integrated energy required to
! entrain up to the bottom of the layer,
! divided by G_Earth, in H kg m-3.
@@ -1134,12 +1120,11 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
real :: h_tiny ! A very small thickness, in H. Layers that are less than
! h_tiny can not be the deepest in the viscous mixed layer.
real :: absf ! The absolute value of f averaged to velocity points, s-1.
- real :: U_star ! The friction velocity at velocity points, in m s-1.
+ real :: U_star ! The friction velocity at velocity points, in Z s-1.
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected, in H.
- real :: Rho0x400_G ! 400*Rho0/G_Earth, in kg s2 m-4. The 400 is a
- ! constant proposed by Killworth and Edwards, 1999.
- real :: H_to_m, m_to_H ! Local copies of unit conversion factors.
+ real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2.
+ ! The 400 is a constant proposed by Killworth and Edwards, 1999.
real :: ustar1 ! ustar in units of H/s
real :: h2f2 ! (h*2*f)^2
logical :: use_EOS, do_any, do_any_shelf, do_i(SZIB_(G))
@@ -1159,17 +1144,17 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
Jsq = js-1 ; Isq = is-1
endif ; endif
- Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth)*GV%m_to_H
+ Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H
U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel
- cdrag_sqrt=sqrt(CS%cdrag)
+ cdrag_sqrt = sqrt(CS%cdrag)
+ cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag)
OBC => CS%OBC
use_EOS = associated(tv%eqn_of_state)
dt_Rho0 = dt/GV%H_to_kg_m2
h_neglect = GV%H_subroundoff
- h_tiny = 2.0*GV%Angstrom + h_neglect
- g_H_Rho0 = (GV%g_Earth * GV%H_to_m) / GV%Rho0
- H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H
+ h_tiny = 2.0*GV%Angstrom_H + h_neglect
+ g_H_Rho0 = (GV%g_Earth*GV%H_to_Z) / GV%Rho0
if (associated(forces%frac_shelf_u) .neqv. associated(forces%frac_shelf_v)) &
call MOM_error(FATAL, "set_viscous_ML: one of forces%frac_shelf_u and "//&
@@ -1178,29 +1163,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
if (associated(forces%frac_shelf_u)) then
! This configuration has ice shelves, and the appropriate variables need to
! be allocated.
- if (.not.associated(visc%tauy_shelf)) then
- allocate(visc%tauy_shelf(G%isd:G%ied,G%JsdB:G%JedB))
- visc%tauy_shelf(:,:) = 0.0
- endif
- if (.not.associated(visc%tbl_thick_shelf_u)) then
- allocate(visc%tbl_thick_shelf_u(G%IsdB:G%IedB,G%jsd:G%jed))
- visc%tbl_thick_shelf_u(:,:) = 0.0
- endif
- if (.not.associated(visc%tbl_thick_shelf_v)) then
- allocate(visc%tbl_thick_shelf_v(G%isd:G%ied,G%JsdB:G%JedB))
- visc%tbl_thick_shelf_v(:,:) = 0.0
- endif
- if (.not.associated(visc%kv_tbl_shelf_u)) then
- allocate(visc%kv_tbl_shelf_u(G%IsdB:G%IedB,G%jsd:G%jed))
- visc%kv_tbl_shelf_u(:,:) = 0.0
- endif
- if (.not.associated(visc%kv_tbl_shelf_v)) then
- allocate(visc%kv_tbl_shelf_v(G%isd:G%ied,G%JsdB:G%JedB))
- visc%kv_tbl_shelf_v(:,:) = 0.0
- endif
+ call safe_alloc_ptr(visc%tauy_shelf, G%isd, G%ied, G%JsdB, G%JedB)
+ call safe_alloc_ptr(visc%tbl_thick_shelf_u, G%IsdB, G%IedB, G%jsd, G%jed)
+ call safe_alloc_ptr(visc%tbl_thick_shelf_v, G%isd, G%ied, G%JsdB, G%JedB)
+ call safe_alloc_ptr(visc%kv_tbl_shelf_u, G%IsdB, G%IedB, G%jsd, G%jed)
+ call safe_alloc_ptr(visc%kv_tbl_shelf_v, G%isd, G%ied, G%JsdB, G%JedB)
! With a linear drag law, the friction velocity is already known.
-! if (CS%linear_drag) ustar(:) = cdrag_sqrt*CS%drag_bg_vel
+! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel
endif
!$OMP parallel do default(shared)
@@ -1231,16 +1201,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
endif
enddo ; endif
-!$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS, &
-!$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,js,je,OBC, &
-!$OMP H_to_m, m_to_H, Isq, Ieq, nz, U_bg_sq,mask_v, &
-!$OMP cdrag_sqrt,Rho0x400_G,nkml) &
-!$OMP private(do_any,htot,do_i,k_massive,Thtot,uhtot,vhtot,U_Star, &
-!$OMP Idecay_len_TKE,press,k2,I_2hlay,T_EOS,S_EOS,dR_dT, &
-!$OMP dR_dS,hlay,v_at_u,Uh2,T_lay,S_lay,gHprime, &
-!$OMP RiBulk,Shtot,Rhtot,absf,do_any_shelf, &
-!$OMP h_at_vel,ustar,htot_vel,hwtot,hutot,hweight,ustarsq, &
-!$OMP oldfn,Dfn,Dh,Rlay,Rlb,h2f2,ustar1)
+ !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, &
+ !$OMP h_neglect,h_tiny,g_H_Rho0,js,je,OBC,Isq,Ieq,nz, &
+ !$OMP U_bg_sq,mask_v,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml)
do j=js,je ! u-point loop
if (CS%dynamic_viscous_ML) then
do_any = .false.
@@ -1261,8 +1224,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
if (CS%omega_frac > 0.0) &
absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2)
endif
- U_Star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j)))
- Idecay_len_TKE(I) = ((absf / U_Star) * CS%TKE_decay) * H_to_m
+ U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))*GV%m_to_Z)
+ Idecay_len_TKE(I) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z
endif
enddo
@@ -1369,7 +1332,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
if (use_EOS .or. .not.CS%linear_drag) then ; do k=1,nz
if (htot_vel>=CS%Htbl_shelf) exit ! terminate the k loop
hweight = MIN(CS%Htbl_shelf - htot_vel, h_at_vel(i,k))
- if (hweight <= 1.5*GV%Angstrom + h_neglect) cycle
+ if (hweight <= 1.5*GV%Angstrom_H + h_neglect) cycle
htot_vel = htot_vel + h_at_vel(i,k)
hwtot = hwtot + hweight
@@ -1386,9 +1349,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
enddo ; endif
if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then
- ustar(I) = cdrag_sqrt*hutot/hwtot
+ ustar(I) = cdrag_sqrt_Z*hutot/hwtot
else
- ustar(I) = cdrag_sqrt*CS%drag_bg_vel
+ ustar(I) = cdrag_sqrt_Z*CS%drag_bg_vel
endif
if (use_EOS) then ; if (hwtot > 0.0) then
@@ -1458,32 +1421,24 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
htot(i) = htot(i) + h_at_vel(i,nz)
endif ! use_EOS
- !visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, &
+ !visc%tbl_thick_shelf_u(I,j) = GV%H_to_Z * max(CS%Htbl_shelf_min, &
! htot(I) / (0.5 + sqrt(0.25 + &
! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / &
- ! (ustar(i)*m_to_H)**2 )) )
- ustar1 = ustar(i)*m_to_H
+ ! (ustar(i)*GV%Z_to_H)**2 )) )
+ ustar1 = ustar(i)*GV%Z_to_H
h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2
- visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, &
+ tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, &
( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) )
- visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, &
- cdrag_sqrt*ustar(I)*visc%tbl_thick_shelf_u(I,j))
+ visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z
+ visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z)
endif ; enddo ! I-loop
endif ! do_any_shelf
enddo ! j-loop at u-points
-!$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS,&
-!$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,is,ie,OBC, &
-!$OMP Jsq,Jeq,nz,U_bg_sq,cdrag_sqrt,Rho0x400_G,nkml, &
-!$OMP m_to_H,H_to_m,mask_u) &
-!$OMP private(do_any,htot,do_i,k_massive,Thtot,vhtot,uhtot,absf,&
-!$OMP U_Star,Idecay_len_TKE,press,k2,I_2hlay,T_EOS, &
-!$OMP S_EOS,dR_dT, dR_dS,hlay,u_at_v,Uh2, &
-!$OMP T_lay,S_lay,gHprime,RiBulk,do_any_shelf, &
-!$OMP Shtot,Rhtot,ustar,h_at_vel,htot_vel,hwtot, &
-!$OMP hutot,hweight,ustarsq,oldfn,Dh,Rlay,Rlb,Dfn, &
-!$OMP h2f2,ustar1)
+ !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, &
+ !$OMP h_neglect,h_tiny,g_H_Rho0,is,ie,OBC,Jsq,Jeq,nz, &
+ !$OMP U_bg_sq,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml,mask_u)
do J=Jsq,Jeq ! v-point loop
if (CS%dynamic_viscous_ML) then
do_any = .false.
@@ -1505,8 +1460,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2)
endif
- U_Star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1)))
- Idecay_len_TKE(i) = ((absf / U_Star) * CS%TKE_decay) * H_to_m
+ U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))*GV%m_to_Z)
+ Idecay_len_TKE(i) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z
endif
enddo
@@ -1614,7 +1569,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
if (use_EOS .or. .not.CS%linear_drag) then ; do k=1,nz
if (htot_vel>=CS%Htbl_shelf) exit ! terminate the k loop
hweight = MIN(CS%Htbl_shelf - htot_vel, h_at_vel(i,k))
- if (hweight <= 1.5*GV%Angstrom + h_neglect) cycle
+ if (hweight <= 1.5*GV%Angstrom_H + h_neglect) cycle
htot_vel = htot_vel + h_at_vel(i,k)
hwtot = hwtot + hweight
@@ -1631,9 +1586,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
enddo ; endif
if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then
- ustar(i) = cdrag_sqrt*hutot/hwtot
+ ustar(i) = cdrag_sqrt_Z*hutot/hwtot
else
- ustar(i) = cdrag_sqrt*CS%drag_bg_vel
+ ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel
endif ; endif
if (use_EOS) then ; if (hwtot > 0.0) then
@@ -1703,16 +1658,17 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
htot(i) = htot(i) + h_at_vel(i,nz)
endif ! use_EOS
- !visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, &
+ !visc%tbl_thick_shelf_v(i,J) = GV%H_to_Z * max(CS%Htbl_shelf_min, &
! htot(i) / (0.5 + sqrt(0.25 + &
! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / &
- ! (ustar(i)*m_to_H)**2 )) )
- ustar1 = ustar(i)*m_to_H
+ ! (ustar(i)*GV%Z_to_H)**2 )) )
+ ustar1 = ustar(i)*GV%Z_to_H
h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2
- visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, &
+ tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, &
( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) )
- visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, &
- cdrag_sqrt*ustar(i)*visc%tbl_thick_shelf_v(i,J))
+ visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z
+ visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z)
+
endif ; enddo ! i-loop
endif ! do_any_shelf
@@ -1730,8 +1686,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize)
end subroutine set_viscous_ML
-!> This subroutine is used to register any fields associated with the
-!! vertvisc_type.
+!> Register any fields associated with the vertvisc_type.
subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -1740,34 +1695,27 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS)
type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical
!! viscosities and related fields.
!! Allocated here.
- type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control
- !! structure.
-! This subroutine is used to register any fields associated with the
-! vertvisc_type.
-! Arguments: HI - A horizontal index type structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (out) visc - A structure containing vertical viscosities and related
-! fields. Allocated here.
-! (in) restart_CS - A pointer to the restart control structure.
- type(vardesc) :: vd
- logical :: use_kappa_shear, adiabatic, useKPP, useEPBL
+ type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure.
+ ! Local variables
+ logical :: use_kappa_shear, KS_at_vertex
+ logical :: adiabatic, useKPP, useEPBL
logical :: use_CVMix_shear, MLE_use_PBL_MLD, use_CVMix_conv
integer :: isd, ied, jsd, jed, nz
+ real :: hfreeze !< If hfreeze > 0 (m), melt potential will be computed.
character(len=40) :: mdl = "MOM_set_visc" ! This module's name.
isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke
call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., &
do_not_log=.true.)
- use_kappa_shear = .false. ; use_CVMix_shear = .false.
+ use_kappa_shear = .false. ; KS_at_vertex = .false. ; use_CVMix_shear = .false.
useKPP = .false. ; useEPBL = .false. ; use_CVMix_conv = .false.
if (.not.adiabatic) then
use_kappa_shear = kappa_shear_is_used(param_file)
+ KS_at_vertex = kappa_shear_at_vertex(param_file)
use_CVMix_shear = CVMix_shear_is_used(param_file)
- use_CVMix_conv = CVMix_conv_is_used(param_file)
+ use_CVMix_conv = CVMix_conv_is_used(param_file)
call get_param(param_file, mdl, "USE_KPP", useKPP, &
"If true, turns on the [CVMix] KPP scheme of Large et al., 1984,\n"// &
"to calculate diffusivities and non-local transport in the OBL.", &
@@ -1779,44 +1727,61 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS)
endif
if (use_kappa_shear .or. useKPP .or. useEPBL .or. use_CVMix_shear .or. use_CVMix_conv) then
- allocate(visc%Kd_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kd_shear(:,:,:) = 0.0
- allocate(visc%TKE_turb(isd:ied,jsd:jed,nz+1)) ; visc%TKE_turb(:,:,:) = 0.0
- allocate(visc%Kv_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kv_shear(:,:,:) = 0.0
+ call safe_alloc_ptr(visc%Kd_shear, isd, ied, jsd, jed, nz+1)
+ call register_restart_field(visc%Kd_shear, "Kd_shear", .false., restart_CS, &
+ "Shear-driven turbulent diffusivity at interfaces", "m2 s-1", z_grid='i')
+ endif
+ if (useKPP .or. useEPBL .or. use_CVMix_shear .or. use_CVMix_conv .or. &
+ (use_kappa_shear .and. .not.KS_at_vertex )) then
+ call safe_alloc_ptr(visc%Kv_shear, isd, ied, jsd, jed, nz+1)
+ call register_restart_field(visc%Kv_shear, "Kv_shear", .false., restart_CS, &
+ "Shear-driven turbulent viscosity at interfaces", "m2 s-1", z_grid='i')
+ endif
+ if (use_kappa_shear .and. KS_at_vertex) then
+ call safe_alloc_ptr(visc%TKE_turb, HI%IsdB, HI%IedB, HI%JsdB, HI%JedB, nz+1)
+ call register_restart_field(visc%TKE_turb, "TKE_turb", .false., restart_CS, &
+ "Turbulent kinetic energy per unit mass at interfaces", "m2 s-2", &
+ hor_grid="Bu", z_grid='i')
+ call safe_alloc_ptr(visc%Kv_shear_Bu, HI%IsdB, HI%IedB, HI%JsdB, HI%JedB, nz+1)
+ call register_restart_field(visc%Kv_shear_Bu, "Kv_shear_Bu", .false., restart_CS, &
+ "Shear-driven turbulent viscosity at vertex interfaces", "m2 s-1", &
+ hor_grid="Bu", z_grid='i')
+ elseif (use_kappa_shear) then
+ call safe_alloc_ptr(visc%TKE_turb, isd, ied, jsd, jed, nz+1)
+ call register_restart_field(visc%TKE_turb, "TKE_turb", .false., restart_CS, &
+ "Turbulent kinetic energy per unit mass at interfaces", "m2 s-2", z_grid='i')
+ endif
! MOM_bkgnd_mixing is always used, so always allocate visc%Kv_slow. GMM
- allocate(visc%Kv_slow(isd:ied,jsd:jed,nz+1)) ; visc%Kv_slow(:,:,:) = 0.0
-
- vd = var_desc("Kd_shear","m2 s-1","Shear-driven turbulent diffusivity at interfaces", &
- hor_grid='h', z_grid='i')
- call register_restart_field(visc%Kd_shear, vd, .false., restart_CS)
-
- vd = var_desc("TKE_turb","m2 s-2","Turbulent kinetic energy per unit mass at interfaces", &
- hor_grid='h', z_grid='i')
- call register_restart_field(visc%TKE_turb, vd, .false., restart_CS)
- vd = var_desc("Kv_shear","m2 s-1","Shear-driven turbulent viscosity at interfaces", &
- hor_grid='h', z_grid='i')
- call register_restart_field(visc%Kv_shear, vd, .false., restart_CS)
- vd = var_desc("Kv_slow","m2 s-1","Vertical turbulent viscosity at interfaces due \n" // &
- " to slow processes", hor_grid='h', z_grid='i')
- call register_restart_field(visc%Kv_slow, vd, .false., restart_CS)
-
- endif
+ call safe_alloc_ptr(visc%Kv_slow, isd, ied, jsd, jed, nz+1)
+ call register_restart_field(visc%Kv_slow, "Kv_slow", .false., restart_CS, &
+ "Vertical turbulent viscosity at interfaces due to slow processes", &
+ "m2 s-1", z_grid='i')
- ! visc%MLD is used to communicate the state of the (e)PBL to the rest of the model
+ ! visc%MLD is used to communicate the state of the (e)PBL or KPP to the rest of the model
call get_param(param_file, mdl, "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, &
default=.false., do_not_log=.true.)
+ ! visc%MLD needs to be allocated when melt potential is computed (HFREEZE>0)
+ call get_param(param_file, mdl, "HFREEZE", hfreeze, &
+ default=-1.0, do_not_log=.true.)
+
if (MLE_use_PBL_MLD) then
- allocate(visc%MLD(isd:ied,jsd:jed)) ; visc%MLD(:,:) = 0.0
- vd = var_desc("MLD","m","Instantaneous active mixing layer depth", &
- hor_grid='h', z_grid='1')
- call register_restart_field(visc%MLD, vd, .false., restart_CS)
+ call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed)
+ call register_restart_field(visc%MLD, "MLD", .false., restart_CS, &
+ "Instantaneous active mixing layer depth", "m")
+ endif
+
+ if (hfreeze >= 0.0 .and. .not.MLE_use_PBL_MLD) then
+ call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed)
endif
+
end subroutine set_visc_register_restarts
-subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
+!> Initializes the MOM_set_visc control structure
+subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OBC)
type(time_type), target, intent(in) :: Time !< The current model time.
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
!! parameters.
@@ -1826,16 +1791,19 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
!! related fields. Allocated here.
type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control
!! structure for this module
- type(ocean_OBC_type), pointer :: OBC
-
- ! local variables
+ type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure.
+ type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure
+ ! Local variables
real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt
real :: Kv_background
real :: omega_frac_dflt
- integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, i, j, n
+ real :: Z_rescale ! A rescaling factor for heights from the representation in
+ ! a reastart fole to the internal representation in this run.
+ integer :: i, j, k, is, ie, js, je, n
+ integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz
logical :: use_kappa_shear, adiabatic, use_omega
logical :: use_CVMix_ddiff, differential_diffusion, use_KPP
- type(OBC_segment_type), pointer :: segment ! pointer to OBC segment type
+ type(OBC_segment_type), pointer :: segment => NULL() ! pointer to OBC segment type
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "MOM_set_visc" ! This module's name.
@@ -1849,16 +1817,15 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
CS%OBC => OBC
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
-
CS%diag => diag
-! Set default, read and log parameters
+ ! Set default, read and log parameters
call log_version(param_file, mdl, version, "")
CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false.
- use_kappa_shear = .false. !; adiabatic = .false. ! Needed? -AJA
differential_diffusion = .false.
call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, &
"If true, the bottom stress is calculated with a drag \n"//&
@@ -1884,8 +1851,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
endif
if (.not.adiabatic) then
- use_kappa_shear = kappa_shear_is_used(param_file)
- CS%RiNo_mix = use_kappa_shear
+ CS%RiNo_mix = kappa_shear_is_used(param_file)
call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differential_diffusion, &
"If true, increase diffusivitives for temperature or salt \n"//&
"based on double-diffusive paramaterization from MOM4/KPP.", &
@@ -1936,7 +1902,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
"The rotation rate of the earth.", units="s-1", &
default=7.2921e-5)
! This give a minimum decay scale that is typically much less than Angstrom.
- CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff)
+ CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff)
else
call get_param(param_file, mdl, "OMEGA", CS%omega, &
"The rotation rate of the earth.", units="s-1", &
@@ -1948,7 +1914,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
"viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//&
"the thickness over which near-bottom velocities are \n"//&
"averaged for the drag law if BOTTOMDRAGLAW is defined \n"//&
- "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.)
+ "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) ! Rescaled later
if (CS%bottomdraglaw) then
call get_param(param_file, mdl, "CDRAG", CS%cdrag, &
"CDRAG is the drag coefficient relating the magnitude of \n"//&
@@ -1970,16 +1936,19 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
"The minimum bottom boundary layer thickness that can be \n"//&
"used with BOTTOMDRAGLAW. This might be \n"//&
"Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//&
- "near-bottom viscosity.", units="m", default=0.0)
+ "near-bottom viscosity.", units="m", default=0.0) ! Rescaled later
call get_param(param_file, mdl, "HTBL_SHELF_MIN", CS%Htbl_shelf_min, &
"The minimum top boundary layer thickness that can be \n"//&
"used with BOTTOMDRAGLAW. This might be \n"//&
"Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//&
- "near-top viscosity.", units="m", default=CS%BBL_thick_min)
+ "near-top viscosity.", units="m", default=CS%BBL_thick_min, scale=GV%m_to_H)
call get_param(param_file, mdl, "HTBL_SHELF", CS%Htbl_shelf, &
"The thickness over which near-surface velocities are \n"//&
"averaged for the drag law under an ice shelf. By \n"//&
- "default this is the same as HBBL", units="m", default=CS%Hbbl)
+ "default this is the same as HBBL", units="m", default=CS%Hbbl, scale=GV%m_to_H)
+ ! These unit conversions are out outside the get_param calls because the are also defaults.
+ CS%Hbbl = CS%Hbbl * GV%m_to_H ! Rescale
+ CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H ! Rescale
call get_param(param_file, mdl, "KV", Kv_background, &
"The background kinematic viscosity in the interior. \n"//&
@@ -2006,10 +1975,10 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, &
"The minimum viscosities in the bottom boundary layer.", &
- units="m2 s-1", default=Kv_background)
+ units="m2 s-1", default=Kv_background, scale=GV%m_to_Z**2)
call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, &
"The minimum viscosities in the top boundary layer.", &
- units="m2 s-1", default=Kv_background)
+ units="m2 s-1", default=Kv_background, scale=GV%m_to_Z**2)
if (CS%Channel_drag) then
call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0)
@@ -2027,6 +1996,12 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
if (CS%c_Smag < 0.0) CS%c_Smag = 0.15
endif
+ if (CS%RiNo_mix .and. kappa_shear_at_vertex(param_file)) then
+ ! These are necessary for reproduciblity across restarts in non-symmetric mode.
+ call pass_var(visc%TKE_turb, G%Domain, position=CORNER, complete=.false.)
+ call pass_var(visc%Kv_shear_Bu, G%Domain, position=CORNER, complete=.true.)
+ endif
+
if (CS%bottomdraglaw) then
allocate(visc%bbl_thick_u(IsdB:IedB,jsd:jed)) ; visc%bbl_thick_u = 0.0
allocate(visc%kv_bbl_u(IsdB:IedB,jsd:jed)) ; visc%kv_bbl_u = 0.0
@@ -2036,21 +2011,21 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
allocate(visc%TKE_bbl(isd:ied,jsd:jed)) ; visc%TKE_bbl = 0.0
CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', &
- diag%axesCu1, Time, 'BBL thickness at u points', 'm')
+ diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=GV%Z_to_m)
CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, &
- Time, 'BBL viscosity at u points', 'm2 s-1')
+ Time, 'BBL viscosity at u points', 'm2 s-1', conversion=GV%Z_to_m**2)
CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', &
- diag%axesCv1, Time, 'BBL thickness at v points', 'm')
+ diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=GV%Z_to_m)
CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, &
- Time, 'BBL viscosity at v points', 'm2 s-1')
+ Time, 'BBL viscosity at v points', 'm2 s-1', conversion=GV%Z_to_m**2)
endif
if (CS%Channel_drag) then
allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0
allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz)) ; visc%Ray_v = 0.0
CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, &
- Time, 'Rayleigh drag velocity at u points', 'm s-1')
+ Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=GV%Z_to_m)
CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, &
- Time, 'Rayleigh drag velocity at v points', 'm s-1')
+ Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=GV%Z_to_m)
endif
if (use_CVMix_ddiff .or. differential_diffusion) then
@@ -2067,14 +2042,41 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC)
diag%axesCv1, Time, 'Number of layers in viscous mixed layer at v points', 'm')
endif
- CS%Hbbl = CS%Hbbl * GV%m_to_H
- CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H
+ if ((GV%m_to_Z_restart /= 0.0) .and. (GV%m_to_Z_restart /= GV%m_to_Z)) then
+ Z_rescale = GV%m_to_Z / GV%m_to_Z_restart
+ if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then
+ do k=1,nz+1 ; do j=js,je ; do i=is,ie
+ visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k)
+ enddo ; enddo ; enddo
+ endif ; endif
+
+ if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then
+ do k=1,nz+1 ; do j=js,je ; do i=is,ie
+ visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k)
+ enddo ; enddo ; enddo
+ endif ; endif
+
+ if (associated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then
+ do k=1,nz+1 ; do j=js,je ; do i=is,ie
+ visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k)
+ enddo ; enddo ; enddo
+ endif ; endif
+
+ if (associated(visc%Kv_slow)) then ; if (query_initialized(visc%Kv_slow, "Kv_slow", restart_CS)) then
+ do k=1,nz+1 ; do j=js,je ; do i=is,ie
+ visc%Kv_slow(i,j,k) = Z_rescale**2 * visc%Kv_slow(i,j,k)
+ enddo ; enddo ; enddo
+ endif ; endif
+ endif
end subroutine set_visc_init
+!> This subroutine dellocates any memory in the set_visc control structure.
subroutine set_visc_end(visc, CS)
- type(vertvisc_type), intent(inout) :: visc
- type(set_visc_CS), pointer :: CS
+ type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and
+ !! related fields. Elements are deallocated here.
+ type(set_visc_CS), pointer :: CS !< The control structure returned by a previous
+ !! call to vertvisc_init.
if (CS%bottomdraglaw) then
deallocate(visc%bbl_thick_u) ; deallocate(visc%bbl_thick_v)
deallocate(visc%kv_bbl_u) ; deallocate(visc%kv_bbl_v)
@@ -2089,6 +2091,7 @@ subroutine set_visc_end(visc, CS)
if (associated(visc%Kv_slow)) deallocate(visc%Kv_slow)
if (associated(visc%TKE_turb)) deallocate(visc%TKE_turb)
if (associated(visc%Kv_shear)) deallocate(visc%Kv_shear)
+ if (associated(visc%Kv_shear_Bu)) deallocate(visc%Kv_shear_Bu)
if (associated(visc%ustar_bbl)) deallocate(visc%ustar_bbl)
if (associated(visc%TKE_bbl)) deallocate(visc%TKE_bbl)
if (associated(visc%taux_shelf)) deallocate(visc%taux_shelf)
@@ -2101,37 +2104,12 @@ subroutine set_visc_end(visc, CS)
deallocate(CS)
end subroutine set_visc_end
-!> \namespace MOM_set_visc
-!!********+*********+*********+*********+*********+*********+*********+**
-!!* *
-!!* By Robert Hallberg, April 1994 - October 2006 *
-!!* Quadratic Bottom Drag by James Stephens and R. Hallberg. *
-!!* *
-!!* This file contains the subroutine that calculates various values *
-!!* related to the bottom boundary layer, such as the viscosity and *
-!!* thickness of the BBL (set_viscous_BBL). This would also be the *
-!!* module in which other viscous quantities that are flow-independent *
-!!* might be set. This information is transmitted to other modules *
-!!* via a vertvisc type structure. *
-!!* *
-!!* The same code is used for the two velocity components, by *
-!!* indirectly referencing the velocities and defining a handful of *
-!!* direction-specific defined variables. *
-!!* *
-!!* Macros written all in capital letters are defined in MOM_memory.h. *
-!!* *
-!!* A small fragment of the grid is shown below: *
-!!* *
-!!* j+1 x ^ x ^ x At x: q *
-!!* j+1 > o > o > At ^: v, frhatv, tauy *
-!!* j x ^ x ^ x At >: u, frhatu, taux *
-!!* j > o > o > At o: h *
-!!* j-1 x ^ x ^ x *
-!!* i-1 i i+1 At x & ^: *
-!!* i i+1 At > & o: *
-!!* *
-!!* The boundaries always run through q grid points (x). *
-!!* *
-!!********+*********+*********+*********+*********+*********+*********+**
+!> \namespace mom_set_visc
+!!
+!! This would also be the module in which other viscous quantities that are flow-independent might be set.
+!! This information is transmitted to other modules via a vertvisc type structure.
+!!
+!! The same code is used for the two velocity components, by indirectly referencing the velocities and
+!! defining a handful of direction-specific defined variables.
end module MOM_set_visc
diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90
index f0695785f8..410a41583a 100644
--- a/src/parameterizations/vertical/MOM_shortwave_abs.F90
+++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90
@@ -1,3 +1,4 @@
+!> Absorption of downwelling shortwave radiation
module MOM_shortwave_abs
! This file is part of MOM6. See LICENSE.md for the license.
@@ -13,42 +14,38 @@ module MOM_shortwave_abs
public absorbRemainingSW, sumSWoverBands
+!> This type is used to exchange information about ocean optical properties
type, public :: optics_type
! ocean optical properties
- integer :: nbands ! number of penetrating bands of SW radiation
+ integer :: nbands !< number of penetrating bands of SW radiation
- real, pointer, dimension(:,:,:,:) :: &
- opacity_band => NULL() ! SW optical depth per unit thickness (1/m)
- ! Number of radiation bands is most rapidly varying (first) index.
+ real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness (1/m)
+ !! The number of radiation bands is most rapidly varying (first) index.
- real, pointer, dimension(:,:,:) :: &
- SW_pen_band => NULL() ! shortwave radiation (W/m^2) at the surface in each of
- ! the nbands bands that penetrates beyond the surface.
- ! The most rapidly varying dimension is the band.
+ real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation (W/m^2) at the surface
+ !! in each of the nbands bands that penetrates beyond the surface.
+ !! The most rapidly varying dimension is the band.
- real, pointer, dimension(:) :: &
- min_wavelength_band => NULL(), & ! The range of wavelengths in each band of
- max_wavelength_band => NULL() ! penetrating shortwave radiation (nm)
+ real, pointer, dimension(:) :: &
+ min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation (nm)
+ max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation (nm)
end type optics_type
-
contains
-!> Apply shortwave heating below surface boundary layer.
+!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted
+!! from GOLD) or throughout the water column.
+!!
+!! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total
+!! water column thickness is greater than H_limit_fluxes.
+!! For thinner water columns, the heating is scaled down proportionately, the assumption being that the
+!! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer.
subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, &
adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, &
eps, ksort, htot, Ttot, TKE, dSV_dT)
-!< This subroutine applies shortwave heating below the boundary layer (when running
-!! with the bulk mixed layer from GOLD) or throughout the water column. In
-!! addition, it causes all of the remaining SW radiation to be absorbed,
-!! provided that the total water column thickness is greater than
-!! H_limit_fluxes. For thinner water columns, the heating is scaled down
-!! proportionately, the assumption being that the remaining heating (which is
-!! left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer.
-
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or
@@ -85,60 +82,18 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes,
!! will be redistributed through the
!! water column (units of K*H), size
!! nsw x SZI_(G).
- real, dimension(SZI_(G),SZK_(G)), &
- optional, intent(in) :: eps !< Small thickness that must remain in
+ real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in
!! each layer, and which will not be
!! subject to heating (units of H)
- integer, dimension(SZI_(G),SZK_(G)), &
- optional, intent(in) :: ksort !< Density-sorted k-indicies.
- real, dimension(SZI_(G)), &
- optional, intent(in) :: htot !< Total mixed layer thickness, in H .
- real, dimension(SZI_(G)), &
- optional, intent(inout) :: Ttot !< Depth integrated mixed layer
+ integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies.
+ real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness, in H .
+ real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer
!! temperature (units of K H).
- real, dimension(SZI_(G),SZK_(G)), &
- optional, intent(in) :: dSV_dT !< The partial derivative of specific
- !! volume with temperature, in m3 kg-1
- !! K-1.
- real, dimension(SZI_(G),SZK_(G)), &
- optional, intent(inout) :: TKE !< The TKE sink from mixing the heating
+ real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific
+ !! volume with temperature, in m3 kg-1 K-1.
+ real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating
!! throughout a layer, in J m-2.
-
-! Arguments:
-! (in) G = the ocean grid structure.
-! (in) GV = The ocean's vertical grid structure.
-! (in) h = the layer thicknesses, in m or kg m-2.
-! units of h are referred to as "H" below.
-! (in) opacity_band = opacity in each band of penetrating shortwave
-! radiation (1/H). The indicies are band, i, k.
-! (in) nsw = number of bands of penetrating shortwave radiation
-! (in) j = j-index to work on
-! (in) dt = time step (seconds)
-! (in) H_limit_fluxes = if the total ocean depth is less than this, they
-! are scaled away to avoid numerical instabilities. (H)
-! This would not be necessary if a finite heat
-! capacity mud-layer were added.
-! (in) adjustAbsorptionProfile = if true, apply heating above the layers
-! in which it should have occurred to get the correct
-! mean depth (and potential energy change) of the
-! shortwave that should be absorbed by each layer.
-! (in) absorbAllSW = if true, any shortwave radiation that hits the
-! bottom is absorbed uniformly over the water column.
-! (inout) T = layer potential/conservative temperatures (deg C)
-! (inout) Pen_SW_bnd = penetrating shortwave heating in each band that
-! hits the bottom and will be redistributed through
-! the water column (units of K*H), size nsw x SZI_(G).
-
-! These optional arguments apply when the bulk mixed layer is used
-! but are unnecessary with other schemes.
-! (in,opt) eps = small thickness that must remain in each layer, and
-! which will not be subject to heating (units of H)
-! (inout,opt) ksort = density-sorted k-indicies
-! (in,opt) htot = total mixed layer thickness, in H
-! (inout,opt) Ttot = depth integrated mixed layer temperature (units of K H)
-! (in,opt) dSV_dT = the partial derivative of specific volume with temperature, in m3 kg-1 K-1.
-! (inout,opt) TKE = the TKE sink from mixing the heating throughout a layer, in J m-2.
-
+ ! Local variables
real, dimension(SZI_(G),SZK_(G)) :: &
T_chg_above ! A temperature change that will be applied to all the thick
! layers above a given layer, in K. This is only nonzero if
@@ -188,12 +143,12 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes,
min_SW_heating = 2.5e-11
- h_min_heat = 2.0*GV%Angstrom + GV%H_subroundoff
+ h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff
is = G%isc ; ie = G%iec ; nz = G%ke
C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0
TKE_calc = (present(TKE) .and. present(dSV_dT))
- g_Hconv2 = GV%g_Earth * GV%H_to_kg_m2**2
+ g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2
h_heat(:) = 0.0
if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif
@@ -346,37 +301,30 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, &
!< This subroutine calculates the total shortwave heat flux integrated over
!! bands as a function of depth. This routine is only called for computing
!! buoyancy fluxes for use in KPP. This routine does not updat e the state.
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m
- !! or kg m-2).
- real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of
- !! penetrating shortwave radiation,
- !! in m-1. The indicies are band, i, k.
- integer, intent(in) :: nsw !< number of bands of penetrating
- !! shortwave radiation.
- integer, intent(in) :: j !< j-index to work on.
- real, intent(in) :: dt !< Time step (seconds).
- real, intent(in) :: H_limit_fluxes
- logical, intent(in) :: absorbAllSW
- real, dimension(:,:), intent(in) :: iPen_SW_bnd
- real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: netPen ! Units of K H.
-
-! Arguments:
-! (in) G = ocean grid structure
-! (in) GV = The ocean's vertical grid structure.
-! (in) h = layer thickness (units of m or kg/m^2)
-! units of h are referred to as H below.
-! (in) opacity_band = opacity in each band of penetrating shortwave
-! radiation, in m-1. The indicies are band, i, k.
-! (in) nsw = number of bands of penetrating shortwave radiation
-! (in) j = j-index to work on
-! (in) dt = time step (seconds)
-! (inout) Pen_SW_bnd = penetrating shortwave heating in each band that
-! hits the bottom and will be redistributed through
-! the water column (K H units); size nsw x SZI_(G).
-! (out) netPen = attenuated flux at interfaces, summed over bands (K H units)
-
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ real, dimension(SZI_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
+ real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of
+ !! penetrating shortwave radiation,
+ !! in m-1. The indicies are band, i, k.
+ integer, intent(in) :: nsw !< number of bands of penetrating
+ !! shortwave radiation.
+ integer, intent(in) :: j !< j-index to work on.
+ real, intent(in) :: dt !< Time step (seconds).
+ real, intent(in) :: H_limit_fluxes !< the total depth at which the
+ !! surface fluxes start to be limited to avoid
+ !! excessive heating of a thin ocean (H units)
+ logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave
+ !! radiation is absorbed in the ocean water column.
+ real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave
+ !! heating in each band that hits the bottom and
+ !! will be redistributed through the water column
+ !! (K H units); size nsw x SZI_(G).
+ real, dimension(SZI_(G),SZK_(G)+1), &
+ intent(inout) :: netPen !< Net penetrating shortwave heat flux at each
+ !! interface, summed across all bands, in K H.
+ ! Local variables
real :: h_heat(SZI_(G)) ! thickness of the water column that receives
! remaining shortwave radiation, in H.
real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the
@@ -400,7 +348,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, &
integer :: is, ie, nz, i, k, ks, n
SW_Remains = .false.
- h_min_heat = 2.0*GV%Angstrom + GV%H_subroundoff
+ h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff
is = G%isc ; ie = G%iec ; nz = G%ke
pen_SW_bnd(:,:) = iPen_SW_bnd(:,:)
diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90
index 3e55557c89..8bb8fa3ef3 100644
--- a/src/parameterizations/vertical/MOM_sponge.F90
+++ b/src/parameterizations/vertical/MOM_sponge.F90
@@ -1,59 +1,8 @@
+!> Implements sponge regions in isopycnal mode
module MOM_sponge
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, March 1999-June 2000 *
-!* *
-!* This program contains the subroutines that implement sponge *
-!* regions, in which the stratification and water mass properties *
-!* are damped toward some profiles. There are three externally *
-!* callable subroutines in this file. *
-!* *
-!* initialize_sponge determines the mapping from the model *
-!* variables into the arrays of damped columns. This remapping is *
-!* done for efficiency and to conserve memory. Only columns which *
-!* have positive inverse damping times and which are deeper than a *
-!* supplied depth are placed in sponges. The inverse damping *
-!* time is also stored in this subroutine, and memory is allocated *
-!* for all of the reference profiles which will subsequently be *
-!* provided through calls to set_up_sponge_field. The first two *
-!* arguments are a two-dimensional array containing the damping *
-!* rates, and the interface heights to damp towards. *
-!* *
-!* set_up_sponge_field is called to provide a reference profile *
-!* and the location of the field that will be damped back toward *
-!* that reference profile. A third argument, the number of layers *
-!* in the field is also provided, but this should always be nz. *
-!* *
-!* Apply_sponge damps all of the fields that have been registered *
-!* with set_up_sponge_field toward their reference profiles. The *
-!* four arguments are the thickness to be damped, the amount of time *
-!* over which the damping occurs, and arrays to which the movement *
-!* of fluid into a layer from above and below will be added. The *
-!* effect on momentum of the sponge may be accounted for later using *
-!* the movement of water recorded in these later arrays. *
-!* *
-!* All of the variables operated upon in this file are defined at *
-!* the thickness points. *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, T, S, Iresttime, ea, eb *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_coms, only : sum_across_PEs
use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field
use MOM_diag_mediator, only : diag_ctrl
@@ -73,49 +22,54 @@ module MOM_sponge
public set_up_sponge_field, set_up_sponge_ML_density
public initialize_sponge, apply_sponge, sponge_end, init_sponge_diags
-type :: p3d
- real, dimension(:,:,:), pointer :: p => NULL()
+!> A structure for creating arrays of pointers to 3D arrays
+type, public :: p3d
+ real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3D array
end type p3d
-type :: p2d
- real, dimension(:,:), pointer :: p => NULL()
+!> A structure for creating arrays of pointers to 2D arrays
+type, public :: p2d
+ real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array
end type p2d
+!> This control structure holds memory and parameters for the MOM_sponge module
type, public :: sponge_CS ; private
- logical :: bulkmixedlayer ! If true, a refined bulk mixed layer is used with
- ! nkml sublayers and nkbl buffer layer.
- integer :: nz ! The total number of layers.
- integer :: isc, iec, jsc, jec ! The index ranges of the computational domain.
- integer :: isd, ied, jsd, jed ! The index ranges of the data domain.
- integer :: num_col ! The number of sponge points within the
- ! computational domain.
- integer :: fldno = 0 ! The number of fields which have already been
- ! registered by calls to set_up_sponge_field
- integer, pointer :: col_i(:) => NULL() ! Arrays containing the i- and j- indicies
- integer, pointer :: col_j(:) => NULL() ! of each of the columns being damped.
- real, pointer :: Iresttime_col(:) => NULL() ! The inverse restoring time of
- ! each column.
- real, pointer :: Rcv_ml_ref(:) => NULL() ! The value toward which the mixed layer
- ! coordinate-density is being damped, in kg m-3.
- real, pointer :: Ref_eta(:,:) => NULL() ! The value toward which the interface
- ! heights are being damped, in m.
- type(p3d) :: var(MAX_FIELDS_) ! Pointers to the fields that are being damped.
- type(p2d) :: Ref_val(MAX_FIELDS_) ! The values to which the fields are damped.
-
- logical :: do_i_mean_sponge ! If true, apply sponges to the i-mean fields.
- real, pointer :: Iresttime_im(:) => NULL() ! The inverse restoring time of
- ! each row for i-mean sponges.
- real, pointer :: Rcv_ml_ref_im(:) => NULL() ! The value toward which the i-mean
- ! mixed layer coordinate-density is being damped,
- ! in kg m-3.
- real, pointer :: Ref_eta_im(:,:) => NULL() ! The value toward which the i-mean
- ! interface heights are being damped, in m.
- type(p2d) :: Ref_val_im(MAX_FIELDS_) ! The values toward which the i-means of
- ! fields are damped.
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- integer :: id_w_sponge = -1
-
+ logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with
+ !! nkml sublayers and nkbl buffer layer.
+ integer :: nz !< The total number of layers.
+ integer :: isc !< The starting i-index of the computational domain at h.
+ integer :: iec !< The ending i-index of the computational domain at h.
+ integer :: jsc !< The starting j-index of the computational domain at h.
+ integer :: jec !< The ending j-index of the computational domain at h.
+ integer :: isd !< The starting i-index of the data domain at h.
+ integer :: ied !< The ending i-index of the data domain at h.
+ integer :: jsd !< The starting j-index of the data domain at h.
+ integer :: jed !< The ending j-index of the data domain at h.
+ integer :: num_col !< The number of sponge points within the computational domain.
+ integer :: fldno = 0 !< The number of fields which have already been
+ !! registered by calls to set_up_sponge_field
+ integer, pointer :: col_i(:) => NULL() !< Array of the i-indicies of each of the columns being damped.
+ integer, pointer :: col_j(:) => NULL() !< Array of the j-indicies of each of the columns being damped.
+ real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each column.
+ real, pointer :: Rcv_ml_ref(:) => NULL() !< The value toward which the mixed layer
+ !! coordinate-density is being damped, in kg m-3.
+ real, pointer :: Ref_eta(:,:) => NULL() !< The value toward which the interface
+ !! heights are being damped, in depth units (Z).
+ type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped.
+ type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped.
+
+ logical :: do_i_mean_sponge !< If true, apply sponges to the i-mean fields.
+ real, pointer :: Iresttime_im(:) => NULL() !< The inverse restoring time of
+ !! each row for i-mean sponges.
+ real, pointer :: Rcv_ml_ref_im(:) => NULL() !! The value toward which the i-mean
+ !< mixed layer coordinate-density is being damped, in kg m-3.
+ real, pointer :: Ref_eta_im(:,:) => NULL() !< The value toward which the i-mean
+ !! interface heights are being damped, in depth units (Z).
+ type(p2d) :: Ref_val_im(MAX_FIELDS_) !< The values toward which the i-means of
+ !! fields are damped.
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ integer :: id_w_sponge = -1 !< A diagnostic ID
end type sponge_CS
contains
@@ -125,16 +79,23 @@ module MOM_sponge
!! positive values of Iresttime and which mask2dT indicates are ocean
!! points are included in the sponges. It also stores the target interface
!! heights.
-subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, &
+subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, &
Iresttime_i_mean, int_height_i_mean)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: int_height !< The interface heights to damp back toward, in m.
- type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control
- !! structure for this module
- real, dimension(SZJ_(G)), optional, intent(in) :: Iresttime_i_mean
- real, dimension(SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_height_i_mean
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(in) :: Iresttime !< The inverse of the restoring time, in s-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), &
+ intent(in) :: int_height !< The interface heights to damp back toward, in depth units (Z).
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control
+ !! structure for this module
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZJ_(G)), &
+ optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for
+ !! the zonal mean properties, in s-1.
+ real, dimension(SZJ_(G),SZK_(G)+1), &
+ optional, intent(in) :: int_height_i_mean !< The interface heights toward which to
+ !! damp the zonal mean heights, in depth units (Z).
! This include declares and sets the variable "version".
@@ -167,8 +128,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, &
CS%do_i_mean_sponge = present(Iresttime_i_mean)
CS%nz = G%ke
- CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec
- CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed
+! CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec
+! CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed
! CS%bulkmixedlayer may be set later via a call to set_up_sponge_ML_density.
CS%bulkmixedlayer = .false.
@@ -242,15 +203,17 @@ end subroutine init_sponge_diags
!! whose address is given by f_ptr. nlay is the number of layers in
!! this variable.
subroutine set_up_sponge_field(sp_val, f_ptr, G, nlay, CS, sp_val_i_mean)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: sp_val !< The reference profiles of the quantity being
- !! registered.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr !< a pointer to the field which will be damped
- integer, intent(in) :: nlay !< the number of layers in this quantity
- type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that
- !! is set by a previous call to initialize_sponge.
- real, dimension(SZJ_(G),SZK_(G)), optional, intent(in) :: sp_val_i_mean !< The i-mean reference value for
- !! this field with i-mean sponges.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: sp_val !< The reference profiles of the quantity being registered.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ target, intent(in) :: f_ptr !< a pointer to the field which will be damped
+ integer, intent(in) :: nlay !< the number of layers in this quantity
+ type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that
+ !! is set by a previous call to initialize_sponge.
+ real, dimension(SZJ_(G),SZK_(G)),&
+ optional, intent(in) :: sp_val_i_mean !< The i-mean reference value for
+ !! this field with i-mean sponges.
integer :: j, k, col
character(len=256) :: mesg ! String for error messages
@@ -300,11 +263,17 @@ subroutine set_up_sponge_field(sp_val, f_ptr, G, nlay, CS, sp_val_i_mean)
end subroutine set_up_sponge_field
+!> This subroutine stores the reference value for mixed layer density. It is handled differently
+!! from other values because it is only used in determining which layers can be inflated.
subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sp_val
- type(sponge_CS), pointer :: CS
- real, dimension(SZJ_(G)), optional, intent(in) :: sp_val_i_mean
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(in) :: sp_val !< The reference values of the mixed layer density, in kg m-3
+ type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that is
+ !! set by a previous call to initialize_sponge.
+ real, dimension(SZJ_(G)), &
+ optional, intent(in) :: sp_val_i_mean !< the reference values of the zonal mean mixed
+ !! layer density in kg m-3, for use if Iresttime_i_mean > 0.
! This subroutine stores the reference value for mixed layer density. It is
! handled differently from other values because it is only used in determining
! which layers can be inflated.
@@ -341,50 +310,44 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean)
end subroutine set_up_sponge_ML_density
+!> This subroutine applies damping to the layers thicknesses, mixed layer buoyancy, and a variety of
+!! tracers for every column where there is damping.
subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
- type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- real, intent(in) :: dt
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: ea !< an array to which the amount of
- !! fluid entrained from the layer above during
- !! this call will be added, in H.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: eb !< an array to which the amount of
- !! fluid entrained from the layer below
- !! during this call will be added, in H.
- type(sponge_CS), pointer :: CS
- real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: Rcv_ml
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ real, intent(in) :: dt !< The amount of time covered by this call, in s.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: ea !< An array to which the amount of fluid entrained
+ !! from the layer above during this call will be
+ !! added, in H.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: eb !< An array to which the amount of fluid entrained
+ !! from the layer below during this call will be
+ !! added, in H.
+ type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module
+ !! that is set by a previous call to initialize_sponge.
+ real, dimension(SZI_(G),SZJ_(G)), &
+ optional, intent(inout) :: Rcv_ml !< The coordinate density of the mixed layer in kg m-2.
! This subroutine applies damping to the layers thicknesses, mixed
! layer buoyancy, and a variety of tracers for every column where
! there is damping.
-! Arguments: h - Layer thickness, in m.
-! (in) dt - The amount of time covered by this call, in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (out) ea - an array to which the amount of fluid entrained
-! from the layer above during this call will be
-! added, in H.
-! (out) eb - an array to which the amount of fluid entrained
-! from the layer below during this call will be
-! added, in H.
-! (in) CS - A pointer to the control structure for this module that is
-! set by a previous call to initialize_sponge.
-! (inout,opt) Rcv_ml - The coordinate density of the mixed layer.
-
+ ! Local variables
real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: &
w_int, & ! Water moved upward across an interface within a timestep,
! in H.
e_D ! Interface heights that are dilated to have a value of 0
- ! at the surface, in m.
+ ! at the surface, in the same units as G%bathyT (m or Z).
real, dimension(SZI_(G), SZJ_(G)) :: &
eta_anom, & ! Anomalies in the interface height, relative to the i-mean
- ! target value, in m.
+ ! target value, in depth units (Z).
fld_anom ! Anomalies in a tracer concentration, relative to the
! i-mean target value.
real, dimension(SZJ_(G), SZK_(G)+1) :: &
- eta_mean_anom ! The i-mean interface height anomalies, in m.
+ eta_mean_anom ! The i-mean interface height anomalies, in Z.
real, allocatable, dimension(:,:,:) :: &
fld_mean_anom ! THe i-mean tracer concentration anomalies.
real, dimension(SZI_(G), SZK_(G)+1) :: &
@@ -394,8 +357,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
dilate ! A nondimensional factor by which to dilate layers to
! give 0 at the surface.
- real :: e(SZK_(G)+1) ! The interface heights, in m, usually negative.
- real :: e0 ! The height of the free surface in m.
+ real :: e(SZK_(G)+1) ! The interface heights, in Z, usually negative.
+ real :: e0 ! The height of the free surface in Z.
real :: e_str ! A nondimensional amount by which the reference
! profile must be stretched for the free surfaces
! heights in the two profiles to agree.
@@ -432,7 +395,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
do j=js,je ; do i=is,ie ; e_D(i,j,nz+1) = -G%bathyT(i,j) ; enddo ; enddo
do k=nz,1,-1 ; do j=js,je ; do i=is,ie
- e_D(i,j,K) = e_D(i,j,K+1) + h(i,j,k)*GV%H_to_m
+ e_D(i,j,K) = e_D(i,j,K+1) + h(i,j,k)*GV%H_to_Z
enddo ; enddo ; enddo
do j=js,je
do i=is,ie
@@ -466,15 +429,15 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
h_above(i,1) = 0.0 ; h_below(i,nz+1) = 0.0
enddo
do K=nz,1,-1 ; do i=is,ie
- h_below(i,K) = h_below(i,K+1) + max(h(i,j,k)-GV%Angstrom, 0.0)
+ h_below(i,K) = h_below(i,K+1) + max(h(i,j,k)-GV%Angstrom_H, 0.0)
enddo ; enddo
do K=2,nz+1 ; do i=is,ie
- h_above(i,K) = h_above(i,K-1) + max(h(i,j,k-1)-GV%Angstrom, 0.0)
+ h_above(i,K) = h_above(i,K-1) + max(h(i,j,k-1)-GV%Angstrom_H, 0.0)
enddo ; enddo
do K=2,nz
! w is positive for an upward (lightward) flux of mass, resulting
! in the downward movement of an interface.
- w = damp_1pdamp * eta_mean_anom(j,K) * GV%m_to_H
+ w = damp_1pdamp * eta_mean_anom(j,K) * GV%Z_to_H
do i=is,ie
if (w > 0.0) then
w_int(i,j,K) = min(w, h_below(i,K))
@@ -496,7 +459,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
enddo
h(i,j,k) = max(h(i,j,k) + (w_int(i,j,K+1) - w_int(i,j,K)), &
- min(h(i,j,k), GV%Angstrom))
+ min(h(i,j,k), GV%Angstrom_H))
enddo ; enddo
endif ; enddo
@@ -512,7 +475,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
e(1) = 0.0 ; e0 = 0.0
do K=1,nz
- e(K+1) = e(K) - h(i,j,k)*GV%H_to_m
+ e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z
enddo
e_str = e(nz+1) / CS%Ref_eta(nz+1,c)
@@ -530,8 +493,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
wpb = 0.0; wb = 0.0
do k=nz,nkmb+1,-1
if (GV%Rlay(k) > Rcv_ml(i,j)) then
- w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, &
- ((wb + h(i,j,k)) - GV%Angstrom))
+ w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%Z_to_H, &
+ ((wb + h(i,j,k)) - GV%Angstrom_H))
wm = 0.5*(w-ABS(w))
do m=1,CS%fldno
CS%var(m)%p(i,j,k) = (h(i,j,k)*CS%var(m)%p(i,j,k) + &
@@ -543,7 +506,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
CS%var(m)%p(i,j,k) = I1pdamp * &
(CS%var(m)%p(i,j,k) + CS%Ref_val(m)%p(k,c)*damp)
enddo
- w = wb + (h(i,j,k) - GV%Angstrom)
+ w = wb + (h(i,j,k) - GV%Angstrom_H)
wm = 0.5*(w-ABS(w))
endif
eb(i,j,k) = eb(i,j,k) + wpb
@@ -555,7 +518,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
if (wb < 0) then
do k=nkmb,1,-1
- w = MIN((wb + (h(i,j,k) - GV%Angstrom)),0.0)
+ w = MIN((wb + (h(i,j,k) - GV%Angstrom_H)),0.0)
h(i,j,k) = h(i,j,k) + (wb - w)
ea(i,j,k) = ea(i,j,k) - w
wb = w
@@ -586,8 +549,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
wpb = 0.0
wb = 0.0
do k=nz,1,-1
- w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, &
- ((wb + h(i,j,k)) - GV%Angstrom))
+ w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%Z_to_H, &
+ ((wb + h(i,j,k)) - GV%Angstrom_H))
wm = 0.5*(w - ABS(w))
do m=1,CS%fldno
CS%var(m)%p(i,j,k) = (h(i,j,k)*CS%var(m)%p(i,j,k) + &
@@ -606,9 +569,9 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
if (associated(CS%diag)) then ; if (query_averaging_enabled(CS%diag)) then
if (CS%id_w_sponge > 0) then
- Idt = 1.0 / dt
+ Idt = GV%H_to_m / dt
do k=1,nz+1 ; do j=js,je ; do i=is,ie
- w_int(i,j,K) = w_int(i,j,K) * Idt * GV%H_to_m ! Scale values by clobbering array since it is local
+ w_int(i,j,K) = w_int(i,j,K) * Idt ! Scale values by clobbering array since it is local
enddo ; enddo ; enddo
call post_data(CS%id_w_sponge, w_int(:,:,:), CS%diag)
endif
@@ -616,10 +579,10 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml)
end subroutine apply_sponge
+!> This call deallocates any memory in the sponge control structure.
subroutine sponge_end(CS)
- type(sponge_CS), pointer :: CS
-! (in) CS - A pointer to the control structure for this module that is
-! set by a previous call to initialize_sponge.
+ type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module
+ !! that is set by a previous call to initialize_sponge.
integer :: m
if (.not.associated(CS)) return
@@ -645,4 +608,37 @@ subroutine sponge_end(CS)
end subroutine sponge_end
+!> \namespace mom_sponge
+!!
+!! By Robert Hallberg, March 1999-June 2000
+!!
+!! This program contains the subroutines that implement sponge
+!! regions, in which the stratification and water mass properties
+!! are damped toward some profiles. There are three externally
+!! callable subroutines in this file.
+!!
+!! initialize_sponge determines the mapping from the model
+!! variables into the arrays of damped columns. This remapping is
+!! done for efficiency and to conserve memory. Only columns which
+!! have positive inverse damping times and which are deeper than a
+!! supplied depth are placed in sponges. The inverse damping
+!! time is also stored in this subroutine, and memory is allocated
+!! for all of the reference profiles which will subsequently be
+!! provided through calls to set_up_sponge_field. The first two
+!! arguments are a two-dimensional array containing the damping
+!! rates, and the interface heights to damp towards.
+!!
+!! set_up_sponge_field is called to provide a reference profile
+!! and the location of the field that will be damped back toward
+!! that reference profile. A third argument, the number of layers
+!! in the field is also provided, but this should always be nz.
+!!
+!! Apply_sponge damps all of the fields that have been registered
+!! with set_up_sponge_field toward their reference profiles. The
+!! four arguments are the thickness to be damped, the amount of time
+!! over which the damping occurs, and arrays to which the movement
+!! of fluid into a layer from above and below will be added. The
+!! effect on momentum of the sponge may be accounted for later using
+!! the movement of water recorded in these later arrays.
+
end module MOM_sponge
diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90
index 226f7c4918..fba82d7f5d 100644
--- a/src/parameterizations/vertical/MOM_tidal_mixing.F90
+++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90
@@ -36,129 +36,132 @@ module MOM_tidal_mixing
public tidal_mixing_end
!> Containers for tidal mixing diagnostics
-type, public :: tidal_mixing_diags
- private
+type, public :: tidal_mixing_diags ; private
real, pointer, dimension(:,:,:) :: &
- Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s)
- Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3)
- Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces
- ! due to propagating low modes (m2/s) (BDM)
- Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation
- ! due to propagating low modes (m3/s3) (BDM)
- Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s)
- Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2)
- Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2)
- Kd_Lowmode_Work => NULL(),& ! layer integrated work by low mode driven mixing (W/m2) BDM
- N2_int => NULL(),&
- vert_dep_3d => NULL(),&
- Schmittner_coeff_3d => NULL(),&
- tidal_qe_md => NULL()
-
+ Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces (Z2 s-1)
+ Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation (m3 s-3)
+ Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces (Z2 s-1)
+ Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing (W m-2)
+ Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing (W m-2)
+ Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing (W m-2)
+ N2_int => NULL(),& !< Bouyancy frequency squared at interfaces (s-2)
+ vert_dep_3d => NULL(),& !< The 3-d mixing energy deposition (W m-3)
+ Schmittner_coeff_3d => NULL() !< The coefficient in the Schmittner et al mixing scheme, in UNITS?
+ real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally,
+ !! interpolated to model vertical coordinate (W m-3?)
+ real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces
+ !! due to propagating low modes (Z2/s)
+ real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent
+ !! dissipation due to propagating low modes (m3/s3)
real, pointer, dimension(:,:) :: &
- TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2)
- N2_bot => NULL(),& ! bottom squared buoyancy frequency (1/s2)
- N2_meanz => NULL(),& ! vertically averaged buoyancy frequency (1/s2)
- Polzin_decay_scale_scaled => NULL(),& ! vertical scale of decay for tidal dissipation
- Polzin_decay_scale => NULL(),& ! vertical decay scale for tidal diss with Polzin (meter)
- Simmons_coeff_2d => NULL()
+ TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom (W/m2)
+ N2_bot => NULL(),& !< bottom squared buoyancy frequency (1/s2)
+ N2_meanz => NULL(),& !< vertically averaged buoyancy frequency (1/s2)
+ Polzin_decay_scale_scaled => NULL(),& !< vertical scale of decay for tidal dissipation
+ Polzin_decay_scale => NULL(),& !< vertical decay scale for tidal diss with Polzin (meter)
+ Simmons_coeff_2d => NULL() !< The Simmons et al mixing coefficient
end type
-!> Control structure for tidal mixing module.
+!> Control structure with parameters for the tidal mixing module.
type, public :: tidal_mixing_cs
- logical :: debug = .true.
! TODO: private
+ logical :: debug = .true. !< If true, do more extensive debugging checks. This is hard-coded.
! Parameters
- logical :: int_tide_dissipation = .false. ! Internal tide conversion (from barotropic)
- ! with the schemes of St Laurent et al (2002)/
- ! Simmons et al (2004)
-
- integer :: Int_tide_profile ! A coded integer indicating the vertical profile
- ! for dissipation of the internal waves. Schemes that
- ! are currently encoded are St Laurent et al (2002) and
- ! Polzin (2009).
- logical :: Lee_wave_dissipation = .false. ! Enable lee-wave driven mixing, following
- ! Nikurashin (2010), with a vertical energy
- ! deposition profile specified by Lee_wave_profile.
- ! St Laurent et al (2002) or
- ! Simmons et al (2004) scheme
-
- integer :: Lee_wave_profile ! A coded integer indicating the vertical profile
- ! for dissipation of the lee waves. Schemes that are
- ! currently encoded are St Laurent et al (2002) and
- ! Polzin (2009).
- real :: Int_tide_decay_scale ! decay scale for internal wave TKE (meter)
-
- real :: Mu_itides ! efficiency for conversion of dissipation
- ! to potential energy (nondimensional)
-
- real :: Gamma_itides ! fraction of local dissipation (nondimensional)
-
- real :: Gamma_lee ! fraction of local dissipation for lee waves
- ! (Nikurashin's energy input) (nondimensional)
- real :: Decay_scale_factor_lee ! Scaling factor for the decay scale of lee
- ! wave energy dissipation (nondimensional)
-
- real :: min_zbot_itides ! minimum depth for internal tide conversion (meter)
- logical :: Lowmode_itidal_dissipation = .false. ! Internal tide conversion (from low modes)
- ! with the schemes of St Laurent et al (2002)/
- ! Simmons et al (2004) !BDM
-
- real :: Nu_Polzin ! The non-dimensional constant used in Polzin form of
- ! the vertical scale of decay of tidal dissipation
-
- real :: Nbotref_Polzin ! Reference value for the buoyancy frequency at the
- ! ocean bottom used in Polzin formulation of the
- ! vertical scale of decay of tidal dissipation (1/s)
- real :: Polzin_decay_scale_factor ! Scaling factor for the decay length scale
- ! of the tidal dissipation profile in Polzin
- ! (nondimensional)
- real :: Polzin_decay_scale_max_factor ! The decay length scale of tidal
- ! dissipation profile in Polzin formulation should not
- ! exceed Polzin_decay_scale_max_factor * depth of the
- ! ocean (nondimensional).
- real :: Polzin_min_decay_scale ! minimum decay scale of the tidal dissipation
- ! profile in Polzin formulation (meter)
-
- real :: TKE_itide_max ! maximum internal tide conversion (W m-2)
- ! available to mix above the BBL
-
- real :: utide ! constant tidal amplitude (m s-1) used if
- real :: kappa_itides ! topographic wavenumber and non-dimensional scaling
- real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height
- character(len=200) :: inputdir
-
- logical :: use_CVMix_tidal = .false. ! true if CVMix is to be used for determining
- ! diffusivity due to tidal mixing
-
- real :: min_thickness ! Minimum thickness allowed [m]
+ logical :: int_tide_dissipation = .false. !< Internal tide conversion (from barotropic)
+ !! with the schemes of St Laurent et al (2002) & Simmons et al (2004)
+
+ integer :: Int_tide_profile !< A coded integer indicating the vertical profile
+ !! for dissipation of the internal waves. Schemes that are
+ !! currently encoded are St Laurent et al (2002) and Polzin (2009).
+ logical :: Lee_wave_dissipation = .false. !< Enable lee-wave driven mixing, following
+ !! Nikurashin (2010), with a vertical energy
+ !! deposition profile specified by Lee_wave_profile to be
+ !! St Laurent et al (2002) or Simmons et al (2004) scheme
+
+ integer :: Lee_wave_profile !< A coded integer indicating the vertical profile
+ !! for dissipation of the lee waves. Schemes that are
+ !! currently encoded are St Laurent et al (2002) and
+ !! Polzin (2009).
+ real :: Int_tide_decay_scale !< decay scale for internal wave TKE (Z)
+
+ real :: Mu_itides !< efficiency for conversion of dissipation
+ !! to potential energy (nondimensional)
+
+ real :: Gamma_itides !< fraction of local dissipation (nondimensional)
+
+ real :: Gamma_lee !< fraction of local dissipation for lee waves
+ !! (Nikurashin's energy input) (nondimensional)
+ real :: Decay_scale_factor_lee !< Scaling factor for the decay scale of lee
+ !! wave energy dissipation (nondimensional)
+
+ real :: min_zbot_itides !< minimum depth for internal tide conversion (Z)
+ logical :: Lowmode_itidal_dissipation = .false. !< If true, consider mixing due to breaking low
+ !! modes that have been remotely generated using an internal tidal
+ !! dissipation scheme to specify the vertical profile of the energy
+ !! input to drive diapycnal mixing, along the lines of St. Laurent
+ !! et al. (2002) and Simmons et al. (2004).
+
+ real :: Nu_Polzin !< The non-dimensional constant used in Polzin form of
+ !! the vertical scale of decay of tidal dissipation
+
+ real :: Nbotref_Polzin !< Reference value for the buoyancy frequency at the
+ !! ocean bottom used in Polzin formulation of the
+ !! vertical scale of decay of tidal dissipation (1/s)
+ real :: Polzin_decay_scale_factor !< Scaling factor for the decay length scale
+ !! of the tidal dissipation profile in Polzin (nondimensional)
+ real :: Polzin_decay_scale_max_factor !< The decay length scale of tidal dissipation
+ !! profile in Polzin formulation should not exceed
+ !! Polzin_decay_scale_max_factor * depth of the ocean (nondimensional).
+ real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation
+ !! profile in Polzin formulation (Z)
+
+ real :: TKE_itide_max !< maximum internal tide conversion (W m-2)
+ !! available to mix above the BBL
+
+ real :: utide !< constant tidal amplitude (m s-1) used if
+ real :: kappa_itides !< topographic wavenumber and non-dimensional scaling, in Z-1
+ real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height
+ character(len=200) :: inputdir !< The directory in which to find input files
+
+ logical :: use_CVMix_tidal = .false. !< true if CVMix is to be used for determining
+ !! diffusivity due to tidal mixing
+
+ real :: min_thickness !< Minimum thickness allowed [m]
! CVMix-specific parameters
- integer :: CVMix_tidal_scheme = -1 ! 1 for Simmons, 2 for Schmittner
- type(CVMix_tidal_params_type) :: CVMix_tidal_params
- type(CVMix_global_params_type) :: CVMix_glb_params ! for Prandtl number only
- real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s]
- real :: tidal_diss_lim_tc ! dissipation limit for tidal-energy-constituent data
- type(remapping_CS) :: remap_cs
+ integer :: CVMix_tidal_scheme = -1 !< 1 for Simmons, 2 for Schmittner
+ type(CVMix_tidal_params_type) :: CVMix_tidal_params !< A CVMix-specific type with parameters for tidal mixing
+ type(CVMix_global_params_type) :: CVMix_glb_params !< CVMix-specific for Prandtl number only
+ real :: tidal_max_coef !< CVMix-specific maximum allowable tidal diffusivity. [m^2/s]
+ real :: tidal_diss_lim_tc !< CVMix-specific dissipation limit for
+ !! tidal-energy-constituent data
+ type(remapping_CS) :: remap_CS !< The control structure for remapping
! Data containers
- real, pointer, dimension(:,:) :: TKE_Niku => NULL()
- real, pointer, dimension(:,:) :: TKE_itidal => NULL()
- real, pointer, dimension(:,:) :: Nb => NULL()
- real, pointer, dimension(:,:) :: mask_itidal => NULL()
- real, pointer, dimension(:,:) :: h2 => NULL()
- real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m/s]
- real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m]
- real, allocatable ,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only
- real, allocatable ,dimension(:,:,:) :: tidal_qe_3d_in ! q*E(x,y)
+ real, pointer, dimension(:,:) :: TKE_Niku => NULL() !< Lee wave driven Turbulent Kinetic Energy input,
+ !! in W m-2
+ real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided
+ !! by the bottom stratfication, in J m-2.
+ real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency, in s-1.
+ real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input
+ real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance, in m2.
+ real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m/s]
+ real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m]
+ real, allocatable, dimension(:,:) :: tidal_qe_2d !< Tidal energy input times the local dissipation
+ !! fraction, q*E(x,y), with the CVMix implementation
+ !! of Jayne et al tidal mixing, in W m-2.
+ !! TODO: make this E(x,y) only
+ real, allocatable, dimension(:,:,:) :: tidal_qe_3d_in !< q*E(x,y,z) with the Schmittner parameterization, in W m-3?
! Diagnostics
- type(diag_ctrl), pointer :: diag => NULL() ! structure to regulate diagn output timing
- type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL()
- type(tidal_mixing_diags), pointer :: dd => NULL()
+ type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing
+ type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() !< A pointer to the control structure
+ !! for remapping diagnostics into Z-space
+ type(tidal_mixing_diags), pointer :: dd => NULL() !< A pointer to a structure of diagnostic arrays
- ! Diagnostic identifiers
+ !>@{ Diagnostic identifiers
integer :: id_TKE_itidal = -1
integer :: id_TKE_leewave = -1
integer :: id_Kd_itidal = -1
@@ -182,9 +185,11 @@ module MOM_tidal_mixing
integer :: id_Schmittner_coeff = -1
integer :: id_tidal_qe_md = -1
integer :: id_vert_dep = -1
+ !!@}
end type tidal_mixing_cs
+!!@{ Coded parmameters for specifying mixing schemes
character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name.
character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02"
character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09"
@@ -194,19 +199,19 @@ module MOM_tidal_mixing
character*(20), parameter :: SCHMITTNER_SCHEME_STRING = "SCHMITTNER"
integer, parameter :: SIMMONS = 1
integer, parameter :: SCHMITTNER = 2
+!!@}
contains
!> Initializes internal tidal dissipation scheme for diapycnal mixing
logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS)
-
type(time_type), intent(in) :: Time !< The current time.
type(ocean_grid_type), intent(in) :: G !< Grid structure.
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure.
type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure.
type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control
- type(tidal_mixing_cs), pointer :: CS !< This module's control structure.
+ type(tidal_mixing_cs), pointer :: CS !< This module's control structure.
! Local variables
logical :: read_tideamp
@@ -215,7 +220,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
character(len=200) :: filename, h2_file, Niku_TKE_input_file
character(len=200) :: tidal_energy_file, tideamp_file
type(vardesc) :: vd
- real :: utide, zbot, hamp, prandtl_tidal
+ real :: utide, hamp, prandtl_tidal
real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data
integer :: i, j, is, ie, js, je
integer :: isd, ied, jsd, jed
@@ -373,7 +378,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
"When the Polzin decay profile is used, this is the \n"//&
"minimum vertical decay scale for the vertical profile\n"//&
"of internal tide dissipation with the Polzin (2009) formulation", &
- units="m", default=0.0)
+ units="m", default=0.0, scale=GV%m_to_Z)
endif
if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then
@@ -381,7 +386,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
"The decay scale away from the bottom for tidal TKE with \n"//&
"the new coding when INT_TIDE_DISSIPATION is used.", &
!units="m", default=0.0)
- units="m", default=500.0) ! TODO: confirm this new default
+ units="m", default=500.0, scale=GV%m_to_Z) ! TODO: confirm this new default
call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, &
"A dimensionless turbulent mixing efficiency used with \n"//&
"INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2)
@@ -392,7 +397,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
units="nondim", default=0.3333)
call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, &
"Turn off internal tidal dissipation when the total \n"//&
- "ocean depth is less than this value.", units="m", default=0.0)
+ "ocean depth is less than this value.", units="m", default=0.0, scale=GV%m_to_Z)
endif
if ( (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) .and. &
@@ -406,7 +411,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, &
"A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//&
"The default is 2pi/10 km, as in St.Laurent et al. 2002.", &
- units="m-1", default=8.e-4*atan(1.0))
+ units="m-1", default=8.e-4*atan(1.0), scale=GV%Z_to_m)
call get_param(param_file, mdl, "UTIDE", CS%utide, &
"The constant tidal amplitude used with INT_TIDE_DISSIPATION.", &
@@ -443,22 +448,21 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
fail_if_missing=(.not.CS%use_CVMix_tidal))
filename = trim(CS%inputdir) // trim(h2_file)
call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename)
- call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1)
+ call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1, scale=GV%m_to_Z**2)
do j=js,je ; do i=is,ie
if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0
CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j)
! Restrict rms topo to 10 percent of column depth.
- zbot = G%bathyT(i,j)
- hamp = sqrt(CS%h2(i,j))
- hamp = min(0.1*zbot,hamp)
+ !### Note the hard-coded nondimensional constant, and that this could be simplified.
+ hamp = min(0.1*G%bathyT(i,j),sqrt(CS%h2(i,j)))
CS%h2(i,j) = hamp*hamp
utide = CS%tideamp(i,j)
! Compute the fixed part of internal tidal forcing; units are [kg s-2] here.
- CS%TKE_itidal(i,j) = 0.5*CS%kappa_h2_factor*GV%Rho0*&
- CS%kappa_itides*CS%h2(i,j)*utide*utide
+ CS%TKE_itidal(i,j) = 0.5*GV%Z_to_m * CS%kappa_h2_factor*GV%Rho0*&
+ CS%kappa_itides * CS%h2(i,j) * utide*utide
enddo ; enddo
endif
@@ -477,7 +481,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
filename = trim(CS%inputdir) // trim(Niku_TKE_input_file)
call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", &
filename)
- call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je); CS%TKE_Niku(:,:) = 0.0
+ 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
CS%TKE_Niku(:,:) = Niku_scale * CS%TKE_Niku(:,:)
@@ -538,10 +542,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
call CVMix_init_tidal(CVmix_tidal_params_user = CS%CVMix_tidal_params, &
mix_scheme = CVMix_tidal_scheme_str, &
efficiency = CS%Mu_itides, &
- vertical_decay_scale = CS%int_tide_decay_scale, &
+ vertical_decay_scale = CS%int_tide_decay_scale*GV%Z_to_m, &
max_coefficient = CS%tidal_max_coef, &
local_mixing_frac = CS%Gamma_itides, &
- depth_cutoff = CS%min_zbot_itides)
+ depth_cutoff = CS%min_zbot_itides*GV%Z_to_m)
call read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS)
@@ -555,12 +559,12 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
CS%Lowmode_itidal_dissipation) then
CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, &
- 'Internal Tide Driven Diffusivity', 'm2 s-1')
+ 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2)
if (CS%use_CVMix_tidal) then
CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, &
'Bouyancy frequency squared, at interfaces', 's-2')
- ! TODO: add units
+ !> TODO: add units
CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, &
'time-invariant portion of the tidal mixing coefficient using the Simmons', '')
CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTL,Time, &
@@ -577,7 +581,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
'Bottom Buoyancy Frequency', 's-1')
CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, &
- 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1')
+ 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1', conversion=GV%Z_to_m**2)
CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, &
'Vertical flux of tidal turbulent dissipation', 'm3 s-3')
@@ -586,12 +590,12 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3')
CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, &
- 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm')
+ 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm', conversion=GV%Z_to_m)
CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model', &
- 'Polzin_decay_scale_scaled',diag%axesT1,Time, &
+ 'Polzin_decay_scale_scaled', diag%axesT1, Time, &
'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, '// &
- 'scaled by N2_bot/N2_meanz', 'm')
+ 'scaled by N2_bot/N2_meanz', 'm', conversion=GV%Z_to_m)
CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, &
'Bottom Buoyancy frequency squared', 's-2')
@@ -612,24 +616,24 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp,
CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, &
'Lee wave Driven Turbulent Kinetic Energy', 'W m-2')
CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, &
- 'Lee Wave Driven Diffusivity', 'm2 s-1')
+ 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2)
endif
endif ! S%use_CVMix_tidal
if (associated(CS%diag_to_Z_CSp)) then
vd = var_desc("Kd_itides","m2 s-1", &
"Internal Tide Driven Diffusivity, interpolated to z", z_grid='z')
- CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time)
+ CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2)
if (CS%Lee_wave_dissipation) then
vd = var_desc("Kd_Nikurashin", "m2 s-1", &
"Lee Wave Driven Diffusivity, interpolated to z", z_grid='z')
- CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time)
+ CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2)
endif
if (CS%Lowmode_itidal_dissipation) then
vd = var_desc("Kd_lowmode","m2 s-1", &
"Internal Tide Driven Diffusivity (from low modes), interpolated to z",&
z_grid='z')
- CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time)
+ CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2)
endif
endif
@@ -642,56 +646,74 @@ end function tidal_mixing_init
!! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface
!! diffusivities.
subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, &
- N2_lay, N2_int, Kd, Kd_int, Kd_max, Kv)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- real, dimension(SZI_(G)), intent(in) :: N2_bot
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay
- real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int
- integer, intent(in) :: j
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd, max_TKE
- type(tidal_mixing_cs), pointer :: CS
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int
- real, intent(inout) :: Kd_max
- real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface
- !! (not layer!) in m2 s-1.
+ N2_lay, N2_int, Kd_lay, Kd_int, Kd_max, Kv)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy
+ !! frequency, in s-2.
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the
+ !! layers, in s-2.
+ real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy frequency at the
+ !! interfaces, in s-2.
+ integer, intent(in) :: j !< The j-index to work on
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE
+ !! TKE dissipated within a layer and the
+ !! diapycnal diffusivity witin that layer,
+ !! usually (~Rho_0 / (G_Earth * dRho_lay)),
+ !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain
+ !! to its maximum realizable thickness, in m3 s-3
+ type(tidal_mixing_cs), pointer :: CS !< The control structure for this module
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), &
+ optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1.
+ real, intent(in) :: Kd_max !< The maximum increment for diapycnal
+ !! diffusivity due to TKE-based processes, in Z2 s-1.
+ !! Set this to a negative value to have no limit.
+ real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface
+ !! (not layer!) in Z2 s-1.
if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then
if (CS%use_CVMix_tidal) then
- call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv)
+ call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv)
else
call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, &
- N2_lay, Kd, Kd_int, Kd_max)
+ N2_lay, Kd_lay, Kd_int, Kd_max)
endif
endif
-end subroutine
+end subroutine calculate_tidal_mixing
!> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven
!! mixing to the interface diffusivities.
-subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv)
- integer, intent(in) :: j
- type(ocean_grid_type), intent(in) :: G !< Grid structure.
- type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
- type(tidal_mixing_cs), pointer :: CS !< This module's control structure.
- real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd
- real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface
- !! (not layer!) in m2 s-1.
-
- ! local
- real, dimension(SZK_(G)+1) :: Kd_tidal !< tidal diffusivity [m2/s]
- real, dimension(SZK_(G)+1) :: Kv_tidal !< tidal viscosity [m2/s]
- real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition
- real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m)
+subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv)
+ integer, intent(in) :: j !< The j-index to work on
+ type(ocean_grid_type), intent(in) :: G !< Grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
+ type(tidal_mixing_cs), pointer :: CS !< This module's control structure.
+ real, dimension(SZI_(G),SZK_(G)+1), &
+ intent(in) :: N2_int !< The squared buoyancy frequency at the
+ !! interfaces, in s-2.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers, in Z2 s-1
+ real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface
+ !! (not layer!) in Z2 s-1.
+ ! Local variables
+ real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2/s]
+ real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2/s]
+ real, dimension(SZK_(G)+1) :: vert_dep ! vertical deposition
+ real, dimension(SZK_(G)+1) :: iFaceHeight ! Height of interfaces (m)
real, dimension(SZK_(G)+1) :: SchmittnerSocn
- real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m)
- real, dimension(SZK_(G)) :: tidal_qe_md !< Tidal dissipation energy interpolated from 3d input to model coordinates
+ real, dimension(SZK_(G)) :: cellHeight ! Height of cell centers (m)
+ real, dimension(SZK_(G)) :: tidal_qe_md ! Tidal dissipation energy interpolated from 3d input
+ ! to model coordinates
real, dimension(SZK_(G)) :: Schmittner_coeff
- real, dimension(SZK_(G)) :: h_m !< Cell thickness [m]
+ real, dimension(SZK_(G)) :: h_m ! Cell thickness [m]
real, allocatable, dimension(:,:) :: exp_hab_zetar
integer :: i, k, is, ie
@@ -699,7 +721,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv)
real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3]
! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW)
real :: h_neglect, h_neglect_edge
- type(tidal_mixing_diags), pointer :: dd
+ type(tidal_mixing_diags), pointer :: dd => NULL()
is = G%isc ; ie = G%iec
dd => CS%dd
@@ -714,7 +736,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv)
hcorr = 0.0
do k=1,G%ke
! cell center and cell bottom in meters (negative values in the ocean)
- dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment
+ dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment, rescaled to m for use by CVMix.
dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0)
hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0
dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness
@@ -750,13 +772,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv)
! Update diffusivity
do k=1,G%ke
- Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) )
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1.
enddo
- ! Update viscosity
+ ! Update viscosity with the proper unit conversion.
if (associated(Kv)) then
do k=1,G%ke+1
- Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k)
+ Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1.
enddo
endif
@@ -795,11 +817,10 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv)
iFaceHeight = 0.0 ! BBL is all relative to the surface
hcorr = 0.0
- h_m = h(i,j,:)*GV%H_to_m
do k=1,G%ke
+ h_m(k) = h(i,j,k)*GV%H_to_m ! Rescale thicknesses to m for use by CVmix.
! cell center and cell bottom in meters (negative values in the ocean)
- dh = h_m(k) ! Nominal thickness to use for increment
- dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0)
+ dh = h_m(k) + hcorr ! Nominal thickness less the accumulated error (could temporarily make dh<0)
hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0
dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness
cellHeight(k) = iFaceHeight(k) - 0.5 * dh
@@ -849,13 +870,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv)
! Update diffusivity
do k=1,G%ke
- Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) )
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1.
enddo
! Update viscosity
if (associated(Kv)) then
do k=1,G%ke+1
- Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k)
+ Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1.
enddo
endif
@@ -894,33 +915,46 @@ end subroutine calculate_CVMix_tidal
!! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction,
!! Froude-number-depending breaking, PSI, etc.).
subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, &
- N2_lay, Kd, Kd_int, Kd_max)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- real, dimension(SZI_(G)), intent(in) :: N2_bot
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay
- integer, intent(in) :: j
- real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd, max_TKE
- type(tidal_mixing_cs), pointer :: CS
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int
- real, intent(inout) :: Kd_max
+ N2_lay, Kd_lay, Kd_int, Kd_max)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency
+ !! frequency, in s-2.
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the
+ !! layers, in s-2.
+ integer, intent(in) :: j !< The j-index to work on
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE
+ !! TKE dissipated within a layer and the
+ !! diapycnal diffusivity witin that layer,
+ !! usually (~Rho_0 / (G_Earth * dRho_lay)),
+ !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3
+ real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain
+ !! to its maximum realizable thickness, in m3 s-3
+ type(tidal_mixing_cs), pointer :: CS !< The control structure for this module
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), &
+ optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1.
+ real, intent(in) :: Kd_max !< The maximum increment for diapycnal
+ !! diffusivity due to TKE-based processes, in Z2 s-1.
+ !! Set this to a negative value to have no limit.
! local
real, dimension(SZI_(G)) :: &
htot, & ! total thickness above or below a layer, or the
- ! integrated thickness in the BBL (meter)
- htot_WKB, & ! distance from top to bottom (meter) WKB scaled
+ ! integrated thickness in the BBL (Z)
+ htot_WKB, & ! distance from top to bottom (Z) WKB scaled
TKE_itidal_bot, & ! internal tide TKE at ocean bottom (m3/s3)
TKE_Niku_bot, & ! lee-wave TKE at ocean bottom (m3/s3)
TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes (m3/s3) (BDM)
Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean (nondim)
Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean (nondim)
Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean (nondim) (BDM)
- z0_Polzin, & ! TKE decay scale in Polzin formulation (meter)
- z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (meter)
+ z0_Polzin, & ! TKE decay scale in Polzin formulation (Z)
+ z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (Z)
! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z
! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz)
! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz
@@ -932,24 +966,25 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer (nondim)
TKE_frac_top_lowmode, &
! fraction of bottom TKE that should appear at top of a layer (nondim) (BDM)
- z_from_bot, & ! distance from bottom (meter)
- z_from_bot_WKB ! distance from bottom (meter), WKB scaled
+ z_from_bot, & ! distance from bottom (Z)
+ z_from_bot_WKB ! distance from bottom (Z), WKB scaled
real :: I_rho0 ! 1 / RHO0, (m3/kg)
- real :: Kd_add ! diffusivity to add in a layer (m2/sec)
+ real :: Kd_add ! diffusivity to add in a layer (Z2/sec)
real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) (m3/s3)
real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3)
real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM)
real :: frac_used ! fraction of TKE that can be used in a layer (nondim)
- real :: Izeta ! inverse of TKE decay scale (1/meter)
- real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/meter)
- real :: z0_psl ! temporary variable with units of meter
+ real :: Izeta ! inverse of TKE decay scale (1/Z)
+ real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/Z)
+ real :: z0_psl ! temporary variable with units of Z
real :: TKE_lowmode_tot ! TKE from all low modes (W/m2) (BDM)
logical :: use_Polzin, use_Simmons
+ character(len=160) :: mesg ! The text of an error message
integer :: i, k, is, ie, nz
integer :: a, fr, m
- type(tidal_mixing_diags), pointer :: dd
+ type(tidal_mixing_diags), pointer :: dd => NULL()
is = G%isc ; ie = G%iec ; nz = G%ke
dd => CS%dd
@@ -958,7 +993,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
do i=is,ie ; htot(i) = 0.0 ; Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 ;enddo
do k=1,nz ; do i=is,ie
- htot(i) = htot(i) + GV%H_to_m*h(i,j,k)
+ htot(i) = htot(i) + GV%H_to_Z*h(i,j,k)
enddo ; enddo
I_Rho0 = 1.0/GV%Rho0
@@ -973,9 +1008,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
! Calculate parameters for vertical structure of dissipation
! Simmons:
if ( use_Simmons ) then
- Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_m)
+ Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_Z)
Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, &
- GV%H_subroundoff*GV%H_to_m)
+ GV%H_subroundoff*GV%H_to_Z)
do i=is,ie
CS%Nb(i,j) = sqrt(N2_bot(i))
if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i)
@@ -994,7 +1029,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
Inv_int_low(i) = 1.0 / (1.0 - exp(-Izeta*htot(i)))
endif
endif
- z_from_bot(i) = GV%H_to_m*h(i,j,nz)
+ z_from_bot(i) = GV%H_to_Z*h(i,j,nz)
enddo
endif ! Simmons
@@ -1003,10 +1038,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
! WKB scaling of the vertical coordinate
do i=is,ie ; N2_meanz(i)=0.0 ; enddo
do k=1,nz ; do i=is,ie
- N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_m*h(i,j,k)
+ N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_Z*h(i,j,k)
enddo ; enddo
do i=is,ie
- N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_m)
+ N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z)
if (associated(dd%N2_meanz)) dd%N2_meanz(i,j) = N2_meanz(i)
enddo
@@ -1014,20 +1049,21 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
do i=is,ie ; htot_WKB(i) = htot(i) ; enddo
! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo
! do k=1,nz ; do i=is,ie
-! htot_WKB(i) = htot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k) / N2_meanz(i)
+! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k)*N2_lay(i,k) / N2_meanz(i)
! enddo ; enddo
! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler
do i=is,ie
CS%Nb(i,j) = sqrt(N2_bot(i))
+ !### In the code below 1.0e-14 is a dimensional constant in s-3
if ((CS%tideamp(i,j) > 0.0) .and. &
(CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then
- z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * &
+ z0_polzin(i) = GV%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * &
CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / &
( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 )
if (z0_polzin(i) < CS%Polzin_min_decay_scale) &
z0_polzin(i) = CS%Polzin_min_decay_scale
- if (N2_meanz(i) > 1.0e-14 ) then
+ if (N2_meanz(i) > 1.0e-14 ) then !### Here 1.0e-14 has dimensions of s-2.
z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i)
else
z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i)
@@ -1048,30 +1084,29 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then
! For the Polzin formulation, this if loop prevents the vertical
! flux of energy dissipation from having NaN values
- if (htot_WKB(i) > 1.0e-14) then
- Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1
+ if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant.
+ Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0
endif
endif
if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then
! For the Polzin formulation, this if loop prevents the vertical
! flux of energy dissipation from having NaN values
- if (htot_WKB(i) > 1.0e-14) then
- Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1
+ if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant.
+ Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0
endif
endif
if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then
! For the Polzin formulation, this if loop prevents the vertical
! flux of energy dissipation from having NaN values
- if (htot_WKB(i) > 1.0e-14) then
- Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1
+ if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant.
+ Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0
endif
endif
- z_from_bot(i) = GV%H_to_m*h(i,j,nz)
- ! Use the new formulation for WKB scaling. N2 is referenced to its
- ! vertical mean.
- if (N2_meanz(i) > 1.0e-14 ) then
- z_from_bot_WKB(i) = GV%H_to_m*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i)
+ z_from_bot(i) = GV%H_to_Z*h(i,j,nz)
+ ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean.
+ if (N2_meanz(i) > 1.0e-14 ) then !### Avoid using this dimensional constant.
+ z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i)
else ; z_from_bot_WKB(i) = 0 ; endif
enddo
endif ! Polzin
@@ -1097,8 +1132,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
! TODO: uncomment the following call and fix it
!call get_lowmode_loss(i,j,G,CS%int_tide_CSp,"WaveDrag",TKE_lowmode_tot)
- print *, "========", __FILE__, __LINE__
- call MOM_error(FATAL,"this block not supported yet. (aa)")
+ write (mesg,*) "========", __FILE__, __LINE__
+ call MOM_error(FATAL,trim(mesg)//": this block not supported yet. (aa)")
TKE_lowmode_bot(i) = CS%Mu_itides * I_rho0 * TKE_lowmode_tot
endif
@@ -1115,7 +1150,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
if ( use_Simmons ) then
do k=nz-1,2,-1 ; do i=is,ie
if (max_TKE(i,k) <= 0.0) cycle
- z_from_bot(i) = z_from_bot(i) + GV%H_to_m*h(i,j,k)
+ z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k)
! Fraction of bottom flux predicted to reach top of this layer
TKE_frac_top(i) = Inv_int(i) * exp(-Izeta * z_from_bot(i))
@@ -1130,10 +1165,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
! Actual power expended may be less than predicted if stratification is weak; adjust
if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then
- frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay)
- TKE_itide_lay = frac_used * TKE_itide_lay
- TKE_Niku_lay = frac_used * TKE_Niku_lay
- TKE_lowmode_lay = frac_used * TKE_lowmode_lay
+ frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay)
+ TKE_itide_lay = frac_used * TKE_itide_lay
+ TKE_Niku_lay = frac_used * TKE_Niku_lay
+ TKE_lowmode_lay = frac_used * TKE_lowmode_lay
endif
! Calculate vertical flux available to bottom of layer above
@@ -1145,7 +1180,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay)
if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max)
- Kd(i,j,k) = Kd(i,j,k) + Kd_add
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add
if (present(Kd_int)) then
Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add
@@ -1196,9 +1231,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
if ( use_Polzin ) then
do k=nz-1,2,-1 ; do i=is,ie
if (max_TKE(i,k) <= 0.0) cycle
- z_from_bot(i) = z_from_bot(i) + GV%H_to_m*h(i,j,k)
+ z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k)
if (N2_meanz(i) > 1.0e-14 ) then
- z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k)/N2_meanz(i)
+ z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_Z*h(i,j,k)*N2_lay(i,k)/N2_meanz(i)
else ; z_from_bot_WKB(i) = 0 ; endif
! Fraction of bottom flux predicted to reach top of this layer
@@ -1232,7 +1267,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,
Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay)
if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max)
- Kd(i,j,k) = Kd(i,j,k) + Kd_add
+ Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add
if (present(Kd_int)) then
Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add
@@ -1282,12 +1317,12 @@ end subroutine add_int_tide_diffusivity
!> Sets up diagnostics arrays for tidal mixing.
subroutine setup_tidal_diagnostics(G,CS)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(tidal_mixing_cs), pointer :: CS
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(tidal_mixing_cs), pointer :: CS !< The control structure for this module
! local
integer :: isd, ied, jsd, jed, nz
- type(tidal_mixing_diags), pointer :: dd
+ type(tidal_mixing_diags), pointer :: dd => NULL()
isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke
dd => CS%dd
@@ -1368,18 +1403,19 @@ subroutine setup_tidal_diagnostics(G,CS)
endif
end subroutine setup_tidal_diagnostics
-subroutine post_tidal_diagnostics(G,GV,h,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.
+!> This subroutine offers up diagnostics of the tidal mixing.
+subroutine post_tidal_diagnostics(G, GV, h ,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.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
- intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
- type(tidal_mixing_cs), pointer :: CS
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2).
+ type(tidal_mixing_cs), pointer :: CS !< The control structure for this module
! local
integer :: num_z_diags
integer :: z_ids(6) ! id numbers of diagns to be interpolated to depth space
type(p3d) :: z_ptrs(6) ! pointers to diagns to be interpolated into depth space
- type(tidal_mixing_diags), pointer :: dd
+ type(tidal_mixing_diags), pointer :: dd => NULL()
num_z_diags = 0
dd => CS%dd
@@ -1459,11 +1495,12 @@ subroutine post_tidal_diagnostics(G,GV,h,CS)
end subroutine post_tidal_diagnostics
! TODO: move this subroutine to MOM_internal_tide_input module (?)
+!> This subroutine read tidal energy inputs from a file.
subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- character(len=20), intent(in) :: tidal_energy_type
- character(len=200), intent(in) :: tidal_energy_file
- type(tidal_mixing_cs), pointer :: CS
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read
+ character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs
+ type(tidal_mixing_cs), pointer :: CS !< The control structure for this module
! local
integer :: isd, ied, jsd, jed, nz
real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2)
@@ -1478,19 +1515,18 @@ subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS)
CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d
deallocate(tidal_energy_flux_2d)
case ('ER03') ! Egbert & Ray 2003
- call read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS)
+ call read_tidal_constituents(G, tidal_energy_file, CS)
case default
call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.")
end select
end subroutine read_tidal_energy
-
-subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- character(len=20), intent(in) :: tidal_energy_type
- character(len=200), intent(in) :: tidal_energy_file
- type(tidal_mixing_cs), pointer :: CS
+!> This subroutine reads tidal input energy from a file by constituent.
+subroutine read_tidal_constituents(G, tidal_energy_file, CS)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidal energy inputs
+ type(tidal_mixing_cs), pointer :: CS !< The control structure for this module
! local
integer :: k, isd, ied, jsd, jed, i,j
@@ -1532,6 +1568,7 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS)
call MOM_read_data(tidal_energy_file, 'z_t', z_t)
call MOM_read_data(tidal_energy_file, 'z_w', z_w)
+ !### THE USE OF WHERE STTAEMENTS IS STRONGLY DISCOURAGED IN MOM6!
where (abs(G%geoLatT(:,:)) < 30.0)
tidal_qk1(:,:) = p33
tidal_qo1(:,:) = p33
@@ -1545,7 +1582,8 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS)
! input cell thickness
CS%h_src(k) = (z_t(k)-z_w(k))*2.0 *1e-2
! form tidal_qe_3d_in from weighted tidal constituents
- where ( (z_t(k)*1e-2) <= G%bathyT(:,:) .and. (z_w(k)*1e-2) > CS%tidal_diss_lim_tc)
+ !### THE USE OF WHERE STATEMENTS IS STRONGLY DISCOURAGED IN MOM6!
+ where (((z_t(k)*1e-2) <= G%bathyT(:,:)*G%Zd_to_m) .and. (z_w(k)*1e-2 > CS%tidal_diss_lim_tc))
CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + &
tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k)
endwhere
@@ -1555,11 +1593,11 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS)
!do j=G%jsd,G%jed
! do i=isd,ied
! if ( i+G%idg_offset .eq. 90 .and. j+G%jdg_offset .eq. 126) then
- ! print *, "-------------------------------------------"
+ ! write(1905,*) "-------------------------------------------"
! do k=50,nz_in(1)
! write(1905,*) i,j,k
! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k)
- ! write(1905,*) z_t(k), G%bathyT(i,j), z_w(k),CS%tidal_diss_lim_tc
+ ! write(1905,*) z_t(k), G%bathyT(i,j)*G%Zd_to_m, z_w(k),CS%tidal_diss_lim_tc
! end do
! endif
! enddo
@@ -1568,13 +1606,13 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS)
! test if qE is positive
if (any(CS%tidal_qe_3d_in<0.0)) then
- call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.")
+ call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.")
endif
!! collapse 3D q*E to 2D q*E
!CS%tidal_qe_2d = 0.0
!do k=1,nz_in(1)
- ! where (z_t(k) <= G%bathyT(:,:))
+ ! where (z_t(k) <= G%bathyT(:,:)*G%Zd_to_m)
! CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + CS%tidal_qe_3d_in(:,:,k)
! endwhere
!enddo
@@ -1592,10 +1630,10 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS)
end subroutine read_tidal_constituents
-
!> Clear pointers and deallocate memory
subroutine tidal_mixing_end(CS)
- type(tidal_mixing_cs), pointer :: CS ! This module's control structure
+ type(tidal_mixing_cs), pointer :: CS !< This module's control structure, which
+ !! will be deallocated in this routine.
if (.not.associated(CS)) return
diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90
index bafbe5eb59..57bf5a3ab6 100644
--- a/src/parameterizations/vertical/MOM_vert_friction.F90
+++ b/src/parameterizations/vertical/MOM_vert_friction.F90
@@ -29,10 +29,11 @@ module MOM_vert_friction
public vertvisc_limit_vel, vertvisc_init, vertvisc_end
public updateCFLtruncationValue
+!> The control structure with parameters and memory for the MOM_vert_friction module
type, public :: vertvisc_CS ; private
- real :: Hmix !< The mixed layer thickness in m.
+ real :: Hmix !< The mixed layer thickness in thickness units (H).
real :: Hmix_stress !< The mixed layer thickness over which the wind
- !! stress is applied with direct_stress, in m.
+ !! stress is applied with direct_stress, in H.
real :: Kvml !< The mixed layer vertical viscosity in m2 s-1.
real :: Kv !< The interior vertical viscosity in m2 s-1.
real :: Hbbl !< The static bottom boundary layer thickness, in m.
@@ -59,20 +60,17 @@ module MOM_vert_friction
type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: &
- a_u !< The u-drag coefficient across an interface, in m s-1.
+ a_u !< The u-drag coefficient across an interface, in Z s-1.
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: &
h_u !< The effective layer thickness at u-points, m or kg m-2.
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: &
- a_v !< The v-drag coefficient across an interface, in m s-1.
+ a_v !< The v-drag coefficient across an interface, in Z s-1.
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
h_v !< The effective layer thickness at v-points, m or kg m-2.
- !>@{
- !! The surface coupling coefficient under ice shelves
- !! in m s-1. Retained to determine stress under shelves.
- real, pointer, dimension(:,:) :: &
- a1_shelf_u => NULL(), &
- a1_shelf_v => NULL()
- !>@}
+ real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under
+ !! ice shelves in m s-1. Retained to determine stress under shelves.
+ real, pointer, dimension(:,:) :: a1_shelf_v => NULL() !< The v-momentum coupling coefficient under
+ !! ice shelves in m s-1. Retained to determine stress under shelves.
logical :: split !< If true, use the split time stepping scheme.
logical :: bottomdraglaw !< If true, the bottom stress is calculated with a
@@ -99,28 +97,28 @@ module MOM_vert_friction
!! thickness for viscosity.
logical :: debug !< If true, write verbose checksums for debugging purposes.
integer :: nkml !< The number of layers in the mixed layer.
- integer, pointer :: ntrunc !< The number of times the velocity has been
- !! truncated since the last call to write_energy.
- !>@{
- !! The complete path to files in which a column's worth of
- !! accelerations are written when velocity truncations occur.
- character(len=200) :: u_trunc_file
- character(len=200) :: v_trunc_file
- !>@}
+ integer, pointer :: ntrunc !< The number of times the velocity has been
+ !! truncated since the last call to write_energy.
+ character(len=200) :: u_trunc_file !< The complete path to a file in which a column of
+ !! u-accelerations are written if velocity truncations occur.
+ character(len=200) :: v_trunc_file !< The complete path to a file in which a column of
+ !! v-accelerations are written if velocity truncations occur.
+ logical :: StokesMixing !< If true, do Stokes drift mixing via the Lagrangian current
+ !! (Eulerian plus Stokes drift). False by default and set
+ !! via STOKES_MIXING_COMBINED.
type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
!! timing of diagnostic output.
- !>@{
- !! Diagnostic identifiers
+ !>@{ Diagnostic identifiers
integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1
integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1
integer :: id_Ray_u = -1, id_Ray_v = -1, id_taux_bot = -1, id_tauy_bot = -1
integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1
!>@}
- type(PointAccel_CS), pointer :: PointAccel_CSp => NULL()
- logical :: StokesMixing
+ type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() !< A pointer to the control structure
+ !! for recording accelerations leading to velocity truncations
end type vertvisc_CS
contains
@@ -143,12 +141,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
taux_bot, tauy_bot, Waves)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
- real, intent(inout), &
- dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u !< Zonal velocity in m s-1
- real, intent(inout), &
- dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: v !< Meridional velocity in m s-1
- real, intent(in), &
- dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Layer thickness in H
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(inout) :: u !< Zonal velocity in m s-1
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(inout) :: v !< Meridional velocity in m s-1
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h !< Layer thickness in H
type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
type(vertvisc_type), intent(inout) :: visc !< Viscosities and bottom drag
real, intent(in) :: dt !< Time increment in s
@@ -174,7 +172,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. c1 is nondimensional,
! while b1 has units of inverse thickness.
real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND.
- real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity in m s-1
+ real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity in Z s-1
real :: b_denom_1 ! The first term in the denominator of b1, in H.
real :: Hmix ! The mixed layer thickness over which stress
@@ -186,7 +184,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
! density, in s m3 kg-1.
real :: Rho0 ! A density used to convert drag laws into stress in
! Pa, in kg m-3.
- real :: dt_m_to_H ! The time step times the conversion from m to the
+ real :: dt_Z_to_H ! The time step times the conversion from Z to the
! units of thickness - either s or s m3 kg-1.
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected, in m or kg m-2.
@@ -209,24 +207,22 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
"Module must be initialized before it is used.")
if (CS%direct_stress) then
- Hmix = CS%Hmix_stress*GV%m_to_H
+ Hmix = CS%Hmix_stress
I_Hmix = 1.0 / Hmix
endif
dt_Rho0 = dt/GV%H_to_kg_m2
- dt_m_to_H = dt*GV%m_to_H
+ dt_Z_to_H = dt*GV%Z_to_H
Rho0 = GV%Rho0
h_neglect = GV%H_subroundoff
Idt = 1.0 / dt
!Check if Stokes mixing allowed if requested (present and associated)
+ DoStokesMixing=.false.
if (CS%StokesMixing) then
- DoStokesMixing=(present(Waves) .and. associated(Waves))
- if (.not.DoStokesMixing) then
+ if (present(Waves)) DoStokesMixing = associated(Waves)
+ if (.not. DoStokesMixing) &
call MOM_error(FATAL,"Stokes Mixing called without allocated"//&
- "Waves Control Structure")
- endif
- else
- DoStokesMixing=.false.
+ "Waves Control Structure")
endif
do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo
@@ -234,17 +230,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
! Update the zonal velocity component using a modification of a standard
! tridagonal solver.
- ! When mixing down Eulerian current + Stokes drift add before calling solver
- if (DoStokesMixing) then ; do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq
- if (G%mask2dCu(I,j) > 0) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k)
- enddo ; enddo ; enddo ; endif
-
!$OMP parallel do default(shared) firstprivate(Ray) &
!$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, &
!$OMP b_denom_1,b1,d1,c1)
do j=G%jsc,G%jec
do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo
+ ! When mixing down Eulerian current + Stokes drift add before calling solver
+ if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq
+ if (do_i(I)) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k)
+ enddo ; enddo ; endif
+
if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq
ADp%du_dt_visc(I,j,k) = u(I,j,k)
enddo ; enddo ; endif
@@ -278,9 +274,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
! and the superdiagonal as c_k. The right-hand side terms are d_k.
!
! ignoring the rayleigh drag contribution,
- ! we have a_k = -dt_m_to_H * a_u(k)
- ! b_k = h_u(k) + dt_m_to_H * (a_u(k) + a_u(k+1))
- ! c_k = -dt_m_to_H * a_u(k+1)
+ ! we have a_k = -dt_Z_to_H * a_u(k)
+ ! b_k = h_u(k) + dt_Z_to_H * (a_u(k) + a_u(k+1))
+ ! c_k = -dt_Z_to_H * a_u(k+1)
!
! for forward elimination, we want to:
! calculate c'_k = - c_k / (b_k + a_k c'_(k-1))
@@ -296,18 +292,18 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
! and the right-hand-side is destructively updated to be d'_k
!
do I=Isq,Ieq ; if (do_i(I)) then
- b_denom_1 = CS%h_u(I,j,1) + dt_m_to_H * (Ray(I,1) + CS%a_u(I,j,1))
- b1(I) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_u(I,j,2))
+ b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1))
+ b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2))
d1(I) = b_denom_1 * b1(I)
u(I,j,1) = b1(I) * (CS%h_u(I,j,1) * u(I,j,1) + surface_stress(I))
endif ; enddo
do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then
- c1(I,k) = dt_m_to_H * CS%a_u(I,j,K) * b1(I)
- b_denom_1 = CS%h_u(I,j,k) + dt_m_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I))
- b1(I) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_u(I,j,K+1))
+ c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K) * b1(I)
+ b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I))
+ b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1))
d1(I) = b_denom_1 * b1(I)
u(I,j,k) = (CS%h_u(I,j,k) * u(I,j,k) + &
- dt_m_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I)
+ dt_Z_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I)
endif ; enddo ; enddo
! back substitute to solve for the new velocities
@@ -332,19 +328,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
taux_bot(I,j) = taux_bot(I,j) + Rho0 * (Ray(I,k)*u(I,j,k))
enddo ; enddo ; endif
endif
- enddo ! end u-component j loop
- ! When mixing down Eulerian current + Stokes drift subtract after calling solver
- if (DoStokesMixing) then ; do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq
- if (G%mask2dCu(I,j) > 0) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k)
- enddo ; enddo ; enddo ; endif
+ ! When mixing down Eulerian current + Stokes drift subtract after calling solver
+ if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq
+ if (do_i(I)) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k)
+ enddo ; enddo ; endif
+
+ enddo ! end u-component j loop
! Now work on the meridional velocity component.
- ! When mixing down Eulerian current + Stokes drift add before calling solver
- if (DoStokesMixing) then ; do k=1,nz ; do j=Jsq,Jeq ; do I=Is,Ie
- if (G%mask2dCv(I,j) > 0) &
- v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k)
- enddo ; enddo ; enddo ; endif
!$OMP parallel do default(shared) firstprivate(Ray) &
!$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, &
@@ -352,6 +344,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
do J=Jsq,Jeq
do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo
+ ! When mixing down Eulerian current + Stokes drift add before calling solver
+ if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie
+ if (do_i(i)) v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k)
+ enddo ; enddo ; endif
+
if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie
ADp%dv_dt_visc(i,J,k) = v(i,J,k)
enddo ; enddo ; endif
@@ -380,18 +377,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
enddo ; enddo ; endif
do i=is,ie ; if (do_i(i)) then
- b_denom_1 = CS%h_v(i,J,1) + dt_m_to_H * (Ray(i,1) + CS%a_v(i,J,1))
- b1(i) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_v(i,J,2))
+ b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1))
+ b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2))
d1(i) = b_denom_1 * b1(i)
v(i,J,1) = b1(i) * (CS%h_v(i,J,1) * v(i,J,1) + surface_stress(i))
endif ; enddo
do k=2,nz ; do i=is,ie ; if (do_i(i)) then
- c1(i,k) = dt_m_to_H * CS%a_v(i,J,K) * b1(i)
- b_denom_1 = CS%h_v(i,J,k) + dt_m_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i))
- b1(i) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_v(i,J,K+1))
+ c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K) * b1(i)
+ b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i))
+ b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1))
d1(i) = b_denom_1 * b1(i)
- v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_m_to_H * &
- CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i)
+ v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i)
endif ; enddo ; enddo
do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then
v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1)
@@ -413,12 +409,13 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, &
tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (Ray(i,k)*v(i,J,k))
enddo ; enddo ; endif
endif
- enddo ! end of v-component J loop
- ! When mixing down Eulerian current + Stokes drift subtract after calling solver
- if (DoStokesMixing) then ; do k=1,nz ; do J=Jsq,Jeq ; do i=Is,Ie
- if (G%mask2dCv(i,J) > 0) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k)
- enddo ; enddo ; enddo ; endif
+ ! When mixing down Eulerian current + Stokes drift subtract after calling solver
+ if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie
+ if (do_i(i)) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k)
+ enddo ; enddo ; endif
+
+ enddo ! end of v-component J loop
call vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS)
@@ -460,15 +457,17 @@ end subroutine vertvisc
subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
- type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag
- !> Fraction of a time-step's worth of a barotopic acceleration that
- !! a layer experiences after viscosity is applied in the zonal direction
- real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: visc_rem_u
- !> Fraction of a time-step's worth of a barotopic acceleration that
- !! a layer experiences after viscosity is applied in the meridional direction
- real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: visc_rem_v
- real, intent(in) :: dt !< Time increment in s
- type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure
+ type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(inout) :: visc_rem_u !< Fraction of a time-step's worth of a
+ !! barotopic acceleration that a layer experiences
+ !! after viscosity is applied in the zonal direction
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(inout) :: visc_rem_v !< Fraction of a time-step's worth of a
+ !! barotopic acceleration that a layer experiences
+ !! after viscosity is applied in the meridional direction
+ real, intent(in) :: dt !< Time increment in s
+ type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure
! Local variables
@@ -479,7 +478,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS)
real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity times the
! time step, in m.
real :: b_denom_1 ! The first term in the denominator of b1, in m or kg m-2.
- real :: dt_m_to_H ! The time step times the conversion from m to the
+ real :: dt_Z_to_H ! The time step times the conversion from Z to the
! units of thickness - either s or s m3 kg-1.
logical :: do_i(SZIB_(G))
@@ -490,12 +489,12 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS)
if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// &
"Module must be initialized before it is used.")
- dt_m_to_H = dt*GV%m_to_H
+ dt_Z_to_H = dt*GV%Z_to_H
do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo
! Find the zonal viscous using a modification of a standard tridagonal solver.
-!$OMP parallel do default(none) shared(G,Isq,Ieq,CS,nz,visc,dt_m_to_H,visc_rem_u) &
+!$OMP parallel do default(none) shared(G,Isq,Ieq,CS,nz,visc,dt_Z_to_H,visc_rem_u) &
!$OMP firstprivate(Ray) &
!$OMP private(do_i,b_denom_1,b1,d1,c1)
do j=G%jsc,G%jec
@@ -506,17 +505,17 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS)
enddo ; enddo ; endif
do I=Isq,Ieq ; if (do_i(I)) then
- b_denom_1 = CS%h_u(I,j,1) + dt_m_to_H * (Ray(I,1) + CS%a_u(I,j,1))
- b1(I) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_u(I,j,2))
+ b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1))
+ b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2))
d1(I) = b_denom_1 * b1(I)
visc_rem_u(I,j,1) = b1(I) * CS%h_u(I,j,1)
endif ; enddo
do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then
- c1(I,k) = dt_m_to_H * CS%a_u(I,j,K)*b1(I)
- b_denom_1 = CS%h_u(I,j,k) + dt_m_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I))
- b1(I) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_u(I,j,K+1))
+ c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K)*b1(I)
+ b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I))
+ b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1))
d1(I) = b_denom_1 * b1(I)
- visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt_m_to_H * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I)
+ visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt_Z_to_H * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I)
endif ; enddo ; enddo
do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then
visc_rem_u(I,j,k) = visc_rem_u(I,j,k) + c1(I,k+1)*visc_rem_u(I,j,k+1)
@@ -526,7 +525,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS)
enddo ! end u-component j loop
! Now find the meridional viscous using a modification.
-!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,G,CS,visc,dt_m_to_H,visc_rem_v,nz) &
+!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,G,CS,visc,dt_Z_to_H,visc_rem_v,nz) &
!$OMP firstprivate(Ray) &
!$OMP private(do_i,b_denom_1,b1,d1,c1)
do J=Jsq,Jeq
@@ -537,17 +536,17 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS)
enddo ; enddo ; endif
do i=is,ie ; if (do_i(i)) then
- b_denom_1 = CS%h_v(i,J,1) + dt_m_to_H * (Ray(i,1) + CS%a_v(i,J,1))
- b1(i) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_v(i,J,2))
+ b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1))
+ b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2))
d1(i) = b_denom_1 * b1(i)
visc_rem_v(i,J,1) = b1(i) * CS%h_v(i,J,1)
endif ; enddo
do k=2,nz ; do i=is,ie ; if (do_i(i)) then
- c1(i,k) = dt_m_to_H * CS%a_v(i,J,K)*b1(i)
- b_denom_1 = CS%h_v(i,J,k) + dt_m_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i))
- b1(i) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_v(i,J,K+1))
+ c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K)*b1(i)
+ b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i))
+ b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1))
d1(i) = b_denom_1 * b1(i)
- visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_m_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i)
+ visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i)
endif ; enddo ; enddo
do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then
visc_rem_v(i,J,k) = visc_rem_v(i,J,k) + c1(i,k+1)*visc_rem_v(i,J,k+1)
@@ -565,19 +564,19 @@ end subroutine vertvisc_remnant
!! and effective layer thicknesses (CS%h_u and CS%h_v) for later use in the
!! applying the implicit vertical viscosity via vertvisc().
subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
- 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 !< Ocean vertical grid structure
- real, intent(in), &
- dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u !< Zonal velocity in m s-1
- real, intent(in), &
- dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: v !< Meridional velocity in m s-1
- real, intent(in), &
- dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Layer thickness in H
- type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
- type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag
- real, intent(in) :: dt !< Time increment in s
- type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure
- type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: u !< Zonal velocity in m s-1
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(in) :: v !< Meridional velocity in m s-1
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h !< Layer thickness in H
+ type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
+ type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag
+ real, intent(in) :: dt !< Time increment in s
+ type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure
+ type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure
! Field from forces used in this subroutine:
! ustar: the friction velocity in m s-1, used here as the mixing
@@ -593,14 +592,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
hvel, & ! hvel is the thickness used at a velocity grid point, in H.
hvel_shelf ! The equivalent of hvel under shelves, in H.
real, dimension(SZIB_(G),SZK_(G)+1) :: &
- a, & ! The drag coefficients across interfaces, in m s-1. a times
+ a_cpl, & ! The drag coefficients across interfaces, in Z s-1. a_cpl times
! the velocity difference gives the stress across an interface.
a_shelf, & ! The drag coefficients across interfaces in water columns under
- ! ice shelves, in m s-1.
+ ! ice shelves, in Z s-1.
z_i ! An estimate of each interface's height above the bottom,
! normalized by the bottom boundary layer thickness, nondim.
real, dimension(SZIB_(G)) :: &
- kv_bbl, & ! The bottom boundary layer viscosity in m2 s-1.
+ kv_bbl, & ! The bottom boundary layer viscosity in Z2 s-1.
bbl_thick, & ! The bottom boundary layer thickness in m or kg m-2.
I_Hbbl, & ! The inverse of the bottom boundary layer thickness, in units
! of H-1 (i.e., m-1 or m2 kg-1).
@@ -614,10 +613,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
zh, & ! An estimate of the interface's distance from the bottom
! based on harmonic mean thicknesses, in m or kg m-2.
h_ml ! The mixed layer depth, in m or kg m-2.
- real, allocatable, dimension(:,:) :: hML_u, hML_v
- real, allocatable, dimension(:,:,:) :: Kv_v, & !< Total vertical viscosity at u-points
- Kv_u !< Total vertical viscosity at v-points
- real :: zcol(SZI_(G)) ! The height of an interface at h-points, in m or kg m-2.
+ real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points, in m.
+ real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points, in m.
+ real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points, in m2 s-1.
+ real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points, in m2 s-1.
+ real :: zcol(SZI_(G)) ! The height of an interface at h-points, in H (m or kg m-2).
real :: botfn ! A function which goes from 1 at the bottom to 0 much more
! than Hbbl into the interior.
real :: topfn ! A function which goes from 1 at the top to 0 much more
@@ -625,9 +625,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
real :: z2 ! The distance from the bottom, normalized by Hbbl, nondim.
real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2.
real :: z_clear ! The clearance of an interface above the surrounding topography, in H.
- real :: h_neglect ! A thickness that is so small it is usually lost
- ! in roundoff and can be neglected, in H.
- real :: H_to_m, m_to_H ! Unit conversion factors.
+ real :: h_neglect ! A thickness that is so small it is usually lost
+ ! in roundoff and can be neglected, in H.
real :: I_valBL ! The inverse of a scaling factor determining when water is
! still within the boundary layer, as determined by the sum
@@ -645,8 +644,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
"Module must be initialized before it is used.")
h_neglect = GV%H_subroundoff
- H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H
- I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect)
+ I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect)
I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val
if (CS%id_Kv_u > 0) then
@@ -673,18 +671,15 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0
endif
-!$OMP parallel do default(none) shared(G,GV,CS,visc,Isq,ieq,nz,u,h,forces,hML_u, &
-!$OMP OBC,h_neglect,dt,m_to_H,I_valBL) &
-!$OMP firstprivate(i_hbbl) &
-!$OMP private(do_i,kv_bbl,bbl_thick,z_i,h_harm,h_arith,h_delta,hvel,z2, &
-!$OMP botfn,zh,Dmin,zcol,a,do_any_shelf,do_i_shelf,zi_dir, &
-!$OMP a_shelf,Ztop_min,I_HTbl,hvel_shelf,topfn,h_ml,z2_wt,z_clear)
+ !$OMP parallel do default(private) shared(G,GV,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, &
+ !$OMP OBC,h_neglect,dt,I_valBL,Kv_u) &
+ !$OMP firstprivate(i_hbbl)
do j=G%Jsc,G%Jec
do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo
if (CS%bottomdraglaw) then ; do I=Isq,Ieq
kv_bbl(I) = visc%kv_bbl_u(I,j)
- bbl_thick(I) = visc%bbl_thick_u(I,j) * m_to_H
+ bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%Z_to_H
if (do_i(I)) I_Hbbl(I) = 1.0 / (bbl_thick(I) + h_neglect)
enddo ; endif
@@ -694,7 +689,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
h_delta(I,k) = h(i+1,j,k) - h(i,j,k)
endif ; enddo ; enddo
do I=Isq,Ieq
- Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * m_to_H
+ Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * GV%Z_to_H
zi_dir(I) = 0
enddo
@@ -703,11 +698,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
do I=Isq,Ieq ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then
if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(I,k) = 0. ; enddo
- Dmin(I) = G%bathyT(i,j) * m_to_H
+ Dmin(I) = G%bathyT(i,j) * GV%Z_to_H
zi_dir(I) = -1
elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then
do k=1,nz ; h_harm(I,k) = h(i+1,j,k) ; h_arith(I,k) = h(i+1,j,k) ; h_delta(I,k) = 0. ; enddo
- Dmin(I) = G%bathyT(i+1,j) * m_to_H
+ Dmin(I) = G%bathyT(i+1,j) * GV%Z_to_H
zi_dir(I) = 1
endif
endif ; enddo
@@ -730,7 +725,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
endif ; enddo ; enddo ! i & k loops
else ! Not harmonic_visc
do I=Isq,Ieq ; zh(I) = 0.0 ; z_i(I,nz+1) = 0.0 ; enddo
- do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * m_to_H ; enddo
+ do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * GV%Z_to_H ; enddo
do k=nz,1,-1
do i=Isq,Ieq+1 ; zcol(i) = zcol(i) + h(i,j,k) ; enddo
do I=Isq,Ieq ; if (do_i(I)) then
@@ -759,7 +754,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
enddo ! k loop
endif
- call find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, &
+ call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, &
dt, j, G, GV, CS, visc, forces, work_on_u=.true., OBC=OBC)
if (allocated(hML_u)) then
do i=isq,ieq ; if (do_i(i)) then ; hML_u(I,j) = h_ml(I) ; endif ; enddo
@@ -781,7 +776,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
! Perhaps this needs to be done more carefully, via find_eta.
do I=Isq,Ieq ; if (do_i_shelf(I)) then
zh(I) = 0.0 ; Ztop_min(I) = min(zcol(i), zcol(i+1))
- I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*m_to_H + h_neglect)
+ I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*GV%Z_to_H + h_neglect)
endif ; enddo
do k=1,nz
do i=Isq,Ieq+1 ; zcol(i) = zcol(i) - h(i,j,k) ; enddo
@@ -813,12 +808,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
if (do_any_shelf) then
do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i_shelf(I)) then
CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * a_shelf(I,K) + &
- (1.0-forces%frac_shelf_u(I,j)) * a(I,K)
+ (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)
! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH
-! CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a(I,K)) + &
-! (1.0-forces%frac_shelf_u(I,j)) * a(I,K)
+! CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a_cpl(I,K)) + &
+! (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)
elseif (do_i(I)) then
- CS%a_u(I,j,K) = a(I,K)
+ CS%a_u(I,j,K) = a_cpl(I,K)
endif ; enddo ; enddo
do k=1,nz ; do I=Isq,Ieq ; if (do_i_shelf(I)) then
! Should we instead take the inverse of the average of the inverses?
@@ -828,14 +823,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
CS%h_u(I,j,k) = hvel(I,k)
endif ; enddo ; enddo
else
- do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = a(I,K) ; enddo ; enddo
+ do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = a_cpl(I,K) ; enddo ; enddo
do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) ; enddo ; enddo
endif
! Diagnose total Kv at u-points
if (CS%id_Kv_u > 0) then
do k=1,nz ; do I=Isq,Ieq
- if (do_i(I)) Kv_u(I,j,k) = 0.5 * (CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k)
+ if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k)
enddo ; enddo
endif
@@ -843,18 +838,15 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
! Now work on v-points.
-!$OMP parallel do default(none) shared(G,GV,CS,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, &
-!$OMP OBC,h_neglect,dt,m_to_H,I_valBL) &
-!$OMP firstprivate(i_hbbl) &
-!$OMP private(do_i,kv_bbl,bbl_thick,z_i,h_harm,h_arith,h_delta,hvel,z2,zi_dir, &
-!$OMP botfn,zh,Dmin,zcol1,zcol2,a,do_any_shelf,do_i_shelf, &
-!$OMP a_shelf,Ztop_min,I_HTbl,hvel_shelf,topfn,h_ml,z2_wt,z_clear)
+ !$OMP parallel do default(private) shared(G,GV,CS,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, &
+ !$OMP OBC,h_neglect,dt,I_valBL,Kv_v) &
+ !$OMP firstprivate(i_hbbl)
do J=Jsq,Jeq
do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo
if (CS%bottomdraglaw) then ; do i=is,ie
kv_bbl(i) = visc%kv_bbl_v(i,J)
- bbl_thick(i) = visc%bbl_thick_v(i,J) * m_to_H
+ bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%Z_to_H
if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i)
enddo ; endif
@@ -864,7 +856,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
h_delta(i,k) = h(i,j+1,k) - h(i,j,k)
endif ; enddo ; enddo
do i=is,ie
- Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * m_to_H
+ Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * GV%Z_to_H
zi_dir(i) = 0
enddo
@@ -873,11 +865,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then
if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(i,k) = 0. ; enddo
- Dmin(I) = G%bathyT(i,j) * m_to_H
+ Dmin(I) = G%bathyT(i,j) * GV%Z_to_H
zi_dir(I) = -1
elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then
do k=1,nz ; h_harm(i,k) = h(i,j+1,k) ; h_arith(i,k) = h(i,j+1,k) ; h_delta(i,k) = 0. ; enddo
- Dmin(i) = G%bathyT(i,j+1) * m_to_H
+ Dmin(i) = G%bathyT(i,j+1) * GV%Z_to_H
zi_dir(i) = 1
endif
endif ; enddo
@@ -902,8 +894,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
else ! Not harmonic_visc
do i=is,ie
zh(i) = 0.0 ; z_i(i,nz+1) = 0.0
- zcol1(i) = -G%bathyT(i,j) * m_to_H
- zcol2(i) = -G%bathyT(i,j+1) * m_to_H
+ zcol1(i) = -G%bathyT(i,j) * GV%Z_to_H
+ zcol2(i) = -G%bathyT(i,j+1) * GV%Z_to_H
enddo
do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then
zh(i) = zh(i) + h_harm(i,k)
@@ -931,7 +923,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
endif ; enddo ; enddo ! i & k loops
endif
- call find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, &
+ call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, &
dt, j, G, GV, CS, visc, forces, work_on_u=.false., OBC=OBC)
if ( allocated(hML_v)) then
do i=is,ie ; if (do_i(i)) then ; hML_v(i,J) = h_ml(i) ; endif ; enddo
@@ -952,7 +944,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
! Perhaps this needs to be done more carefully, via find_eta.
do i=is,ie ; if (do_i_shelf(i)) then
zh(i) = 0.0 ; Ztop_min(I) = min(zcol1(i), zcol2(i))
- I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*m_to_H + h_neglect)
+ I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*GV%Z_to_H + h_neglect)
endif ; enddo
do k=1,nz
do i=is,ie ; if (do_i_shelf(i)) then
@@ -984,12 +976,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
if (do_any_shelf) then
do K=1,nz+1 ; do i=is,ie ; if (do_i_shelf(i)) then
CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * a_shelf(i,k) + &
- (1.0-forces%frac_shelf_v(i,J)) * a(i,K)
+ (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)
! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH
-! CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a(i,K)) + &
-! (1.0-forces%frac_shelf_v(i,J)) * a(i,K)
+! CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a_cpl(i,K)) + &
+! (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)
elseif (do_i(i)) then
- CS%a_v(i,J,K) = a(i,K)
+ CS%a_v(i,J,K) = a_cpl(i,K)
endif ; enddo ; enddo
do k=1,nz ; do i=is,ie ; if (do_i_shelf(i)) then
! Should we instead take the inverse of the average of the inverses?
@@ -999,14 +991,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
CS%h_v(i,J,k) = hvel(i,k)
endif ; enddo ; enddo
else
- do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a(i,K) ; enddo ; enddo
+ do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a_cpl(i,K) ; enddo ; enddo
do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) ; enddo ; enddo
endif
! Diagnose total Kv at v-points
if (CS%id_Kv_v > 0) then
do k=1,nz ; do i=is,ie
- if (do_i(I)) Kv_v(i,J,k) = 0.5 * (CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k)
+ if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k)
enddo ; enddo
endif
@@ -1016,7 +1008,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC)
call uvchksum("vertvisc_coef h_[uv]", CS%h_u, &
CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m)
call uvchksum("vertvisc_coef a_[uv]", CS%a_u, &
- CS%a_v, G%HI, haloshift=0)
+ CS%a_v, G%HI, haloshift=0, scale=GV%Z_to_m)
if (allocated(hML_u) .and. allocated(hML_v)) &
call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, &
G%HI, haloshift=0, scale=GV%H_to_m)
@@ -1041,70 +1033,60 @@ end subroutine vertvisc_coef
!> Calculate the 'coupling coefficient' (a[k]) at the
!! interfaces. If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the
!! adjacent layer thicknesses are used to calculate a[k] near the bottom.
-subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, &
+subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, &
dt, j, G, GV, CS, visc, forces, work_on_u, OBC, shelf)
- type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
- type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
- !> Coupling coefficient across interfaces, in m s-1
- real, dimension(SZIB_(G),SZK_(GV)+1), intent(out) :: a
- !> Thickness at velocity points, in H
- real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel
- !> If true, determine coupling coefficient for a column
- logical, dimension(SZIB_(G)), intent(in) :: do_i
- !> Harmonic mean of thicknesses around a velocity grid point, in H
- real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: h_harm
- !> Bottom boundary layer thickness, in H
- real, dimension(SZIB_(G)), intent(in) :: bbl_thick
- !> Bottom boundary layer viscosity, in m2 s-1
- real, dimension(SZIB_(G)), intent(in) :: kv_bbl
- !> Estimate of interface heights above the bottom,
- !! normalised by the bottom boundary layer thickness
- real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i
- !> Mixed layer depth, in H
- real, dimension(SZIB_(G)), intent(out) :: h_ml
- !> j-index to find coupling coefficient for
- integer, intent(in) :: j
- !> Time increment, in s
- real, intent(in) :: dt
- !> Vertical viscosity control structure
- type(vertvisc_CS), pointer :: CS
- !> Structure containing viscosities and bottom drag
- type(vertvisc_type), intent(in) :: visc
- type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
- !> If true, u-points are being calculated, otherwise v-points
- logical, intent(in) :: work_on_u
- !> Open boundary condition structure
- type(ocean_OBC_type), pointer :: OBC
- !> If present and true, use a surface boundary condition
- !! appropriate for an ice shelf.
- logical, optional, intent(in) :: shelf
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
+ real, dimension(SZIB_(G),SZK_(GV)+1), &
+ intent(out) :: a_cpl !< Coupling coefficient across interfaces, in Z s-1
+ real, dimension(SZIB_(G),SZK_(GV)), &
+ intent(in) :: hvel !< Thickness at velocity points, in H
+ logical, dimension(SZIB_(G)), &
+ intent(in) :: do_i !< If true, determine coupling coefficient for a column
+ real, dimension(SZIB_(G),SZK_(GV)), &
+ intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity
+ !! grid point, in H
+ real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness, in H
+ real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in Z2 s-1
+ real, dimension(SZIB_(G),SZK_(GV)+1), &
+ intent(in) :: z_i !< Estimate of interface heights above the bottom,
+ !! normalized by the bottom boundary layer thickness
+ real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth, in H
+ integer, intent(in) :: j !< j-index to find coupling coefficient for
+ real, intent(in) :: dt !< Time increment, in s
+ type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure
+ type(vertvisc_type), intent(in) :: visc !< Structure containing viscosities and bottom drag
+ type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
+ logical, intent(in) :: work_on_u !< If true, u-points are being calculated,
+ !! otherwise they are v-points
+ type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure
+ logical, optional, intent(in) :: shelf !< If present and true, use a surface boundary
+ !! condition appropriate for an ice shelf.
! Local variables
real, dimension(SZIB_(G)) :: &
- u_star, & ! ustar at a velocity point, in m s-1.
+ u_star, & ! ustar at a velocity point, in Z s-1.
absf, & ! The average of the neighboring absolute values of f, in s-1.
! h_ml, & ! The mixed layer depth, in m or kg m-2.
nk_visc, & ! The (real) interface index of the base of mixed layer.
z_t, & ! The distance from the top, sometimes normalized
- ! by Hmix, in m or nondimensional.
- kv_tbl, &
+ ! by Hmix, in H or nondimensional.
+ kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1.
tbl_thick
real, dimension(SZIB_(G),SZK_(GV)) :: &
- Kv_add ! A viscosity to add, in m2 s-1.
- real :: h_shear ! The distance over which shears occur, m or kg m-2.
- real :: r ! A thickness to compare with Hbbl, in m or kg m-2.
- real :: visc_ml ! The mixed layer viscosity, in m2 s-1.
- real :: I_Hmix ! The inverse of the mixed layer thickness, in m-1 or m2 kg-1.
+ Kv_add ! A viscosity to add, in Z2 s-1.
+ real :: h_shear ! The distance over which shears occur, H.
+ real :: r ! A thickness to compare with Hbbl, in H.
+ real :: visc_ml ! The mixed layer viscosity, in Z2 s-1.
+ real :: I_Hmix ! The inverse of the mixed layer thickness, in H-1.
real :: a_ml ! The layer coupling coefficient across an interface in
! the mixed layer, in m s-1.
- real :: temp1 ! A temporary variable in m2 s-1.
+ real :: I_amax ! The inverse of the maximum coupling coefficient, in Z-1.???
+ real :: temp1 ! A temporary variable in H Z
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected, in H.
- real :: dz_neglect ! A thickness in m that is so small it is usually lost
- ! in roundoff and can be neglected, in m.
real :: z2 ! A copy of z_i, nondim.
- real :: H_to_m, m_to_H ! Unit conversion factors.
real :: topfn
real :: a_top
logical :: do_shelf, do_OBCs
@@ -1112,14 +1094,17 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
integer :: nz
real :: botfn
- a(:,:) = 0.0
+ a_cpl(:,:) = 0.0
if (work_on_u) then ; is = G%IscB ; ie = G%IecB
else ; is = G%isc ; ie = G%iec ; endif
nz = G%ke
h_neglect = GV%H_subroundoff
- H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H
- dz_neglect = GV%H_subroundoff*GV%H_to_m
+
+ ! The maximum coupling coefficent was originally introduced to avoid
+ ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10
+ ! sets the maximum coupling coefficient increment to 1e10 m per timestep.
+ I_amax = (1.0e-10*GV%Z_to_m) * dt
do_shelf = .false. ; if (present(shelf)) do_shelf = shelf
do_OBCs = .false.
@@ -1128,15 +1113,15 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
! The following loop calculates the vertical average velocity and
! surface mixed layer contributions to the vertical viscosity.
- do i=is,ie ; a(i,1) = 0.0 ; enddo
+ do i=is,ie ; a_cpl(i,1) = 0.0 ; enddo
if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie
- if (do_i(i)) a(i,K) = 2.0*CS%Kv
+ if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv
enddo ; enddo ; else
- I_Hmix = 1.0 / (CS%Hmix * m_to_H + h_neglect)
+ I_Hmix = 1.0 / (CS%Hmix + h_neglect)
do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo
do K=2,nz ; do i=is,ie ; if (do_i(i)) then
z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix
- a(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * &
+ a_cpl(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * &
(1.0 + 0.09*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i)))
endif ; enddo ; enddo
endif
@@ -1145,12 +1130,12 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
if (CS%bottomdraglaw) then
r = hvel(i,nz)*0.5
if (r < bbl_thick(i)) then
- a(i,nz+1) = 1.0*kv_bbl(i) / (1e-10*dt*kv_bbl(i) + r*H_to_m)
+ a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + r*GV%H_to_Z)
else
- a(i,nz+1) = 1.0*kv_bbl(i) / (1e-10*dt*kv_bbl(i) + bbl_thick(i)*H_to_m)
+ a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z)
endif
else
- a(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*H_to_m + 2.0e-10*dt*CS%Kvbbl)
+ a_cpl(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax*CS%Kvbbl)
endif
endif ; enddo
@@ -1173,7 +1158,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
endif ; enddo
endif
do K=2,nz ; do i=is,ie ; if (do_i(i)) then
- a(i,K) = a(i,K) + Kv_add(i,K)
+ a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K)
endif ; enddo ; enddo
else
do K=2,nz ; do i=is,ie ; if (do_i(i)) then
@@ -1189,7 +1174,19 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
endif ; enddo
endif
do K=2,nz ; do i=is,ie ; if (do_i(i)) then
- a(i,K) = a(i,K) + Kv_add(i,K)
+ a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K)
+ endif ; enddo ; enddo
+ endif
+ endif
+
+ if (associated(visc%Kv_shear_Bu)) then
+ if (work_on_u) then
+ do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then
+ a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k))
+ endif ; enddo ; enddo
+ else
+ do K=2,nz ; do i=is,ie ; if (do_i(i)) then
+ a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k))
endif ; enddo ; enddo
endif
endif
@@ -1211,12 +1208,13 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
endif ; enddo
endif
do K=2,nz ; do i=is,ie ; if (do_i(i)) then
- a(i,K) = a(i,K) + Kv_add(i,K)
+ a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K)
endif ; enddo ; enddo
else
do K=2,nz ; do i=is,ie ; if (do_i(i)) then
Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k))
endif ; enddo ; enddo
+ !### I am pretty sure that this is double counting here! - RWH
if (do_OBCs) then
do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then
if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
@@ -1227,7 +1225,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
endif ; enddo
endif
do K=2,nz ; do i=is,ie ; if (do_i(i)) then
- a(i,K) = a(i,K) + Kv_add(i,K)
+ a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K)
endif ; enddo ; enddo
endif
endif
@@ -1239,7 +1237,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2)
if (CS%bottomdraglaw) then
- a(i,K) = a(i,K) + 2.0*(kv_bbl(i)-CS%Kv)*botfn
+ a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i) - CS%Kv)*botfn
r = (hvel(i,k)+hvel(i,k-1))
if (r > 2.0*bbl_thick(i)) then
h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i))
@@ -1247,15 +1245,12 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
h_shear = r
endif
else
- a(i,K) = a(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn
+ a_cpl(i,K) = a_cpl(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn
h_shear = hvel(i,k) + hvel(i,k-1) + h_neglect
endif
- ! Up to this point a has units of m2 s-1, but now is converted to m s-1.
- ! The term including 1e-10 in the denominators is here to avoid
- ! truncation error problems in the tridiagonal solver. Effectively, this
- ! sets the maximum coupling coefficient at 1e10 m.
- a(i,K) = a(i,K) / (h_shear*H_to_m + 1.0e-10*dt*a(i,K))
+ ! Up to this point a_cpl has had units of Z2 s-1, but now is converted to Z s-1.
+ a_cpl(i,K) = a_cpl(i,K) / (h_shear*GV%H_to_Z + I_amax*a_cpl(i,K))
endif ; enddo ; enddo ! i & k loops
if (do_shelf) then
@@ -1263,18 +1258,18 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
do i=is,ie ; if (do_i(i)) then
if (work_on_u) then
kv_tbl(i) = visc%kv_tbl_shelf_u(I,j)
- tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * m_to_H
+ tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%Z_to_H
else
kv_tbl(i) = visc%kv_tbl_shelf_v(i,J)
- tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * m_to_H
+ tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%Z_to_H
endif
z_t(i) = 0.0
- ! If a(i,1) were not already 0, it would be added here.
+ ! If a_cpl(i,1) were not already 0, it would be added here.
if (0.5*hvel(i,1) > tbl_thick(i)) then
- a(i,1) = kv_tbl(i) / (tbl_thick(i) *H_to_m + (1.0e-10*dt)*kv_tbl(i))
+ a_cpl(i,1) = kv_tbl(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*kv_tbl(i))
else
- a(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*H_to_m + (1.0e-10*dt)*kv_tbl(i))
+ a_cpl(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_tbl(i))
endif
endif ; enddo
@@ -1288,22 +1283,20 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
else
h_shear = r
endif
- ! The term including 1e-10 in the denominators is here to avoid
- ! truncation error problems in the tridiagonal solver. Effectively, this
- ! sets the maximum coupling coefficient increment to 1e10 m.
+
a_top = 2.0 * topfn * kv_tbl(i)
- a(i,K) = a(i,K) + a_top / (h_shear*H_to_m + 1.0e-10*dt*a_top)
+ a_cpl(i,K) = a_cpl(i,K) + a_top / (h_shear*GV%H_to_Z + I_amax*a_top)
endif ; enddo ; enddo
elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then
max_nk = 0
do i=is,ie ; if (do_i(i)) then
if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1)
if (work_on_u) then
- u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))
+ u_star(I) = 0.5*GV%m_to_Z*(forces%ustar(i,j) + forces%ustar(i+1,j))
absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J)))
if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1
else
- u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))
+ u_star(i) = 0.5*GV%m_to_Z*(forces%ustar(i,j) + forces%ustar(i,j+1))
absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1
endif
@@ -1314,16 +1307,16 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
if (do_OBCS) then ; if (work_on_u) then
do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then
if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) &
- u_star(I) = forces%ustar(i,j)
+ u_star(I) = GV%m_to_Z*forces%ustar(i,j)
if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) &
- u_star(I) = forces%ustar(i+1,j)
+ u_star(I) = GV%m_to_Z*forces%ustar(i+1,j)
endif ; enddo
else
do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then
if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) &
- u_star(i) = forces%ustar(i,j)
+ u_star(i) = GV%m_to_Z*forces%ustar(i,j)
if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) &
- u_star(i) = forces%ustar(i,j+1)
+ u_star(i) = GV%m_to_Z*forces%ustar(i,j+1)
endif ; enddo
endif ; endif
@@ -1338,16 +1331,15 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m
do K=2,max_nk ; do i=is,ie ; if (do_i(i)) then ; if (k < nk_visc(i)) then
! Set the viscosity at the interfaces.
z_t(i) = z_t(i) + hvel(i,k-1)
- temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i)) * H_to_m
- ! This viscosity is set to go to 0 at the mixed layer top and bottom
- ! (in a log-layer) and be further limited by rotation to give the
- ! natural Ekman length.
+ temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z
+ ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer)
+ ! and be further limited by rotation to give the natural Ekman length.
visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / &
(absf(i)*temp1 + h_ml(i)*u_star(i))
- a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * H_to_m + &
- 2.0e-10*dt*visc_ml)
+ a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + &
+ 2.0*I_amax* visc_ml)
! Choose the largest estimate of a.
- if (a_ml > a(i,K)) a(i,K) = a_ml
+ if (a_ml > a_cpl(i,K)) a_cpl(i,K) = a_ml
endif ; endif ; enddo ; enddo
endif
@@ -1389,7 +1381,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS)
maxvel = CS%maxvel
truncvel = 0.9*maxvel
- H_report = 6.0 * GV%Angstrom
+ H_report = 6.0 * GV%Angstrom_H
dt_Rho0 = dt / GV%Rho0
if (len_trim(CS%u_trunc_file) > 0) then
@@ -1564,25 +1556,28 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS)
end subroutine vertvisc_limit_vel
-!> Initialise the vertical friction module
+!> Initialize the vertical friction module
subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, &
ntrunc, CS)
- !> "MOM Internal State", a set of pointers to the fields and accelerations
- !! that make up the ocean's physical state
- type(ocean_internal_state), target, intent(in) :: MIS
- type(time_type), target, intent(in) :: Time !< Current model time
- type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
- type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
+ type(ocean_internal_state), &
+ target, intent(in) :: MIS !< The "MOM Internal State", a set of pointers
+ !! to the fields and accelerations that make
+ !! up the ocean's physical state
+ type(time_type), target, intent(in) :: Time !< Current model time
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
type(param_file_type), intent(in) :: param_file !< File to parse for parameters
- type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic control structure
- type(accel_diag_ptrs), intent(inout) :: ADp !< Acceleration diagnostic pointers
- type(directories), intent(in) :: dirs !< Relevant directory paths
- integer, target, intent(inout) :: ntrunc !< Number of velocity truncations
- type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure
+ type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic control structure
+ type(accel_diag_ptrs), intent(inout) :: ADp !< Acceleration diagnostic pointers
+ type(directories), intent(in) :: dirs !< Relevant directory paths
+ integer, target, intent(inout) :: ntrunc !< Number of velocity truncations
+ type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure
! Local variables
real :: hmix_str_dflt
+ real :: Kv_dflt ! A default viscosity in m2 s-1.
+ real :: Hmix_m ! A boundary layer thickness, in m.
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz
! This include declares and sets the variable "version".
#include "version_variable.h"
@@ -1649,16 +1644,17 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, &
call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, &
"The prescribed depth over which the near-surface \n"//&
"viscosity and diffusivity are elevated when the bulk \n"//&
- "mixed layer is not used.", units="m", fail_if_missing=.true.)
+ "mixed layer is not used.", units="m", scale=GV%m_to_H, &
+ unscaled=Hmix_m, fail_if_missing=.true.)
if (CS%direct_stress) then
if (GV%nkml < 1) then
call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, &
"The depth over which the wind stress is applied if \n"//&
- "DIRECT_STRESS is true.", units="m", default=CS%Hmix)
+ "DIRECT_STRESS is true.", units="m", default=Hmix_m, scale=GV%m_to_H)
else
call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, &
"The depth over which the wind stress is applied if \n"//&
- "DIRECT_STRESS is true.", units="m", fail_if_missing=.true.)
+ "DIRECT_STRESS is true.", units="m", fail_if_missing=.true., scale=GV%m_to_H)
endif
if (CS%Hmix_stress <= 0.0) call MOM_error(FATAL, "vertvisc_init: " // &
"HMIX_STRESS must be set to a positive value if DIRECT_STRESS is true.")
@@ -1666,25 +1662,24 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, &
call get_param(param_file, mdl, "KV", CS%Kv, &
"The background kinematic viscosity in the interior. \n"//&
"The molecular value, ~1e-6 m2 s-1, may be used.", &
- units="m2 s-1", fail_if_missing=.true.)
+ units="m2 s-1", fail_if_missing=.true., scale=GV%m_to_Z**2, unscaled=Kv_dflt)
-! CS%Kvml = CS%Kv ; CS%Kvbbl = CS%Kv ! Needed? -AJA
if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, &
"The kinematic viscosity in the mixed layer. A typical \n"//&
"value is ~1e-2 m2 s-1. KVML is not used if \n"//&
"BULKMIXEDLAYER is true. The default is set by KV.", &
- units="m2 s-1", default=CS%Kv)
+ units="m2 s-1", default=Kv_dflt, scale=GV%m_to_Z**2)
if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, &
"The kinematic viscosity in the benthic boundary layer. \n"//&
"A typical value is ~1e-2 m2 s-1. KVBBL is not used if \n"//&
"BOTTOMDRAGLAW is true. The default is set by KV.", &
- units="m2 s-1", default=CS%Kv)
+ units="m2 s-1", default=Kv_dflt, scale=GV%m_to_Z**2)
call get_param(param_file, mdl, "HBBL", CS%Hbbl, &
"The thickness of a bottom boundary layer with a \n"//&
"viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//&
"the thickness over which near-bottom velocities are \n"//&
"averaged for the drag law if BOTTOMDRAGLAW is defined \n"//&
- "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.)
+ "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true., scale=GV%m_to_H)
call get_param(param_file, mdl, "MAXVEL", CS%maxvel, &
"The maximum velocity allowed before the velocity \n"//&
"components are truncated.", units="m s-1", default=3.0e8)
@@ -1739,19 +1734,19 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, &
ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0
CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, &
- 'Slow varying vertical viscosity', 'm2 s-1')
+ 'Slow varying vertical viscosity', 'm2 s-1', conversion=GV%Z_to_m**2)
CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, &
- 'Total vertical viscosity at u-points', 'm2 s-1')
+ 'Total vertical viscosity at u-points', 'm2 s-1', conversion=GV%Z_to_m**2)
CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, &
- 'Total vertical viscosity at v-points', 'm2 s-1')
+ 'Total vertical viscosity at v-points', 'm2 s-1', conversion=GV%Z_to_m**2)
CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, &
- 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1')
+ 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m)
CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, &
- 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1')
+ 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m)
CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, &
'Thickness at Zonal Velocity Points for Viscosity', thickness_units)
@@ -1788,8 +1783,8 @@ end subroutine vertvisc_init
subroutine updateCFLtruncationValue(Time, CS, activate)
type(time_type), target, intent(in) :: Time !< Current model time
type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure
- !> Whether to record the value of Time as the beginning of the ramp period
- logical, optional, intent(in) :: activate
+ logical, optional, intent(in) :: activate !< Specifiy whether to record the value of
+ !! Time as the beginning of the ramp period
! Local variables
real :: deltaTime, wghtA
@@ -1824,7 +1819,9 @@ end subroutine updateCFLtruncationValue
!> Clean up and deallocate the vertical friction module
subroutine vertvisc_end(CS)
- type(vertvisc_CS), pointer :: CS
+ type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure that
+ !! will be deallocated in this subroutine.
+
DEALLOC_(CS%a_u) ; DEALLOC_(CS%h_u)
DEALLOC_(CS%a_v) ; DEALLOC_(CS%h_v)
if (associated(CS%a1_shelf_u)) deallocate(CS%a1_shelf_u)
diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90
index 9c4536a013..89393c2c8c 100644
--- a/src/tracer/DOME_tracer.F90
+++ b/src/tracer/DOME_tracer.F90
@@ -1,3 +1,4 @@
+!> A tracer package that is used as a diagnostic in the DOME experiments
module DOME_tracer
! This file is part of MOM6. See LICENSE.md for the license.
@@ -14,7 +15,7 @@ module DOME_tracer
use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer
use MOM_restart, only : MOM_restart_CS
use MOM_sponge, only : set_up_sponge_field, sponge_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_variables, only : surface
@@ -30,35 +31,30 @@ module DOME_tracer
public register_DOME_tracer, initialize_DOME_tracer
public DOME_tracer_column_physics, DOME_tracer_surface_state, DOME_tracer_end
-! ntr is the number of tracers in this module.
-integer, parameter :: ntr = 11
+integer, parameter :: ntr = 11 !< The number of tracers in this module.
+!> The DOME_tracer control structure
type, public :: DOME_tracer_CS ; private
- logical :: coupled_tracers = .false. ! These tracers are not offered to the
- ! coupler.
- character(len=200) :: tracer_IC_file ! The full path to the IC file, or " "
- ! to initialize internally.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
- real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this
- ! subroutine, in g m-3?
- real :: land_val(NTR) = -1.0 ! The value of tr used where land is masked out.
- logical :: use_sponge ! If true, sponges may be applied somewhere in the domain.
-
- integer, dimension(NTR) :: ind_tr ! Indices returned by aof_set_coupler_flux
- ! if it is used and the surface tracer concentrations are to be
- ! provided to the coupler.
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
-
- type(vardesc) :: tr_desc(NTR)
+ logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
+ character(len=200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3?
+ real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out.
+ logical :: use_sponge !< If true, sponges may be applied somewhere in the domain.
+
+ integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the
+ !! surface tracer concentrations are to be provided to the coupler.
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+
+ type(vardesc) :: tr_desc(NTR) !< Descriptions and metadata for the tracers
end type DOME_tracer_CS
contains
-!> This subroutine is used to register tracer fields and subroutines
-!! to be used with MOM.
+!> Register tracer fields and subroutines to be used with MOM.
function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -137,8 +133,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
register_DOME_tracer = .true.
end function register_DOME_tracer
-!> This subroutine initializes the NTR tracer fields in tr(:,:,:,:)
-!! and it sets up the tracer output.
+!> Initializes the NTR tracer fields in tr(:,:,:,:) and sets up the tracer output.
subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, &
sponge_CSp, diag_to_Z_CSp, param_file)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
@@ -174,8 +169,9 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, &
real :: tr_y ! Initial zonally uniform tracer concentrations.
real :: dist2 ! The distance squared from a line, in m2.
real :: h_neglect ! A thickness that is so small it is usually lost
- ! in roundoff and can be neglected, in m.
- real :: e(SZK_(G)+1), e_top, e_bot, d_tr
+ ! in roundoff and can be neglected, in H.
+ real :: e(SZK_(G)+1), e_top, e_bot ! Heights in Z.
+ real :: d_tr ! A change in tracer concentraions, in tracer units.
integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
integer :: IsdB, IedB, JsdB, JedB
@@ -220,24 +216,24 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, &
do j=js,je ; do i=is,ie
e(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
- e(K) = e(K+1) + h(i,j,k)*GV%H_to_m
+ e(K) = e(K+1) + h(i,j,k)*GV%H_to_Z
do m=7,NTR
- e_top = -600.0*real(m-1) + 3000.0
- e_bot = -600.0*real(m-1) + 2700.0
+ e_top = (-600.0*real(m-1) + 3000.0) * GV%m_to_Z
+ e_bot = (-600.0*real(m-1) + 2700.0) * GV%m_to_Z
if (e_top < e(K)) then
if (e_top < e(K+1)) then ; d_tr = 0.0
elseif (e_bot < e(K+1)) then
- d_tr = (e_top-e(K+1)) / ((h(i,j,k)+h_neglect)*GV%H_to_m)
- else ; d_tr = (e_top-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_m)
+ d_tr = 1.0 * (e_top-e(K+1)) / ((h(i,j,k)+h_neglect)*GV%H_to_Z)
+ else ; d_tr = 1.0 * (e_top-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z)
endif
elseif (e_bot < e(K)) then
if (e_bot < e(K+1)) then ; d_tr = 1.0
- else ; d_tr = (e(K)-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_m)
+ else ; d_tr = 1.0 * (e(K)-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z)
endif
else
d_tr = 0.0
endif
- if (h(i,j,k) < 2.0*GV%Angstrom) d_tr=0.0
+ if (h(i,j,k) < 2.0*GV%Angstrom_H) d_tr=0.0
CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + d_tr
enddo
enddo
@@ -380,38 +376,21 @@ subroutine DOME_tracer_end(CS)
endif
end subroutine DOME_tracer_end
-!> \namespace DOME_tracer
-!! *
-!! By Robert Hallberg, 2002 *
-!! *
-!! This file contains an example of the code that is needed to set *
-!! up and use a set (in this case eleven) of dynamically passive *
-!! tracers. These tracers dye the inflowing water or water initially *
-!! within a range of latitudes or water initially in a range of *
-!! depths. *
-!! *
-!! A single subroutine is called from within each file to register *
-!! each of the tracers for reinitialization and advection and to *
-!! register the subroutine that initializes the tracers and set up *
-!! their output and the subroutine that does any tracer physics or *
-!! chemistry along with diapycnal mixing (included here because some *
-!! tracers may float or swim vertically or dye diapycnal processes). *
-!! *
-!! *
-!! Macros written all in capital letters are defined in MOM_memory.h. *
-!! *
-!! A small fragment of the grid is shown below: *
-!! *
-!! j+1 x ^ x ^ x At x: q *
-!! j+1 > o > o > At ^: v *
-!! j x ^ x ^ x At >: u *
-!! j > o > o > At o: h, tr *
-!! j-1 x ^ x ^ x *
-!! i-1 i i+1 At x & ^: *
-!! i i+1 At > & o: *
-!! *
-!! The boundaries always run through q grid points (x). *
-!! *
-!!*******+*********+*********+*********+*********+*********+*********+**
+!> \namespace dome_tracer
+!!
+!! By Robert Hallberg, 2002
+!!
+!! This file contains an example of the code that is needed to set
+!! up and use a set (in this case eleven) of dynamically passive
+!! tracers. These tracers dye the inflowing water or water initially
+!! within a range of latitudes or water initially in a range of
+!! depths.
+!!
+!! A single subroutine is called from within each file to register
+!! each of the tracers for reinitialization and advection and to
+!! register the subroutine that initializes the tracers and set up
+!! their output and the subroutine that does any tracer physics or
+!! chemistry along with diapycnal mixing (included here because some
+!! tracers may float or swim vertically or dye diapycnal processes).
end module DOME_tracer
diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90
index f867c26764..0707b54fb3 100644
--- a/src/tracer/ISOMIP_tracer.F90
+++ b/src/tracer/ISOMIP_tracer.F90
@@ -1,20 +1,14 @@
-!> This module contains the routines used to set up and use a set of (one for now)
-!! dynamically passive tracers. For now, just one passive tracer is injected in
+!> Routines used to set up and use a set of (one for now)
+!! dynamically passive tracers in the ISOMIP configuration.
+!!
+!! For now, just one passive tracer is injected in
!! the sponge layer.
-!! Set up and use passive tracers requires the following:
-!! (1) register_ISOMIP_tracer
-!! (2)
module ISOMIP_tracer
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* Original sample tracer package by Robert Hallberg, 2002 *
-!* Adapted to the ISOMIP test case by Gustavo Marques, May 2016 *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
+! Original sample tracer package by Robert Hallberg, 2002
+! Adapted to the ISOMIP test case by Gustavo Marques, May 2016
use MOM_diag_mediator, only : diag_ctrl
use MOM_diag_to_Z, only : diag_to_Z_CS
@@ -26,7 +20,7 @@ module ISOMIP_tracer
use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc
use MOM_restart, only : MOM_restart_CS
use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_variables, only : surface
@@ -45,38 +39,33 @@ module ISOMIP_tracer
public register_ISOMIP_tracer, initialize_ISOMIP_tracer
public ISOMIP_tracer_column_physics, ISOMIP_tracer_surface_state, ISOMIP_tracer_end
-!< ntr is the number of tracers in this module.
-integer, parameter :: ntr = 1
+integer, parameter :: ntr = 1 !< ntr is the number of tracers in this module.
-!> tracer control structure
+!> ISOMIP tracer package control structure
type, public :: ISOMIP_tracer_CS ; private
- logical :: coupled_tracers = .false. !< These tracers are not offered to the
- !< coupler.
- character(len = 200) :: tracer_IC_file !< The full path to the IC file, or " "
- !< to initialize internally.
+ logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
+ character(len = 200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally.
type(time_type), pointer :: Time !< A pointer to the ocean model's clock.
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
- real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this
- !< subroutine, in g m-3?
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3?
real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out.
- logical :: use_sponge ! If true, sponges may be applied somewhere in the domain.
+ logical :: use_sponge !< If true, sponges may be applied somewhere in the domain.
integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux
!< if it is used and the surface tracer concentrations are to be
!< provided to the coupler.
type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
- !< timing of diagnostic output.
+ !! timing of diagnostic output.
- type(vardesc) :: tr_desc(NTR)
+ type(vardesc) :: tr_desc(NTR) !< Descriptions and metadata for the tracers in this package
end type ISOMIP_tracer_CS
contains
!> This subroutine is used to register tracer fields
-function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, &
- restart_CS)
+function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(hor_index_type), intent(in) :: HI ! This subroutine applies diapycnal diffusion and any other column
-! tracer physics or chemistry to the tracers from this file.
-! This is a simple example of a set of advected passive tracers.
+!> This subroutine applies diapycnal diffusion, including the surface boundary
+!! conditions and any other column tracer physics or chemistry to the tracers from this file.
subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, &
- evap_CFL_limit, minimum_forcing_depth)
+ evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
@@ -288,31 +276,17 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G
real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which
!! fluxes can be applied, in m
-! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2.
-! (in) h_new - Layer thickness after entrainment, in m or kg m-2.
-! (in) ea - an array to which the amount of fluid entrained
-! from the layer above during this call will be
-! added, in m or kg m-2.
-! (in) eb - an array to which the amount of fluid entrained
-! from the layer below during this call will be
-! added, in m or kg m-2.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) dt - The amount of time covered by this call, in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! ISOMIP_register_tracer.
-!
! The arguments to this subroutine are redundant in that
! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1]
+ ! Local variables
real :: mmax
real :: b1(SZI_(G)) ! b1 and c1 are variables used by the
real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver.
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
real :: melt(SZI_(G),SZJ_(G)) ! melt water (positive for melting
! negative for freezing)
+ character(len=256) :: mesg ! The text of an error message
integer :: i, j, k, is, ie, js, je, nz, m
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
@@ -323,15 +297,15 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G
! max. melt
mmax = MAXVAL(melt(is:ie,js:je))
call max_across_PEs(mmax)
- !write(*,*)'max melt', mmax
+ ! write(mesg,*) 'max melt = ', mmax
+ ! call MOM_mesg(mesg, 5)
! dye melt water (m=1), dye = 1 if melt=max(melt)
do m=1,NTR
- do j=js,je ; do i=is,ie
+ do j=js,je ; do i=is,ie
if (melt(i,j) > 0.0) then ! melting
- !write(*,*)'i,j,melt,melt/mmax',i,j,melt(i,j),melt(i,j)/mmax
- CS%tr(i,j,1:2,m) = melt(i,j)/mmax ! inject dye in the ML
+ CS%tr(i,j,1:2,m) = melt(i,j)/mmax ! inject dye in the ML
else ! freezing
- CS%tr(i,j,1:2,m) = 0.0
+ CS%tr(i,j,1:2,m) = 0.0
endif
enddo ; enddo
enddo
@@ -339,10 +313,10 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G
if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then
do m=1,NTR
do k=1,nz ;do j=js,je ; do i=is,ie
- h_work(i,j,k) = h_old(i,j,k)
+ h_work(i,j,k) = h_old(i,j,k)
enddo ; enddo ; enddo
call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m) , dt, fluxes, h_work, &
- evap_CFL_limit, minimum_forcing_depth)
+ evap_CFL_limit, minimum_forcing_depth)
call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV)
enddo
else
@@ -386,6 +360,7 @@ subroutine ISOMIP_tracer_surface_state(state, h, G, CS)
end subroutine ISOMIP_tracer_surface_state
+!> Deallocate any memory used by the ISOMIP tracer package
subroutine ISOMIP_tracer_end(CS)
type(ISOMIP_tracer_CS), pointer :: CS !< The control structure returned by a previous
!! call to ISOMIP_register_tracer.
diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90
index 11531dcb62..ebff38508c 100644
--- a/src/tracer/MOM_OCMIP2_CFC.F90
+++ b/src/tracer/MOM_OCMIP2_CFC.F90
@@ -1,52 +1,8 @@
+!> Simulates CFCs using the OCMIP2 protocols
module MOM_OCMIP2_CFC
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, 2007 *
-!* *
-!* This file contains an example of the code that is needed to set *
-!* up and use CFC-11 and CFC-12 in a fully coupled or ice-ocean model *
-!* context. There are 5 subroutines in this file. *
-!* *
-!* register_OCMIP2_CFC determines if the module is going to work, *
-!* then makes several calls registering tracers to be advected and *
-!* read from a restart file. it also sets various run-time parameters *
-!* for this module and sets up a "control structure" (CS) to store *
-!* all information for this module. *
-!* *
-!* initialize_OCMIP2_CFC initializes this modules arrays if they *
-!* have not been found in a restart file. It also determines which *
-!* diagnostics will need to be calculated. *
-!* *
-!* OCMIP2_CFC_column_physics updates the CFC concentrations, *
-!* applying everthing but horizontal advection and diffusion. *
-!* Surface fluxes are applied inside an implicit vertical advection *
-!* and diffusion tridiagonal solver, and any interior sources and *
-!* sinks (not applicable for CFCs) would also be applied here. This *
-!* subroutine also sends out any requested interior diagnostics. *
-!* *
-!* OCMIP2_CFC_surface_state calculates the information required *
-!* from the ocean for the FMS coupler to calculate CFC fluxes. *
-!* *
-!* OCMIP2_CFC_end deallocates the persistent run-time memory used *
-!* by this module. *
-!* *
-!* A small fragment of the horizontal grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v, *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, CFC11, CFC12 *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_mediator, only : diag_ctrl
use MOM_diag_to_Z, only : diag_to_Z_CS
use MOM_error_handler, only : MOM_error, FATAL, WARNING
@@ -58,7 +14,7 @@ module MOM_OCMIP2_CFC
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : query_initialized, MOM_restart_CS
use MOM_sponge, only : set_up_sponge_field, sponge_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_Z_init, only : tracer_Z_init
@@ -78,19 +34,20 @@ module MOM_OCMIP2_CFC
public OCMIP2_CFC_stock, OCMIP2_CFC_end
-! NTR is the number of tracers in this module.
-integer, parameter :: NTR = 2
+integer, parameter :: NTR = 2 !< the number of tracers in this module.
+!> The control structure for the OCMPI2_CFC tracer package
type, public :: OCMIP2_CFC_CS ; private
- character(len=200) :: IC_file ! The file in which the CFC initial values can
- ! be found, or an empty string for internal initilaization.
- logical :: Z_IC_file ! If true, the IC_file is in Z-space. The default is false..
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
+ character(len=200) :: IC_file !< The file in which the CFC initial values can
+ !! be found, or an empty string for internal initilaization.
+ logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false..
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM6 tracer registry
real, pointer, dimension(:,:,:) :: &
- CFC11 => NULL(), & ! The CFC11 concentration in mol m-3.
- CFC12 => NULL() ! The CFC12 concentration in mol m-3.
+ CFC11 => NULL(), & !< The CFC11 concentration in mol m-3.
+ CFC12 => NULL() !< The CFC12 concentration in mol m-3.
! In the following variables a suffix of _11 refers to CFC11 and _12 to CFC12.
+ !>@{ Coefficients used in the CFC11 and CFC12 solubility calculation
real :: a1_11, a2_11, a3_11, a4_11 ! Coefficients in the calculation of the
real :: a1_12, a2_12, a3_12, a4_12 ! CFC11 and CFC12 Schmidt numbers, in
! units of ND, degC-1, degC-2, degC-3.
@@ -100,29 +57,34 @@ module MOM_OCMIP2_CFC
real :: e1_11, e2_11, e3_11 ! More coefficients in the calculation of
real :: e1_12, e2_12, e3_12 ! the CFC11 and CFC12 solubilities, in
! units of PSU-1, PSU-1 K-1, PSU-1 K-2.
- real :: CFC11_IC_val = 0.0 ! The initial value assigned to CFC11.
- real :: CFC12_IC_val = 0.0 ! The initial value assigned to CFC12.
- real :: CFC11_land_val = -1.0 ! The values of CFC11 and CFC12 used where
- real :: CFC12_land_val = -1.0 ! land is masked out.
- logical :: tracers_may_reinit ! If true, tracers may go through the
- ! initialization code if they are not found in the
- ! restart files.
- character(len=16) :: CFC11_name, CFC12_name ! Variable names.
-
- integer :: ind_cfc_11_flux ! Indices returned by aof_set_coupler_flux that
- integer :: ind_cfc_12_flux ! are used to pack and unpack surface boundary
- ! condition arrays.
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
+ !!@}
+ real :: CFC11_IC_val = 0.0 !< The initial value assigned to CFC11.
+ real :: CFC12_IC_val = 0.0 !< The initial value assigned to CFC12.
+ real :: CFC11_land_val = -1.0 !< The value of CFC11 used where land is masked out.
+ real :: CFC12_land_val = -1.0 !< The value of CFC12 used where land is masked out.
+ logical :: tracers_may_reinit !< If true, tracers may be reset via the initialization code
+ !! if they are not found in the restart files.
+ character(len=16) :: CFC11_name !< CFC11 variable name
+ character(len=16) :: CFC12_name !< CFC12 variable name
+
+ integer :: ind_cfc_11_flux !< Index returned by aof_set_coupler_flux that is used to
+ !! pack and unpack surface boundary condition arrays.
+ integer :: ind_cfc_12_flux !< Index returned by aof_set_coupler_flux that is used to
+ !! pack and unpack surface boundary condition arrays.
+
+ type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to
+ ! regulate the timing of diagnostic output.
type(MOM_restart_CS), pointer :: restart_CSp => NULL()
! The following vardesc types contain a package of metadata about each tracer.
- type(vardesc) :: CFC11_desc, CFC12_desc
+ type(vardesc) :: CFC11_desc !< A set of metadata for the CFC11 tracer
+ type(vardesc) :: CFC12_desc !< A set of metadata for the CFC12 tracer
end type OCMIP2_CFC_CS
contains
+!> Register the OCMIP2 CFC tracers to be used with MOM and read the parameters
+!! that are used with this tracer package
function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -134,19 +96,13 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure.
! This subroutine is used to register tracer fields and subroutines
! to be used with MOM.
-! Arguments: HI - A horizontal index type structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-! (in/out) tr_Reg - A pointer to the tracer registry.
-! (in) restart_CS - A pointer to the restart control structure.
-
-! This include declares and sets the variable "version".
-#include "version_variable.h"
+
+ ! Local variables
character(len=40) :: mdl = "MOM_OCMIP2_CFC" ! This module's name.
character(len=200) :: inputdir ! The directory where NetCDF input files are.
- real, dimension(:,:,:), pointer :: tr_ptr
+ ! This include declares and sets the variable "version".
+#include "version_variable.h"
+ real, dimension(:,:,:), pointer :: tr_ptr => NULL()
real :: a11_dflt(4), a12_dflt(4) ! Default values of the various coefficients
real :: d11_dflt(4), d12_dflt(4) ! In the expressions for the solubility and
real :: e11_dflt(3), e12_dflt(3) ! Schmidt numbers.
@@ -351,8 +307,7 @@ subroutine flux_init_OCMIP2_CFC(CS, verbosity)
end subroutine flux_init_OCMIP2_CFC
-!> This subroutine initializes the NTR tracer fields in tr(:,:,:,:)
-!! and it sets up the tracer output.
+!> Initialize the OCMP2 CFC tracer fields and set up the tracer output.
subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, &
sponge_CSp, diag_to_Z_CSp)
logical, intent(in) :: restart !< .true. if the fields have already been
@@ -378,21 +333,6 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, &
! This subroutine initializes the NTR tracer fields in tr(:,:,:,:)
! and it sets up the tracer output.
-! Arguments: restart - .true. if the fields have already been read from
-! a restart file.
-! (in) day - Time of the start of the run.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) h - Layer thickness, in m or kg m-2.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in) OBC - This open boundary condition type specifies whether, where,
-! and what open boundary conditions are used.
-! (in/out) CS - The control structure returned by a previous call to
-! register_OCMIP2_CFC.
-! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if
-! they are in use. Otherwise this may be unassociated.
-! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics
-! in depth space.
logical :: from_file = .false.
if (.not.associated(CS)) return
@@ -460,10 +400,9 @@ subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, CS)
end subroutine init_tracer_CFC
-!> This subroutine applies diapycnal diffusion and any other column
-! tracer physics or chemistry to the tracers from this file.
-! CFCs are relatively simple, as they are passive tracers. with only a surface
-! flux as a source.
+!> This subroutine applies diapycnal diffusion, souces and sinks and any other column
+!! tracer physics or chemistry to the OCMIP2 CFC tracers.
+!! CFCs are relatively simple, as they are passive tracers with only a surface flux as a source.
subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, &
evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
@@ -494,31 +433,16 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS
! CFCs are relatively simple, as they are passive tracers. with only a surface
! flux as a source.
-! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2.
-! (in) h_new - Layer thickness after entrainment, in m or kg m-2.
-! (in) ea - an array to which the amount of fluid entrained
-! from the layer above during this call will be
-! added, in m or kg m-2.
-! (in) eb - an array to which the amount of fluid entrained
-! from the layer below during this call will be
-! added, in m or kg m-2.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) dt - The amount of time covered by this call, in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_OCMIP2_CFC.
-!
! The arguments to this subroutine are redundant in that
! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1]
+ ! Local variables
real :: b1(SZI_(G)) ! b1 and c1 are variables used by the
real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver.
real, dimension(SZI_(G),SZJ_(G)) :: &
CFC11_flux, & ! The fluxes of CFC11 and CFC12 into the ocean, in the
CFC12_flux ! units of CFC concentrations times meters per second.
- real, pointer, dimension(:,:,:) :: CFC11, CFC12
+ real, pointer, dimension(:,:,:) :: CFC11 => NULL(), CFC12 => NULL()
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
integer :: i, j, k, m, is, ie, js, je, nz, idim(4), jdim(4)
@@ -580,23 +504,9 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index)
character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated.
integer, optional, intent(in) :: stock_index !< The coded index of a specific
!! stock being sought.
- integer :: OCMIP2_CFC_stock
-! This function calculates the mass-weighted integral of all tracer stocks,
-! returning the number of stocks it has calculated. If the stock_index
-! is present, only the stock corresponding to that coded index is returned.
-
-! Arguments: h - Layer thickness, in m or kg m-2.
-! (out) stocks - the mass-weighted integrated amount of each tracer,
-! in kg times concentration units.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_OCMIP2_CFC.
-! (out) names - the names of the stocks calculated.
-! (out) units - the units of the stocks calculated.
-! (in,opt) stock_index - the coded index of a specific stock being sought.
-! Return value: the number of stocks calculated here.
+ integer :: OCMIP2_CFC_stock !< The number of stocks calculated here.
+ ! Local variables
real :: mass
integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -639,6 +549,7 @@ subroutine OCMIP2_CFC_surface_state(state, h, G, CS)
type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_OCMIP2_CFC.
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
CFC11_Csurf, & ! The CFC-11 and CFC-12 surface concentrations times the
CFC12_Csurf, & ! Schmidt number term, both in mol m-3.
@@ -700,6 +611,7 @@ subroutine OCMIP2_CFC_surface_state(state, h, G, CS)
end subroutine OCMIP2_CFC_surface_state
+!> Deallocate any memory associated with the OCMIP2 CFC tracer package
subroutine OCMIP2_CFC_end(CS)
type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a
!! previous call to register_OCMIP2_CFC.
@@ -716,4 +628,13 @@ subroutine OCMIP2_CFC_end(CS)
endif
end subroutine OCMIP2_CFC_end
+
+!> \namespace mom_ocmip2_cfc
+!!
+!! By Robert Hallberg, 2007
+!!
+!! This module contains the code that is needed to set
+!! up and use CFC-11 and CFC-12 in a fully coupled or ice-ocean model
+!! context using the OCMIP2 protocols
+
end module MOM_OCMIP2_CFC
diff --git a/src/tracer/MOM_OCMIP2_CO2calc.F90 b/src/tracer/MOM_OCMIP2_CO2calc.F90
deleted file mode 100644
index 58b4adb380..0000000000
--- a/src/tracer/MOM_OCMIP2_CO2calc.F90
+++ /dev/null
@@ -1,530 +0,0 @@
-module MOM_ocmip2_co2calc_mod !{
-
-! This file is part of MOM6. See LICENSE.md for the license.
-
-! Richard D. Slater
-!
-!
-! John P. Dunne
-!
-!
-!
-! Surface fCO2 calculation
-!
-!
-!
-! Calculate the fugacity of CO2 at the surface in thermodynamic
-! equilibrium with the current alkalinity (Alk) and total dissolved
-! inorganic carbon (DIC) at a particular temperature and salinity
-! using an initial guess for the total hydrogen
-! ion concentration (htotal)
-!
-!
-
-!
-!------------------------------------------------------------------
-!
-! Global definitions
-!
-!------------------------------------------------------------------
-!
-
-implicit none ; private
-
-public :: MOM_ocmip2_co2calc, CO2_dope_vector
-
-! This include declares and sets the variable "version".
-#include "version_variable.h"
-
-type CO2_dope_vector
- integer :: isc, iec, jsc, jec
- integer :: isd, ied, jsd, jed
-end type CO2_dope_vector
-!
-!-----------------------------------------------------------------------
-!
-! Subroutine and function definitions
-!
-!-----------------------------------------------------------------------
-!
-
-contains
-
-
-!#######################################################################
-!
-!
-!
-! Calculate co2* from total alkalinity and total CO2 at
-! temperature (t) and salinity (s).
-! It is assumed that init_ocmip2_co2calc has already been called with
-! the T and S to calculate the various coefficients.
-!
-! INPUT
-!
-! dope_vec = an array of indices corresponding to the compute
-! and data domain boundaries.
-!
-! mask = land mask array (0.0 = land)
-!
-! dic_in = total inorganic carbon (mol/kg)
-! where 1 T = 1 metric ton = 1000 kg
-!
-! ta_in = total alkalinity (eq/kg)
-!
-! pt_in = inorganic phosphate (mol/kg)
-!
-! sit_in = inorganic silicate (mol/kg)
-!
-! htotallo = lower limit of htotal range
-!
-! htotalhi = upper limit of htotal range
-!
-! htotal = H+ concentration (mol/kg)
-!
-! OUTPUT
-! co2star = CO2*water, or H2CO3 concentration (mol/kg)
-! alpha = Solubility of CO2 for air (mol/kg/atm)
-! pco2surf = oceanic pCO2 (ppmv)
-! co3_ion = Carbonate ion, or CO3-- concentration (mol/kg)
-!
-! FILES and PROGRAMS NEEDED: drtsafe, ta_iter_1
-!
-! IMPORTANT: co2star and alpha need to be multiplied by rho before being
-! passed to the atmosphere.
-!
-!
-
-subroutine MOM_ocmip2_co2calc(dope_vec, mask, &
- t_in, s_in, dic_in, pt_in, sit_in, ta_in, htotallo, &
- htotalhi, htotal, co2star, alpha, pCO2surf, co3_ion) !{
-
-implicit none
-
-!
-! local parameters
-!
-
-real, parameter :: permeg = 1.e-6
-real, parameter :: xacc = 1.0e-10
-
-!
-! arguments
-!
-type(CO2_dope_vector), intent(in) :: dope_vec
-real, dimension(dope_vec%isd:dope_vec%ied,dope_vec%jsd:dope_vec%jed), &
- intent(in):: mask, &
- t_in, &
- s_in, &
- dic_in, &
- pt_in, &
- sit_in, &
- ta_in, &
- htotallo, &
- htotalhi
-real, dimension(dope_vec%isd:dope_vec%ied,dope_vec%jsd:dope_vec%jed), &
- intent(inout) :: htotal
-real, dimension(dope_vec%isd:dope_vec%ied,dope_vec%jsd:dope_vec%jed), &
- optional, intent(out) :: alpha, &
- pCO2surf, &
- co2star, &
- co3_ion
-!
-! local variables
-!
-integer :: isc, iec, jsc, jec
-integer :: i,j
-real :: alpha_internal
-real :: bt
-real :: co2star_internal
-real :: dlogtk
-real :: ft
-real :: htotal2
-real :: invtk
-real :: is
-real :: is2
-real :: k0
-real :: k1
-real :: k2
-real :: k1p
-real :: k2p
-real :: k3p
-real :: kb
-real :: kf
-real :: ks
-real :: ksi
-real :: kw
-real :: log100
-real :: s2
-real :: scl
-real :: sqrtis
-real :: sqrts
-real :: st
-real :: tk
-real :: tk100
-real :: tk1002
-real :: logf_of_s
-
-! Set the loop indices.
- isc = dope_vec%isc ; iec = dope_vec%iec
- jsc = dope_vec%jsc ; jec = dope_vec%jec
-
-!
-! Initialize the module
-!
- log100 = log(100.0)
-
- do j = jsc, jec !{
- do i = isc, iec !{
-!
-!---------------------------------------------------------------------
-!
-!***********************************************************************
-! Calculate all constants needed to convert between various measured
-! carbon species. References for each equation are noted in the code.
-! Once calculated, the constants are stored and passed in the common
-! block "const". The original version of this code was based on
-! the code by Dickson in Version 2 of "Handbook of Methods for the
-! Analysis of the Various Parameters of the Carbon Dioxide System
-! in Seawater", DOE, 1994 (SOP No. 3, p25-26).
- tk = 273.15 + t_in(i,j)
- tk100 = tk / 100.0
- tk1002 = tk100**2
- invtk = 1.0 / tk
- dlogtk = log(tk)
- is = 19.924 * s_in(i,j) /(1000.0 -1.005 * s_in(i,j))
- is2 = is * is
- sqrtis = sqrt(is)
- s2 = s_in(i,j) * s_in(i,j)
- sqrts = sqrt(s_in(i,j))
- scl = s_in(i,j) / 1.80655
- logf_of_s = log(1.0 - 0.001005 * s_in(i,j))
-!
-! k0 from Weiss 1974
-!
-
- k0 = exp(93.4517/tk100 - 60.2409 + 23.3585 * log(tk100) + &
- s_in(i,j) * (0.023517 - 0.023656 * tk100 + &
- 0.0047036 * tk1002))
-!
-! k1 = [H][HCO3]/[H2CO3]
-! k2 = [H][CO3]/[HCO3]
-!
-! Millero p.664 (1995) using Mehrbach et al. data on seawater scale
-!
-
- k1 = 10.0**(-(3670.7 * invtk - 62.008 + 9.7944 * dlogtk - &
- 0.0118 * s_in(i,j) + 0.000116 * s2))
- k2 = 10.0**(-(1394.7 * invtk + 4.777 - &
- 0.0184 * s_in(i,j) + 0.000118 * s2))
-!
-! kb = [H][BO2]/[HBO2]
-!
-! Millero p.669 (1995) using data from Dickson (1990)
-!
-
- kb = exp((-8966.90 - 2890.53 * sqrts - 77.942 * s_in(i,j) + &
- 1.728 * sqrts**3 - 0.0996 * s2) * invtk + (148.0248 + &
- 137.1942 * sqrts + 1.62142 * s_in(i,j)) + (-24.4344 - &
- 25.085 * sqrts - 0.2474 * s_in(i,j)) * dlogtk + &
- 0.053105 * sqrts * tk)
-!
-! k1p = [H][H2PO4]/[H3PO4]
-!
-! DOE(1994) eq 7.2.20 with footnote using data from Millero (1974)
-!
-
- k1p = exp(-4576.752 * invtk + 115.525 - 18.453 * dlogtk + &
- (-106.736 * invtk + 0.69171) * sqrts + (-0.65643 * &
- invtk - 0.01844) * s_in(i,j))
-!
-! k2p = [H][HPO4]/[H2PO4]
-!
-! DOE(1994) eq 7.2.23 with footnote using data from Millero (1974))
-!
-
- k2p = exp(-8814.715 * invtk + 172.0883 - 27.927 * (-160.340 * &
- invtk + 1.3566) * sqrts + (0.37335 * invtk - &
- 0.05778) * s_in(i,j))
-!
-!-----------------------------------------------------------------------
-! k3p = [H][PO4]/[HPO4]
-!
-! DOE(1994) eq 7.2.26 with footnote using data from Millero (1974)
-!
-
- k3p = exp(-3070.75 * invtk - 18.141 +(17.27039 * invtk + &
- 2.81197) * sqrts + (-44.99486 * invtk - 0.09984) * &
- s_in(i,j))
-!
-!-----------------------------------------------------------------------
-! ksi = [H][SiO(OH)3]/[Si(OH)4]
-!
-! Millero p.671 (1995) using data from Yao and Millero (1995)
-!
- ksi = exp(-8904.2 * invtk + 117.385 - 19.334 * dlogtk + &
- (-458.79 * invtk + 3.5913) * sqrtis + (188.74 * &
- invtk - 1.5998) * is + (-12.1652 * invtk + 0.07871) * &
- is2 + logf_of_s)
-!
-!-----------------------------------------------------------------------
-! kw = [H][OH]
-!
-! Millero p.670 (1995) using composite data
-!
-
- kw = exp(-13847.26 * invtk + 148.9652 - 23.6521 * dlogtk + &
- (118.67 * invtk - 5.977 + 1.0495 * dlogtk) * sqrts - &
- 0.01615 * s_in(i,j))
-!
-!-----------------------------------------------------------------------
-! ks = [H][SO4]/[HSO4]
-!
-! Dickson (1990, J. chem. Thermodynamics 22, 113)
-!
- ks = exp(-4276.1 * invtk + 141.328 - 23.093 * dlogtk + &
- (-13856.0 * invtk + 324.57 - 47.986 * dlogtk) * &
- sqrtis + (35474.0 * invtk - 771.54 + 114.723 * &
- dlogtk) * is - 2698.0 * invtk * sqrtis**3 + &
- 1776.0 * invtk * is2 + logf_of_s)
-!
-!-----------------------------------------------------------------------
-! kf = [H][F]/[HF]
-!
-! Dickson and Riley (1979) -- change pH scale to total
-!
- kf = exp(1590.2 * invtk - 12.641 + 1.525 * sqrtis + logf_of_s + &
- log(1.0 + (0.1400 / 96.062) * scl / ks))
-!
-!-----------------------------------------------------------------------
-! Calculate concentrations for borate, sulfate, and fluoride
-!
-! Uppstrom (1974)
-!
- bt = 0.000232 / 10.811 * scl
-!
-! Morris & Riley (1966)
-!
- st = 0.14 / 96.062 * scl
-!
-! Riley (1965)
-!
- ft = 0.000067 / 18.9984 * scl
-!
-!***********************************************************************
-!
-! Calculate [H+] total when DIC and TA are known at T, S and 1 atm.
-! The solution converges to err of xacc. The solution must be within
-! the range x1 to x2.
-!
-! If DIC and TA are known then either a root finding or iterative method
-! must be used to calculate htotal. In this case we use the
-! Newton-Raphson "safe" method taken from "Numerical Recipes"
-! (function "rtsafe.f" with error trapping removed).
-!
-! As currently set, this procedure iterates about 12 times. The x1
-! and x2 values set below will accomodate ANY oceanographic values.
-! If an initial guess of the pH is known, then the number of
-! iterations can be reduced to about 5 by narrowing the gap between
-! x1 and x2. It is recommended that the first few time steps be run
-! with x1 and x2 set as below. After that, set x1 and x2 to the
-! previous value of the pH +/- ~0.5. The current setting of xacc will
-! result in co2star accurate to 3 significant figures (xx.y). Making
-! xacc bigger will result in faster convergence also, but this is not
-! recommended (xacc of 10**-9 drops precision to 2 significant
-! figures).
-!
- if (mask(i,j) /= 0.0) then !{
- htotal(i,j) = drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, &
- ks, kf, bt, dic_in(i,j), ft, pt_in(i,j),&
- sit_in(i,j), st, ta_in(i,j), &
- htotalhi(i,j), htotallo(i,j), xacc)
- endif
-!
-! Calculate [CO2*] as defined in DOE Methods Handbook 1994 Ver.2,
-! ORNL/CDIAC-74, Dickson and Goyet, eds. (Ch 2 p 10, Eq A.49)
-!
- htotal2 = htotal(i,j) * htotal(i,j)
- co2star_internal = dic_in(i,j) * htotal2 / (htotal2 + &
- k1 * htotal(i,j) + k1 * k2)
- if (present(co2star)) co2star(i,j) = co2star_internal
- if (present(co3_ion)) co3_ion(i,j) = co2star_internal * k1 * k2 / htotal2
-!
-! Weiss & Price (1980, Mar. Chem., 8, 347-359; Eq 13 with table 6
-! values)
-!
- if (present(alpha) .or. present(pCO2surf)) then
- alpha_internal = exp(-162.8301 + 218.2968 / tk100 + 90.9241 * &
- (dlogtk -log100) - 1.47696 * tk1002 + &
- s_in(i,j) * (0.025695 - 0.025225 * tk100 + &
- 0.0049867 * tk1002))
- endif
- if (present(alpha)) alpha(i,j) = alpha_internal
- if (present(pCO2surf)) then
- pCO2surf(i,j) = co2star_internal / (alpha_internal * permeg)
- endif
- enddo !} i
- enddo !} j
-
-return
-
-end subroutine MOM_ocmip2_co2calc !}
-! NAME="MOM_ocmip2_co2calc"
-
-
-!#######################################################################
-!
-!
-!
-! File taken from Numerical Recipes. Modified R. M. Key 4/94
-!
-
-function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, &
- bt, dic, ft, pt, sit, st, ta, x1, x2, xacc) !{
-
-implicit none
-
-!
-! arguments
-!
-
-real :: k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf
-real :: bt, dic, ft, pt, sit, st, ta
-real :: drtsafe
-real :: x1, x2, xacc
-
-!
-! local parameters
-!
-
-integer, parameter :: maxit = 100
-
-!
-! local variables
-!
-
-integer :: j
-real :: fl, df, fh, swap, xl, xh, dxold, dx, f, temp
-
-call ta_iter_1(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, &
- bt, dic, ft, pt, sit, st, ta, x1, fl, df)
-call ta_iter_1(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, &
- bt, dic, ft, pt, sit, st, ta, x2, fh, df)
-if (fl < 0.0) then
- xl=x1
- xh=x2
-else
- xh=x1
- xl=x2
- swap=fl
- fl=fh
- fh=swap
-endif
-drtsafe=0.5*(x1+x2)
-dxold=abs(x2-x1)
-dx=dxold
-call ta_iter_1(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, &
- bt, dic, ft, pt, sit, st, ta, drtsafe, f, df)
-do j=1,maxit !{
- if (((drtsafe-xh)*df-f)*((drtsafe-xl)*df-f) >= 0.0 .or. &
- abs(2.0*f) > abs(dxold*df)) then
- dxold=dx
- dx=0.5*(xh-xl)
- drtsafe=xl+dx
- if (xl == drtsafe) then
-! write (6,*) 'Exiting drtsafe at A on iteration ', j, ', ph = ', -log10(drtsafe)
- return
- endif
- else
- dxold=dx
- dx=f/df
- temp=drtsafe
- drtsafe=drtsafe-dx
- if (temp == drtsafe) then
-! write (6,*) 'Exiting drtsafe at B on iteration ', j, ', ph = ', -log10(drtsafe)
- return
- endif
- endif
- if (abs(dx) < xacc) then
-! write (6,*) 'Exiting drtsafe at C on iteration ', j, ', ph = ', -log10(drtsafe)
- return
- endif
- call ta_iter_1(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, &
- bt, dic, ft, pt, sit, st, ta, drtsafe, f, df)
- if (f < 0.0) then
- xl=drtsafe
- fl=f
- else
- xh=drtsafe
- fh=f
- endif
-enddo !} j
-
-return
-
-end function drtsafe !}
-! NAME="drtsafe"
-
-
-!#######################################################################
-!
-!
-!
-! This routine expresses TA as a function of DIC, htotal and constants.
-! It also calculates the derivative of this function with respect to
-! htotal. It is used in the iterative solution for htotal. In the call
-! "x" is the input value for htotal, "fn" is the calculated value for TA
-! and "df" is the value for dTA/dhtotal
-!
-
-subroutine ta_iter_1(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, &
- bt, dic, ft, pt, sit, st, ta, x, fn, df) !{
-
-implicit none
-
-!
-! arguments
-!
-
-real :: k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf
-real :: bt, dic, ft, pt, sit, st, ta, x, fn, df
-
-!
-! local variables
-!
-
-real :: x2, x3, k12, k12p, k123p, c, a, a2, da, b, b2, db
-
-x2 = x*x
-x3 = x2*x
-k12 = k1*k2
-k12p = k1p*k2p
-k123p = k12p*k3p
-c = 1.0 + st/ks
-a = x3 + k1p*x2 + k12p*x + k123p
-a2 = a*a
-da = 3.0*x2 + 2.0*k1p*x + k12p
-b = x2 + k1*x + k12
-b2 = b*b
-db = 2.0*x + k1
-!
-! fn = hco3+co3+borate+oh+hpo4+2*po4+silicate+hfree+hso4+hf+h3po4-ta
-!
-fn = k1*x*dic/b + 2.0*dic*k12/b + bt/ (1.0 + x/kb) + kw/x + &
- pt*k12p*x/a + 2.0*pt*k123p/a + sit/(1.0 + x/ksi) - &
- x/c - st/(1.0 + ks/x/c) - ft/(1.0 + kf/x) - pt*x3/a - ta
-!
-! df = dfn/dx
-!
-df = ((k1*dic*b) - k1*x*dic*db)/b2 - 2.0*dic*k12*db/b2 - &
- bt/kb/(1.0+x/kb)**2 - kw/x2 + (pt*k12p*(a - x*da))/a2 - &
- 2.0*pt*k123p*da/a2 - sit/ksi/ (1.0+x/ksi)**2 - 1.0/c + &
- st*(1.0 + ks/x/c)**(-2)*(ks/c/x2) + &
- ft*(1.0 + kf/x)**(-2)*kf/x2 - pt*x2*(3.0*a-x*da)/a2
-
-return
-
-end subroutine ta_iter_1 !}
-! NAME="ta_iter_1"
-
-end module MOM_ocmip2_co2calc_mod !}
diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90
index 7b7fe8e5a2..ee1f038180 100644
--- a/src/tracer/MOM_generic_tracer.F90
+++ b/src/tracer/MOM_generic_tracer.F90
@@ -35,7 +35,7 @@ module MOM_generic_tracer
use MOM_spatial_means, only : global_area_mean
use MOM_sponge, only : set_up_sponge_field, sponge_CS
use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS
- use MOM_time_manager, only : time_type, get_time, set_time
+ use MOM_time_manager, only : time_type, set_time
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_Z_init, only : tracer_Z_init
@@ -66,8 +66,8 @@ module MOM_generic_tracer
! initialization code if they are not found in the
! restart files.
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
+ type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to
+ ! regulate the timing of diagnostic output.
type(MOM_restart_CS), pointer :: restart_CSp => NULL()
! The following pointer will be directed to the first element of the
@@ -435,28 +435,29 @@ end subroutine initialize_MOM_generic_tracer
!! flux as a source.
subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, CS, tv, optics, &
evap_CFL_limit, minimum_forcing_depth)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old !< Layer thickness before entrainment,
- !! in m or kg !m-2.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_new !< Layer thickness after entrainment,
- !! in m or kg !m-2.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: ea !< an array to which the amount of
- !! fluid entrained from the layer !above during this
- !! call will be added, in m or kg !m-2.
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< an array to which the amount of
- !! fluid entrained from the layer !below during this
- !! call will be added, in m or kg !m-2.
- type(forcing), intent(in) :: fluxes
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h_new !< Layer thickness after entrainment, in 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 during this call, in 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 during this call, in m or kg m-2.
+ type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic
+ !! and tracer forcing fields.
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hml !< Mixed layer depth
- real, intent(in) :: dt !< The amount of time covered by this call, in s
- type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
- type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
- type(optics_type), intent(in) :: optics
- real, optional,intent(in) :: evap_CFL_limit !< Limits how much water can be fluxed out of
- !! the top layer Stored previously in diabatic CS.
- real, optional,intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes
- !! can be applied Stored previously in diabatic CS.
+ real, intent(in) :: dt !< The amount of time covered by this call, in s
+ type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
+ type(optics_type), intent(in) :: optics !< The structure containing optical properties.
+ real, optional, intent(in) :: evap_CFL_limit !< Limits how much water can be fluxed out of
+ !! the top layer Stored previously in diabatic CS.
+ real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes
+ !! can be applied Stored previously in diabatic CS.
! The arguments to this subroutine are redundant in that
! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1]
@@ -497,7 +498,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml,
!
g_tracer=>CS%g_tracer_list
do
- if (_allocated(g_tracer%trunoff)) then
+ if (_ALLOCATED(g_tracer%trunoff)) then
call g_tracer_get_alias(g_tracer,g_tracer_name)
call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array)
call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array)
@@ -518,7 +519,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml,
!Prepare input arrays for source update
!
- rho_dzt(:,:,:) = GV%H_to_kg_m2 * GV%Angstrom
+ rho_dzt(:,:,:) = GV%H_to_kg_m2 * GV%Angstrom_H
do k = 1, nk ; do j = jsc, jec ; do i = isc, iec !{
rho_dzt(i,j,k) = GV%H_to_kg_m2 * h_old(i,j,k)
enddo ; enddo ; enddo !}
@@ -661,7 +662,7 @@ end function MOM_generic_tracer_stock
function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, ygmin, zgmin, &
xgmax, ygmax, zgmax , G, CS, names, units)
use mpp_utilities_mod, only: mpp_array_global_min_max
- integer, intent(in) :: ind_start
+ integer, intent(in) :: ind_start !< The index of the tracer to start with
logical, dimension(:), intent(out) :: got_minmax !< Indicates whether the global min and
!! max are found for each tracer
real, dimension(:), intent(out) :: gmin !< Global minimum of each tracer, in kg
@@ -708,7 +709,6 @@ function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, yg
allocate(geo_z(nk))
do k=1,nk ; geo_z(k) = real(k) ; enddo
-
m=ind_start ; g_tracer=>CS%g_tracer_list
do
call g_tracer_get_alias(g_tracer,names(m))
@@ -721,14 +721,12 @@ function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, yg
tr_ptr => tr_field(:,:,:,1)
-
call mpp_array_global_min_max(tr_ptr, grid_tmask,isd,jsd,isc,iec,jsc,jec,nk , gmin(m), gmax(m), &
G%geoLonT,G%geoLatT,geo_z,xgmin(m), ygmin(m), zgmin(m), &
xgmax(m), ygmax(m), zgmax(m))
got_minmax(m) = .true.
-
!traverse the linked list till hit NULL
call g_tracer_get_next(g_tracer, g_tracer_next)
if (.NOT. associated(g_tracer_next)) exit
@@ -824,8 +822,9 @@ subroutine MOM_generic_flux_init(verbosity)
end subroutine MOM_generic_flux_init
subroutine MOM_generic_tracer_fluxes_accumulate(flux_tmp, weight)
- type(forcing), intent(in) :: flux_tmp
- real, intent(in) :: weight
+ type(forcing), intent(in) :: flux_tmp !< A structure containing pointers to
+ !! thermodynamic and tracer forcing fields.
+ real, intent(in) :: weight !< A weight for accumulating this flux
call generic_tracer_coupler_accumulate(flux_tmp%tr_fluxes, weight)
@@ -834,7 +833,7 @@ end subroutine MOM_generic_tracer_fluxes_accumulate
!> Copy the requested tracer into an array.
subroutine MOM_generic_tracer_get(name,member,array, CS)
character(len=*), intent(in) :: name !< Name of requested tracer.
- character(len=*), intent(in) :: member !< ??
+ character(len=*), intent(in) :: member !< The tracer element to return.
real, dimension(:,:,:), intent(out) :: array !< Array filled by this routine.
type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90
index 65679fe2a6..4002fe646b 100644
--- a/src/tracer/MOM_neutral_diffusion.F90
+++ b/src/tracer/MOM_neutral_diffusion.F90
@@ -31,61 +31,60 @@ module MOM_neutral_diffusion
#include
-public neutral_diffusion
-public neutral_diffusion_init
-public neutral_diffusion_end
+public neutral_diffusion, neutral_diffusion_init, neutral_diffusion_end
public neutral_diffusion_calc_coeffs
public neutral_diffusion_unit_tests
+!> The control structure for the MOM_neutral_diffusion module
type, public :: neutral_diffusion_CS ; private
- integer :: nkp1 ! Number of interfaces for a column = nk + 1
- integer :: nsurf ! Number of neutral surfaces
- integer :: deg = 2 ! Degree of polynomial used for reconstructions
- logical :: continuous_reconstruction = .true. ! True if using continuous PPM reconstruction at interfaces
- logical :: refine_position = .false.
- logical :: debug = .false.
- integer :: max_iter ! Maximum number of iterations if refine_position is defined
- real :: tolerance ! Convergence criterion representing difference from true neutrality
- real :: ref_pres ! Reference pressure, negative if using locally referenced neutral density
+ integer :: nkp1 !< Number of interfaces for a column = nk + 1
+ integer :: nsurf !< Number of neutral surfaces
+ integer :: deg = 2 !< Degree of polynomial used for reconstructions
+ logical :: continuous_reconstruction = .true. !< True if using continuous PPM reconstruction at interfaces
+ logical :: refine_position = .false. !< If true, iterate to refine the corresponding positions
+ !! in neighboring columns
+ logical :: debug = .false. !< If true, write verbose debugging messages
+ integer :: max_iter !< Maximum number of iterations if refine_position is defined
+ real :: tolerance !< Convergence criterion representing difference from true neutrality
+ real :: ref_pres !< Reference pressure, negative if using locally referenced neutral density
! Positions of neutral surfaces in both the u, v directions
- real, allocatable, dimension(:,:,:) :: uPoL ! Non-dimensional position with left layer uKoL-1, u-point
- real, allocatable, dimension(:,:,:) :: uPoR ! Non-dimensional position with right layer uKoR-1, u-point
- integer, allocatable, dimension(:,:,:) :: uKoL ! Index of left interface corresponding to neutral surface,
- ! at a u-point
- integer, allocatable, dimension(:,:,:) :: uKoR ! Index of right interface corresponding to neutral surface,
- ! at a u-point
- real, allocatable, dimension(:,:,:) :: uHeff ! Effective thickness at u-point (H units)
- real, allocatable, dimension(:,:,:) :: vPoL ! Non-dimensional position with left layer uKoL-1, v-point
- real, allocatable, dimension(:,:,:) :: vPoR ! Non-dimensional position with right layer uKoR-1, v-point
- integer, allocatable, dimension(:,:,:) :: vKoL ! Index of left interface corresponding to neutral surface,
- ! at a v-point
- integer, allocatable, dimension(:,:,:) :: vKoR ! Index of right interface corresponding to neutral surface,
- ! at a v-point
- real, allocatable, dimension(:,:,:) :: vHeff ! Effective thickness at v-point (H units)
+ real, allocatable, dimension(:,:,:) :: uPoL !< Non-dimensional position with left layer uKoL-1, u-point
+ real, allocatable, dimension(:,:,:) :: uPoR !< Non-dimensional position with right layer uKoR-1, u-point
+ integer, allocatable, dimension(:,:,:) :: uKoL !< Index of left interface corresponding to neutral surface,
+ !! at a u-point
+ integer, allocatable, dimension(:,:,:) :: uKoR !< Index of right interface corresponding to neutral surface,
+ !! at a u-point
+ real, allocatable, dimension(:,:,:) :: uHeff !< Effective thickness at u-point (H units)
+ real, allocatable, dimension(:,:,:) :: vPoL !< Non-dimensional position with left layer uKoL-1, v-point
+ real, allocatable, dimension(:,:,:) :: vPoR !< Non-dimensional position with right layer uKoR-1, v-point
+ integer, allocatable, dimension(:,:,:) :: vKoL !< Index of left interface corresponding to neutral surface,
+ !! at a v-point
+ integer, allocatable, dimension(:,:,:) :: vKoR !< Index of right interface corresponding to neutral surface,
+ !! at a v-point
+ real, allocatable, dimension(:,:,:) :: vHeff !< Effective thickness at v-point (H units)
! Coefficients of polynomial reconstructions for temperature and salinity
real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_T !< Polynomial coefficients for temperature
- real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_S !< 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/m3/degC) at interfaces
- real, allocatable, dimension(:,:,:) :: dRdS ! dRho/dS (kg/m3/ppt) 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(:,:,:) :: dRdT !< dRho/dT (kg/m3/degC) at interfaces
+ real, allocatable, dimension(:,:,:) :: dRdS !< dRho/dS (kg/m3/ppt) at interfaces
+ real, allocatable, dimension(:,:,:) :: Tint !< Interface T (degC)
+ real, allocatable, dimension(:,:,:) :: Sint !< Interface S (ppt)
+ real, allocatable, dimension(:,:,:) :: Pint !< Interface pressure (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(:,:,:,:) :: dRdT_i ! dRho/dT (kg/m3/degC) at top edge
- real, allocatable, dimension(:,:,:,:) :: dRdS_i ! dRho/dS (kg/m3/ppt) 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 ! structure to regulate output
- integer :: id_uhEff_2d = -1
- integer :: id_vhEff_2d = -1
-
- real :: C_p ! heat capacity of seawater (J kg-1 K-1)
+ 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(:,:,:,:) :: dRdT_i !< dRho/dT (kg/m3/degC) at top edge
+ real, allocatable, dimension(:,:,:,:) :: dRdS_i !< dRho/dS (kg/m3/ppt) 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
+ !! regulate the timing of diagnostic output.
+ 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
type(ndiff_aux_CS_type), pointer :: ndiff_aux_CS !< Store parameters for iteratively finding neutral surface
@@ -93,7 +92,7 @@ module MOM_neutral_diffusion
! This include declares and sets the variable "version".
#include "version_variable.h"
-character(len=40) :: mdl = "MOM_neutral_diffusion" ! module name
+character(len=40) :: mdl = "MOM_neutral_diffusion" !< module name
contains
@@ -1268,9 +1267,9 @@ real function absolute_position(n,ns,Pint,Karr,NParr,k_surface)
real, intent(in) :: Pint(n+1) !< Position of interfaces (Pa)
integer, intent(in) :: Karr(ns) !< Index of interface above position
real, intent(in) :: NParr(ns) !< Non-dimensional position within layer Karr(:)
-
+ integer, intent(in) :: k_surface !< k-interface to query
! Local variables
- integer :: k_surface, k
+ integer :: k
k = Karr(k_surface)
if (k>n) stop 'absolute_position: k>nk is out of bounds!'
diff --git a/src/tracer/MOM_neutral_diffusion_aux.F90 b/src/tracer/MOM_neutral_diffusion_aux.F90
index 2cc91606ff..c25564b8da 100644
--- a/src/tracer/MOM_neutral_diffusion_aux.F90
+++ b/src/tracer/MOM_neutral_diffusion_aux.F90
@@ -20,6 +20,7 @@ module MOM_neutral_diffusion_aux
public check_neutral_positions
public kahan_sum
+!> The control structure for this module
type, public :: ndiff_aux_CS_type ; private
integer :: nterm !< Number of terms in polynomial (deg+1)
integer :: max_iter !< Maximum number of iterations
@@ -27,10 +28,9 @@ module MOM_neutral_diffusion_aux
real :: xtol !< Criterion for how much position changes (nondim)
real :: ref_pres !< Determines whether a constant reference pressure is used everywhere or locally referenced
!< density is done. ref_pres <-1 is the latter, ref_pres >= 0. otherwise
- logical :: force_brent = .false. !< Use Brent's method instead of Newton even when second derivatives are available
- logical :: debug
+ logical :: force_brent = .false. !< Use Brent's method instead of Newton even when second derivatives are available
+ logical :: debug !< If true, write verbose debugging messages and checksusm
type(EOS_type), pointer :: EOS !< Pointer to equation of state used in the model
-
end type ndiff_aux_CS_type
contains
diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90
index 45f01686c5..dc616e8a49 100644
--- a/src/tracer/MOM_offline_aux.F90
+++ b/src/tracer/MOM_offline_aux.F90
@@ -44,12 +44,16 @@ module MOM_offline_aux
!> This updates thickness based on the convergence of horizontal mass fluxes
!! NOTE: Only used in non-ALE mode
subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new)
- type(ocean_grid_type), pointer :: G
- type(verticalGrid_type), pointer :: GV
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_new
+ type(ocean_grid_type), pointer :: G !< ocean grid structure
+ type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: uhtr !< Accumulated mass flux through zonal face, in kg
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: vhtr !< Accumulated mass flux through meridional face, in kg
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h_pre !< Previous layer thicknesses, in kg m-2.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: h_new !< Updated layer thicknesses, in kg m-2.
! Local variables
integer :: i, j, k, m, is, ie, js, je, nz
@@ -66,7 +70,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new)
! add a bit of mass to avoid truncation errors. This will lead to
! non-conservation of tracers
h_new(i,j,k) = h_new(i,j,k) + &
- max(GV%Angstrom, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k))
+ max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k))
! Convert back to thickness
h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j)
@@ -78,12 +82,19 @@ end subroutine update_h_horizontal_flux
!> Updates layer thicknesses due to vertical mass transports
!! NOTE: Only used in non-ALE configuration
subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new)
- type(ocean_grid_type), pointer :: G
- type(verticalGrid_type), pointer :: GV
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: ea
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: eb
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_new
+ type(ocean_grid_type), pointer :: G !< ocean grid structure
+ type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: ea !< Mass of fluid entrained from the layer
+ !! above within this timestep, in kg m-2
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: eb !< Mass of fluid entrained from the layer
+ !! below within this timestep, in kg m-2
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h_pre !< Layer thicknesses at the end of the previous
+ !! step, in kg m-2.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: h_new !< Updated layer thicknesses, in kg m-2.
! Local variables
integer :: i, j, k, m, is, ie, js, je, nz
@@ -124,13 +135,21 @@ end subroutine update_h_vertical_flux
!> This routine limits the mass fluxes so that the a layer cannot be completely depleted.
!! NOTE: Only used in non-ALE mode
subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre)
- type(ocean_grid_type), pointer :: G
- type(verticalGrid_type), pointer :: GV
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre
+ type(ocean_grid_type), pointer :: G !< ocean grid structure
+ type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: uh !< Mass flux through zonal face, in kg
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(inout) :: vh !< Mass flux through meridional face, in kg
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: ea !< Mass of fluid entrained from the layer
+ !! above within this timestep, in kg m-2
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: eb !< Mass of fluid entrained from the layer
+ !! below within this timestep, in kg m-2
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h_pre !< Layer thicknesses at the end of the previous
+ !! step, in kg m-2.
! Local variables
integer :: i, j, k, m, is, ie, js, je, nz
@@ -219,10 +238,13 @@ end subroutine limit_mass_flux_3d
!> In the case where offline advection has failed to converge, redistribute the u-flux
!! into remainder of the water column as a barotropic equivalent
subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh)
- type(ocean_grid_type), pointer :: G
- type(verticalGrid_type), pointer :: GV
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: hvol
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh
+ type(ocean_grid_type), pointer :: G !< ocean grid structure
+ type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in ) :: hvol !< Mass of water in the cells at the end
+ !! of the previous timestep, in kg
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: uh !< Zonal mass transport within a timestep, in kg
real, dimension(SZIB_(G),SZK_(G)) :: uh2d
real, dimension(SZIB_(G)) :: uh2d_sum
@@ -272,7 +294,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh)
endif
! Calculate and check that column integrated transports match the original to
! within the tolerance limit
- uh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i+1,j))
+ uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j))
if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) &
call MOM_error(WARNING,"Column integral of uh does not match after "//&
"barotropic redistribution")
@@ -287,10 +309,13 @@ end subroutine distribute_residual_uh_barotropic
!> Redistribute the v-flux as a barotropic equivalent
subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh)
- type(ocean_grid_type), pointer :: G
- type(verticalGrid_type), pointer :: GV
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: hvol
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh
+ type(ocean_grid_type), pointer :: G !< ocean grid structure
+ type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in ) :: hvol !< Mass of water in the cells at the end
+ !! of the previous timestep, in kg
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(inout) :: vh !< Meridional mass transport within a timestep, in kg
real, dimension(SZJB_(G),SZK_(G)) :: vh2d
real, dimension(SZJB_(G)) :: vh2d_sum
@@ -339,7 +364,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh)
endif
! Calculate and check that column integrated transports match the original to
! within the tolerance limit
- vh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i,j+1))
+ vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1))
if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then
call MOM_error(WARNING,"Column integral of vh does not match after "//&
"barotropic redistribution")
@@ -357,10 +382,13 @@ end subroutine distribute_residual_vh_barotropic
!> In the case where offline advection has failed to converge, redistribute the u-flux
!! into layers above
subroutine distribute_residual_uh_upwards(G, GV, hvol, uh)
- type(ocean_grid_type), pointer :: G
- type(verticalGrid_type), pointer :: GV
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: hvol
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh
+ type(ocean_grid_type), pointer :: G !< ocean grid structure
+ type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in ) :: hvol !< Mass of water in the cells at the end
+ !! of the previous timestep, in kg
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: uh !< Zonal mass transport within a timestep, in kg
real, dimension(SZIB_(G),SZK_(G)) :: uh2d
real, dimension(SZI_(G),SZK_(G)) :: h2d
@@ -372,7 +400,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh)
! Set index-related variables for fields on T-grid
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
- min_h = GV%Angstrom*0.1
+ min_h = GV%Angstrom_H*0.1
do j=js,je
! Copy over uh and cell volume to working arrays
@@ -432,7 +460,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh)
! Calculate and check that column integrated transports match the original to
! within the tolerance limit
- uh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i+1,j))
+ uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j))
if (abs(uh_col - sum(uh2d(I,:)))>uh_neglect) then
call MOM_error(WARNING,"Column integral of uh does not match after "//&
"upwards redistribution")
@@ -450,10 +478,13 @@ end subroutine distribute_residual_uh_upwards
!> In the case where offline advection has failed to converge, redistribute the u-flux
!! into layers above
subroutine distribute_residual_vh_upwards(G, GV, hvol, vh)
- type(ocean_grid_type), pointer :: G
- type(verticalGrid_type), pointer :: GV
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: hvol
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh
+ type(ocean_grid_type), pointer :: G !< ocean grid structure
+ type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in ) :: hvol !< Mass of water in the cells at the end
+ !! of the previous timestep, in kg
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(inout) :: vh !< Meridional mass transport within a timestep, in kg
real, dimension(SZJB_(G),SZK_(G)) :: vh2d
real, dimension(SZJB_(G)) :: vh2d_sum
@@ -467,7 +498,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh)
! Set index-related variables for fields on T-grid
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
- min_h = 0.1*GV%Angstrom
+ min_h = 0.1*GV%Angstrom_H
do i=is,ie
! Copy over uh and cell volume to working arrays
@@ -527,7 +558,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh)
! Calculate and check that column integrated transports match the original to
! within the tolerance limit
- vh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i,j+1))
+ vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1))
if ( ABS(vh_col-SUM(vh2d(J,:))) > vh_neglect) then
call MOM_error(WARNING,"Column integral of vh does not match after "//&
"upwards redistribution")
@@ -544,10 +575,10 @@ end subroutine distribute_residual_vh_upwards
!> add_diurnal_SW adjusts the shortwave fluxes in an forcying_type variable
!! to add a synthetic diurnal cycle. Adapted from SIS2
subroutine offline_add_diurnal_SW(fluxes, G, Time_start, Time_end)
- type(forcing), intent(inout) :: fluxes !< The type with atmospheric fluxes to be adjusted.
- type(ocean_grid_type), intent(in) :: G !< The sea-ice lateral grid type.
- type(time_type), intent(in) :: Time_start !< The start time for this step.
- type(time_type), intent(in) :: Time_end !< The ending time for this step.
+ type(forcing), intent(inout) :: fluxes !< The type with atmospheric fluxes to be adjusted.
+ type(ocean_grid_type), intent(in) :: G !< The ocean lateral grid type.
+ type(time_type), intent(in) :: Time_start !< The start time for this step.
+ type(time_type), intent(in) :: Time_end !< The ending time for this step.
real :: diurnal_factor, time_since_ae, rad
real :: fracday_dt, fracday_day
@@ -606,9 +637,9 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_
character(len=*), intent(in ) :: snap_file !< Name of file with snapshot fields
character(len=*), intent(in ) :: surf_file !< Name of file with surface fields
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
- intent(inout) :: uhtr !< Zonal mass fluxes
+ intent(inout) :: uhtr !< Zonal mass fluxes in kg
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
- intent(inout) :: vhtr !< Meridional mass fluxes
+ intent(inout) :: vhtr !< Meridional mass fluxes in kg
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
intent(inout) :: h_end !< End of timestep layer thickness
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
@@ -739,12 +770,12 @@ subroutine update_offline_from_arrays(G, GV, nk_input, ridx_sum, mean_file, sum_
character(len=200), intent(in ) :: mean_file !< Name of file with averages fields
character(len=200), intent(in ) :: sum_file !< Name of file with summed fields
character(len=200), intent(in ) :: snap_file !< Name of file with snapshot fields
- real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Zonal mass fluxes
- real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Meridional mass fluxes
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hend !< End of timestep layer thickness
- real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes
- real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes
- real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Zonal mass fluxes in kg
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Meridional mass fluxes in kg
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hend !< End of timestep layer thickness in kg m-2
+ real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes in kg
+ real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes in kg
+ real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness in kg m-2
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: temp !< Temperature array
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: salt !< Salinity array
real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array
diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90
index a821219cd5..8a59f69a61 100644
--- a/src/tracer/MOM_offline_main.F90
+++ b/src/tracer/MOM_offline_main.F90
@@ -15,7 +15,7 @@ module MOM_offline_main
use MOM_diabatic_aux, only : tridiagTS
use MOM_diag_mediator, only : diag_ctrl, post_data, register_diag_field
use MOM_domains, only : sum_across_PEs, pass_var, pass_vector
-use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe
+use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING
use MOM_error_handler, only : callTree_enter, callTree_leave
use MOM_file_parser, only : read_param, get_param, log_version, param_file_type
use MOM_forcing_type, only : forcing
@@ -42,32 +42,46 @@ module MOM_offline_main
#include "MOM_memory.h"
#include "version_variable.h"
+!> The control structure for the offline transport module
type, public :: offline_transport_CS ; private
- !> Pointers to relevant fields from the main MOM control structure
+ ! Pointers to relevant fields from the main MOM control structure
type(ALE_CS), pointer :: ALE_CSp => NULL()
+ !< A pointer to the ALE control structure
type(diabatic_CS), pointer :: diabatic_CSp => NULL()
+ !< A pointer to the diabatic control structure
type(diag_ctrl), pointer :: diag => NULL()
+ !< Structure that regulates diagnostic output
type(ocean_OBC_type), pointer :: OBC => NULL()
+ !< A pointer to the open boundary condition control structure
type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL()
+ !< A pointer to the tracer advection control structure
+ type(opacity_CS), pointer :: opacity_CSp => NULL()
+ !< A pointer to the opacity control structure
type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL()
+ !< A pointer to control structure that orchestrates the calling of tracer packages
type(tracer_registry_type), pointer :: tracer_Reg => NULL()
+ !< A pointer to the tracer registry
type(thermo_var_ptrs), pointer :: tv => NULL()
+ !< A structure pointing to various thermodynamic variables
type(ocean_grid_type), pointer :: G => NULL()
+ !< Pointer to a structure containing metrics and related information
type(verticalGrid_type), pointer :: GV => NULL()
+ !< Pointer to structure containing information about the vertical grid
type(optics_type), pointer :: optics => NULL()
- type(opacity_CS), pointer :: opacity_CSp => NULL()
+ !< Pointer to the optical properties type
!> Variables related to reading in fields from online run
integer :: start_index !< Timelevel to start
integer :: iter_no !< Timelevel to start
integer :: numtime !< How many timelevels in the input fields
integer :: accumulated_time !< Length of time accumulated in the current offline interval
- integer :: & !< Index of each of the variables to be read in
- ridx_sum = -1, & !! Separate indices for each variable if they are
- ridx_snap = -1 !! setoff from each other in time
- integer :: nk_input !! Number of input levels in the input fields
- character(len=200) :: offlinedir ! Directory where offline fields are stored
+ ! Index of each of the variables to be read in with separate indices for each variable if they
+ ! are set off from each other in time
+ integer :: ridx_sum = -1 !< Read index offset of the summed variables
+ integer :: ridx_snap = -1 !< Read index offset of the snapshot variables
+ integer :: nk_input !< Number of input levels in the input fields
+ character(len=200) :: offlinedir !< Directory where offline fields are stored
character(len=200) :: & ! Names of input files
surf_file, & !< Contains surface fields (2d arrays)
snap_file, & !< Snapshotted fields (layer thicknesses)
@@ -79,14 +93,14 @@ module MOM_offline_main
!! 'both' if both methods are used
character(len=20) :: mld_var_name !< Name of the mixed layer depth variable to use
logical :: fields_are_offset !< True if the time-averaged fields and snapshot fields are
- ! offset by one time level
+ !! offset by one time level
logical :: x_before_y !< Which horizontal direction is advected first
logical :: print_adv_offline !< Prints out some updates each advection sub interation
logical :: skip_diffusion !< Skips horizontal diffusion of tracers
logical :: read_sw !< Read in averaged values for shortwave radiation
logical :: read_mld !< Check to see whether mixed layer depths should be read in
logical :: diurnal_sw !< Adds a synthetic diurnal cycle on shortwave radiation
- logical :: debug
+ logical :: debug !< If true, write verbose debugging messages
logical :: redistribute_barotropic !< Redistributes column-summed residual transports throughout
!! a column weighted by thickness
logical :: redistribute_upwards !< Redistributes remaining fluxes only in layers above
@@ -98,13 +112,13 @@ module MOM_offline_main
integer :: num_off_iter !< Number of advection iterations per offline step
integer :: num_vert_iter !< Number of vertical iterations per offline step
integer :: off_ale_mod !< Sets how frequently the ALE step is done during the advection
- real :: dt_offline ! Timestep used for offline tracers
- real :: dt_offline_vertical ! Timestep used for calls to tracer vertical physics
- real :: evap_CFL_limit, minimum_forcing_depth !< Copied from diabatic_CS controlling how tracers
- !! follow freshwater fluxes
+ real :: dt_offline !< Timestep used for offline tracers
+ real :: dt_offline_vertical !< Timestep used for calls to tracer vertical physics
+ real :: evap_CFL_limit !< Copied from diabatic_CS controlling how tracers follow freshwater fluxes
+ real :: minimum_forcing_depth !< Copied from diabatic_CS controlling how tracers follow freshwater fluxes
real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity
real :: min_residual !< The minimum amount of total mass flux before exiting the main advection routine
- !> Diagnostic manager IDs for some fields that may be of interest when doing offline transport
+ !>@{ Diagnostic manager IDs for some fields that may be of interest when doing offline transport
integer :: &
id_uhr = -1, &
id_vhr = -1, &
@@ -121,30 +135,32 @@ module MOM_offline_main
id_h_redist = -1, &
id_eta_diff_end = -1
- !> Diagnostic IDs for the regridded/remapped input fields
+ ! Diagnostic IDs for the regridded/remapped input fields
integer :: &
id_uhtr_regrid = -1, &
id_vhtr_regrid = -1, &
id_temp_regrid = -1, &
id_salt_regrid = -1, &
id_h_regrid = -1
+ !!@}
- !> IDs for timings of various offline components
- integer :: &
- id_clock_read_fields = -1, &
- id_clock_offline_diabatic = -1, &
- id_clock_offline_adv = -1, &
- id_clock_redistribute = -1
+ ! IDs for timings of various offline components
+ integer :: id_clock_read_fields = -1 !< A CPU time clock
+ integer :: id_clock_offline_diabatic = -1 !< A CPU time clock
+ integer :: id_clock_offline_adv = -1 !< A CPU time clock
+ integer :: id_clock_redistribute = -1 !< A CPU time clock
- !> Variables that may need to be stored between calls to step_MOM
+ !> Zonal transport that may need to be stored between calls to step_MOM
real, allocatable, dimension(:,:,:) :: uhtr
+ !> Meridional transport that may need to be stored between calls to step_MOM
real, allocatable, dimension(:,:,:) :: vhtr
! Fields at T-point
- real, allocatable, dimension(:,:,:) :: &
- eatr, & !< Amount of fluid entrained from the layer above within
+ real, allocatable, dimension(:,:,:) :: eatr
+ !< Amount of fluid entrained from the layer above within
!! one time step (m for Bouss, kg/m^2 for non-Bouss)
- ebtr !< Amount of fluid entrained from the layer below within
+ real, allocatable, dimension(:,:,:) :: ebtr
+ !< Amount of fluid entrained from the layer below within
!! one time step (m for Bouss, kg/m^2 for non-Bouss)
! Fields at T-points on interfaces
real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity
@@ -154,9 +170,12 @@ module MOM_offline_main
real, allocatable, dimension(:,:) :: netMassOut !< Freshwater fluxes out of the ocean
real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points, in H.
- !> Allocatable arrays to read in entire fields during initialization
- real, allocatable, dimension(:,:,:,:) :: &
- uhtr_all, vhtr_all, hend_all, temp_all, salt_all
+ ! Allocatable arrays to read in entire fields during initialization
+ real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport
+ real, allocatable, dimension(:,:,:,:) :: vhtr_all !< Entire field of mericional transport
+ real, allocatable, dimension(:,:,:,:) :: hend_all !< Entire field of layer thicknesses
+ real, allocatable, dimension(:,:,:,:) :: temp_all !< Entire field of temperatures
+ real, allocatable, dimension(:,:,:,:) :: salt_all !< Entire field of salinities
end type offline_transport_CS
@@ -185,10 +204,13 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock
real, intent(in) :: time_interval !< time interval
type(offline_transport_CS), pointer :: CS !< control structure for offline module
integer, intent(in) :: id_clock_ALE !< Clock for ALE routines
- real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_pre !< layer thicknesses before advection
- real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: uhtr !< Zonal mass transport
- real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), intent(inout) :: vhtr !< Meridional mass transport
- logical, intent( out) :: converged
+ real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
+ intent(inout) :: h_pre !< layer thicknesses before advection in m or kg m-2
+ real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
+ intent(inout) :: uhtr !< Zonal mass transport in m3 or kg
+ real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), &
+ intent(inout) :: vhtr !< Meridional mass transport in m3 or kg
+ logical, intent( out) :: converged !< True if the iterations have converged
! Local pointers
type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing
@@ -210,6 +232,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock
real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end
integer :: niter, iter
real :: Inum_iter
+ character(len=256) :: mesg ! The text of an error message
integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz
integer :: isv, iev, jsv, jev ! The valid range of the indices.
integer :: IsdB, IedB, JsdB, JedB
@@ -218,7 +241,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock
integer :: nstocks
real :: stock_values(MAX_FIELDS_)
- character*20 :: debug_msg
+ character(len=20) :: debug_msg
call cpu_clock_begin(CS%id_clock_offline_adv)
! Grid-related pointer assignments
@@ -285,9 +308,8 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock
endif
tot_residual = remaining_transport_sum(CS, uhtr, vhtr)
if (CS%print_adv_offline) then
- if (is_root_pe()) then
- write(*,'(A,ES24.16)') "Main advection starting transport: ", tot_residual
- endif
+ write(mesg,'(A,ES24.16)') "Main advection starting transport: ", tot_residual
+ call MOM_mesg(mesg)
endif
! This loop does essentially a flux-limited, nonlinear advection scheme until all mass fluxes
@@ -348,13 +370,13 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock
! advection has stalled
tot_residual = remaining_transport_sum(CS, uhtr, vhtr)
if (CS%print_adv_offline) then
- if (is_root_pe()) then
- write(*,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual
- endif
+ write(mesg,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual
+ call MOM_mesg(mesg)
endif
! If all the mass transports have been used u, then quit
if (tot_residual == 0.0) then
- if (is_root_pe()) write(0,*) "Converged after iteration", iter
+ write(mesg,*) "Converged after iteration ", iter
+ call MOM_mesg(mesg)
converged = .true.
exit
endif
@@ -387,12 +409,14 @@ end subroutine offline_advection_ale
!! throughout the water column. 'upwards' attempts to redistribute the transport in the layers above and will
!! eventually work down the entire water column
subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged)
- type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM
-
- real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_pre !< layer thicknesses before advection
- real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: uhtr !< Zonal mass transport
- real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), intent(inout) :: vhtr !< Meridional mass transport
- logical, intent(in ) :: converged
+ type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM
+ real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
+ intent(inout) :: h_pre !< layer thicknesses before advection
+ real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
+ intent(inout) :: uhtr !< Zonal mass transport
+ real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), &
+ intent(inout) :: vhtr !< Meridional mass transport
+ logical, intent(in ) :: converged !< True if the iterations have converged
type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing
! metrics and related information
@@ -409,6 +433,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged)
real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhr !< Zonal mass transport
real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhr !< Meridional mass transport
+ character(len=256) :: mesg ! The text of an error message
integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz, iter
real :: prev_tot_residual, tot_residual, stock_values(MAX_FIELDS_)
integer :: nstocks
@@ -425,7 +450,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged)
if (CS%id_eta_pre_distribute>0) then
eta_work(:,:) = 0.0
do k=1,nz ; do j=js,je ; do i=is,ie
- if (h_pre(i,j,k)>GV%Angstrom) then
+ if (h_pre(i,j,k)>GV%Angstrom_H) then
eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k)
endif
enddo ; enddo ; enddo
@@ -541,9 +566,8 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged)
! Check to see if all transport has been exhausted
tot_residual = remaining_transport_sum(CS, uhtr, vhtr)
if (CS%print_adv_offline) then
- if (is_root_pe()) then
- write(*,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual
- endif
+ write(mesg,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual
+ call MOM_mesg(mesg)
endif
! If the remaining residual is 0, then this return is done
if (tot_residual==0.0 ) then
@@ -559,7 +583,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged)
if (CS%id_eta_post_distribute>0) then
eta_work(:,:) = 0.0
do k=1,nz ; do j=js,je ; do i=is,ie
- if (h_pre(i,j,k)>GV%Angstrom) then
+ if (h_pre(i,j,k)>GV%Angstrom_H) then
eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k)
endif
enddo ; enddo ; enddo
@@ -617,15 +641,18 @@ end function remaining_transport_sum
!! vertical diffuvities and source/sink terms.
subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, ebtr)
- type(forcing), intent(inout) :: fluxes !< pointers to forcing fields
- type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type
- type(time_type), intent(in) :: Time_end !< time interval
- type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM
- real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_pre
- real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: eatr !< Entrainment from layer above
- real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: ebtr !< Entrainment from layer below
- real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: sw, sw_vis, sw_nir !< Save old value of shortwave radiation
+ type(forcing), intent(inout) :: fluxes !< pointers to forcing fields
+ type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type
+ type(time_type), intent(in) :: Time_end !< time interval
+ type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM
+ real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
+ intent(inout) :: h_pre !< layer thicknesses before advection in m or kg m-2
+ real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
+ intent(inout) :: eatr !< Entrainment from layer above in m or kg-2
+ real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
+ intent(inout) :: ebtr !< Entrainment from layer below in m or kg-2
+ real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: sw, sw_vis, sw_nir !< Save old value of shortwave radiation
real :: hval
integer :: i,j,k
integer :: is, ie, js, je, nz
@@ -638,7 +665,7 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e
call cpu_clock_begin(CS%id_clock_offline_diabatic)
- if (is_root_pe()) write (0,*) "Applying tracer source, sinks, and vertical mixing"
+ call MOM_mesg("Applying tracer source, sinks, and vertical mixing")
if (CS%debug) then
call hchksum(h_pre,"h_pre before offline_diabatic_ale",CS%G%HI)
@@ -717,13 +744,15 @@ end subroutine offline_diabatic_ale
!> Apply positive freshwater fluxes (into the ocean) and update netMassOut with only the negative
!! (out of the ocean) fluxes
subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional)
- type(offline_transport_CS), intent(inout) :: CS !< Offline control structure
- type(ocean_grid_type), intent(in) :: G !< Grid structure
- type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
- type(forcing), intent(inout) :: fluxes !< Surface fluxes container
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units
- !> The total time-integrated amount of tracer that leaves with freshwater
- real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: in_flux_optional
+ type(offline_transport_CS), intent(inout) :: CS !< Offline control structure
+ type(ocean_grid_type), intent(in) :: G !< Grid structure
+ type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
+ type(forcing), intent(inout) :: fluxes !< Surface fluxes container
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: h !< Layer thickness in H units
+ real, dimension(SZI_(G),SZJ_(G)), &
+ optional, intent(in) :: in_flux_optional !< The total time-integrated amount
+ !! of tracer that leaves with freshwater
integer :: i, j, m
real, dimension(SZI_(G),SZJ_(G)) :: negative_fw !< store all negative fluxes
@@ -765,13 +794,15 @@ end subroutine offline_fw_fluxes_into_ocean
!> Apply negative freshwater fluxes (out of the ocean)
subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional)
- type(offline_transport_CS), intent(inout) :: CS !< Offline control structure
- type(ocean_grid_type), intent(in) :: G !< Grid structure
- type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
- type(forcing), intent(inout) :: fluxes !< Surface fluxes container
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units
- !> The total time-integrated amount of tracer that leaves with freshwater
- real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional
+ type(offline_transport_CS), intent(inout) :: CS !< Offline control structure
+ type(ocean_grid_type), intent(in) :: G !< Grid structure
+ type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
+ type(forcing), intent(inout) :: fluxes !< Surface fluxes container
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(inout) :: h !< Layer thickness in H units
+ real, dimension(SZI_(G),SZJ_(G)), &
+ optional, intent(in) :: out_flux_optional !< The total time-integrated amount
+ !! of tracer that leaves with freshwater
integer :: m
logical :: update_h !< Flag for whether h should be updated
@@ -838,6 +869,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre,
integer :: niter, iter
real :: Inum_iter, dt_iter
logical :: converged
+ character(len=160) :: mesg ! The text of an error message
integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz
integer :: isv, iev, jsv, jev ! The valid range of the indices.
integer :: IsdB, IedB, JsdB, JedB
@@ -949,9 +981,11 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre,
enddo ; enddo ; enddo
call sum_across_PEs(sum_abs_fluxes)
- print *, "Remaining u-flux, v-flux:", sum_u, sum_v
+ write(mesg,*) "offline_advection_layer: Remaining u-flux, v-flux:", sum_u, sum_v
+ call MOM_mesg(mesg)
if (sum_abs_fluxes==0) then
- print *, 'Converged after iteration', iter
+ write(mesg,*) 'offline_advection_layer: Converged after iteration', iter
+ call MOM_mesg(mesg)
exit
endif
@@ -1023,7 +1057,7 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale)
! Apply masks/factors at T, U, and V points
do k=1,nz ; do j=js,je ; do i=is,ie
if (CS%G%mask2dT(i,j)<1.0) then
- CS%h_end(i,j,k) = CS%GV%Angstrom
+ CS%h_end(i,j,k) = CS%GV%Angstrom_H
endif
enddo ; enddo ; enddo
@@ -1061,9 +1095,9 @@ end subroutine update_offline_fields
!> Initialize additional diagnostics required for offline tracer transport
subroutine register_diags_offline_transport(Time, diag, CS)
- type(offline_transport_CS), pointer :: CS !< Control structure for offline module
- type(time_type), intent(in) :: Time !< current model time
- type(diag_ctrl), intent(in) :: diag
+ type(offline_transport_CS), pointer :: CS !< Control structure for offline module
+ type(time_type), intent(in) :: Time !< current model time
+ type(diag_ctrl), intent(in) :: diag !< Structure that regulates diagnostic output
! U-cell fields
CS%id_uhr = register_diag_field('ocean_model', 'uhr', diag%axesCuL, Time, &
@@ -1152,15 +1186,19 @@ subroutine extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_t
dt_offline, dt_offline_vertical, skip_diffusion)
type(offline_transport_CS), target, intent(in ) :: CS !< Offline control structure
! Returned optional arguments
- real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport
- real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport
- real, dimension(:,:,:), optional, pointer :: eatr
- real, dimension(:,:,:), optional, pointer :: ebtr
- real, dimension(:,:,:), optional, pointer :: h_end
- integer, optional, pointer :: accumulated_time
- integer, optional, intent( out) :: dt_offline
- integer, optional, intent( out) :: dt_offline_vertical
- logical, optional, intent( out) :: skip_diffusion
+ real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport
+ real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport
+ real, dimension(:,:,:), optional, pointer :: eatr !< Amount of fluid entrained from the layer above within
+ !! one time step (m for Bouss, kg/m^2 for non-Bouss)
+ real, dimension(:,:,:), optional, pointer :: ebtr !< Amount of fluid entrained from the layer below within
+ !! one time step (m for Bouss, kg/m^2 for non-Bouss)
+ real, dimension(:,:,:), optional, pointer :: h_end !< Thicknesses at the end of offline timestep in m or kg m-2
+ integer, optional, pointer :: accumulated_time !< Length of time accumulated in the
+ !! current offline interval
+ integer, optional, intent( out) :: dt_offline !< Timestep used for offline tracers
+ integer, optional, intent( out) :: dt_offline_vertical !< Timestep used for calls to tracer
+ !! vertical physics
+ logical, optional, intent( out) :: skip_diffusion !< Skips horizontal diffusion of tracers
! Pointers to 3d members
if (present(uhtr)) uhtr => CS%uhtr
@@ -1183,20 +1221,30 @@ end subroutine extract_offline_main
!! are optional except for the CS itself
subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_CSp, &
tracer_flow_CSp, tracer_Reg, tv, G, GV, x_before_y, debug)
- type(offline_transport_CS), intent(inout) :: CS !< Offline control structure
+ type(offline_transport_CS), intent(inout) :: CS !< Offline control structure
! Inserted optional arguments
- type(ALE_CS), target, optional, intent(in ) :: ALE_CSp
- type(diabatic_CS), target, optional, intent(in ) :: diabatic_CSp
- type(diag_ctrl), target, optional, intent(in ) :: diag
- type(ocean_OBC_type), target, optional, intent(in ) :: OBC
- type(tracer_advect_CS), target, optional, intent(in ) :: tracer_adv_CSp
- type(tracer_flow_control_CS), target, optional, intent(in ) :: tracer_flow_CSp
- type(tracer_registry_type), target, optional, intent(in ) :: tracer_Reg
- type(thermo_var_ptrs), target, optional, intent(in ) :: tv
- type(ocean_grid_type), target, optional, intent(in ) :: G !< ocean grid structure
- type(verticalGrid_type), target, optional, intent(in ) :: GV !< ocean vertical grid structure
- logical, optional, intent(in ) :: x_before_y
- logical, optional, intent(in ) :: debug
+ type(ALE_CS), &
+ target, optional, intent(in ) :: ALE_CSp !< A pointer to the ALE control structure
+ type(diabatic_CS), &
+ target, optional, intent(in ) :: diabatic_CSp !< A pointer to the diabatic control structure
+ type(diag_ctrl), &
+ target, optional, intent(in ) :: diag !< A pointer to the structure that regulates diagnostic output
+ type(ocean_OBC_type), &
+ target, optional, intent(in ) :: OBC !< A pointer to the open boundary condition control structure
+ type(tracer_advect_CS), &
+ target, optional, intent(in ) :: tracer_adv_CSp !< A pointer to the tracer advection control structure
+ type(tracer_flow_control_CS), &
+ target, optional, intent(in ) :: tracer_flow_CSp !< A pointer to the tracer flow control control structure
+ type(tracer_registry_type), &
+ target, optional, intent(in ) :: tracer_Reg !< A pointer to the tracer registry
+ type(thermo_var_ptrs), &
+ target, optional, intent(in ) :: tv !< A structure pointing to various thermodynamic variables
+ type(ocean_grid_type), &
+ target, optional, intent(in ) :: G !< ocean grid structure
+ type(verticalGrid_type), &
+ target, optional, intent(in ) :: GV !< ocean vertical grid structure
+ logical, optional, intent(in ) :: x_before_y !< Indicates which horizontal direction is advected first
+ logical, optional, intent(in ) :: debug !< If true, write verbose debugging messages
if (present(ALE_CSp)) CS%ALE_CSp => ALE_CSp
@@ -1218,9 +1266,9 @@ end subroutine insert_offline_main
! run time parameters from MOM_input
subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV)
- type(param_file_type), intent(in) :: param_file
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
type(offline_transport_CS), pointer :: CS !< Offline control structure
- type(diabatic_CS), intent(in) :: diabatic_CSp
+ type(diabatic_CS), intent(in) :: diabatic_CSp !< The diabatic control structure
type(ocean_grid_type), target, intent(in) :: G !< ocean grid structure
type(verticalGrid_type), target, intent(in) :: GV !< ocean vertical grid structure
@@ -1410,7 +1458,7 @@ subroutine read_all_input(CS)
allocate(CS%temp_all(isd:ied,jsd:jed,nz,1:ntime)) ; CS%temp_all(:,:,:,:) = 0.0
allocate(CS%salt_all(isd:ied,jsd:jed,nz,1:ntime)) ; CS%salt_all(:,:,:,:) = 0.0
- if (is_root_pe()) write (0,*) "Reading in uhtr, vhtr, h_start, h_end, temp, salt"
+ call MOM_mesg("Reading in uhtr, vhtr, h_start, h_end, temp, salt")
do t = 1,ntime
call MOM_read_vector(CS%snap_file, 'uhtr_sum', 'vhtr_sum', CS%uhtr_all(:,:,1:CS%nk_input,t), &
CS%vhtr_all(:,:,1:CS%nk_input,t), CS%G%Domain, timelevel=t)
diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90
index df244cd8a4..7450571500 100644
--- a/src/tracer/MOM_tracer_Z_init.F90
+++ b/src/tracer/MOM_tracer_Z_init.F90
@@ -1,28 +1,8 @@
+!> Used to initialize tracers from a depth- (or z*-) space file.
module MOM_tracer_Z_init
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, September 2009 *
-!* *
-!* This file contains a subroutine to initialize tracers into the *
-!* MOM vertical grid from a depth- (or z*-) space file. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: *
-!* j+1 > o > o > At ^: *
-!* j x ^ x ^ x At >: *
-!* j > o > o > At o: tr *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_to_Z, only : find_overlap, find_limited_slope
use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe
! use MOM_file_parser, only : get_param, log_version, param_file_type
@@ -39,26 +19,24 @@ module MOM_tracer_Z_init
contains
+!> This function initializes a tracer by reading a Z-space file, returning
+!! .true. if this appears to have been successful, and false otherwise.
function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val)
- logical :: tracer_Z_init
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: tr
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- character(len=*), intent(in) :: filename, tr_name
-! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- real, optional, intent(in) :: missing_val
- real, optional, intent(in) :: land_val
-! This function initializes a tracer by reading a Z-space file, returning
-! .true. if this appears to have been successful, and false otherwise.
-! Arguments: tr - The tracer to initialize.
-! (in) h - Layer thickness, in m or kg m-2.
-! (in) filename - The name of the file to read from.
-! (in) tr_name - The name of the tracer in the file.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in,opt) missing_val - The missing value for the tracer.
-! (in,opt) land_val - The value to use to fill in land points.
+ logical :: tracer_Z_init !< A return code indicating if the initialization has been successful
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(out) :: tr !< The tracer to initialize
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ character(len=*), intent(in) :: filename !< The name of the file to read from
+ character(len=*), intent(in) :: tr_name !< The name of the tracer in the file
+! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ real, optional, intent(in) :: missing_val !< The missing value for the tracer
+ real, optional, intent(in) :: land_val !< A value to use to fill in land points
+
+ ! This function initializes a tracer by reading a Z-space file, returning true if this
+ ! appears to have been successful, and false otherwise.
+!
integer, save :: init_calls = 0
! This include declares and sets the variable "version".
#include "version_variable.h"
@@ -69,7 +47,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val)
tr_in ! The z-space array of tracer concentrations that is read in.
real, allocatable, dimension(:) :: &
z_edges, & ! The depths of the cell edges or cell centers (depending on
- ! the value of has_edges) in the input z* data.
+ ! the value of has_edges) in the input z* data, in depth units (Z).
tr_1d, & ! A copy of the input tracer concentrations in a column.
wt, & ! The fractional weight for each layer in the range between
! k_top and k_bot, nondim.
@@ -77,14 +55,14 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val)
z2 ! of a z-cell that contributes to a layer, relative to the cell
! center and normalized by the cell thickness, nondim.
! Note that -1/2 <= z1 <= z2 <= 1/2.
- real :: e(SZK_(G)+1) ! The z-star interface heights in m.
+ real :: e(SZK_(G)+1) ! The z-star interface heights in Z.
real :: landval ! The tracer value to use in land points.
real :: sl_tr ! The normalized slope of the tracer
! within the cell, in tracer units.
real :: htot(SZI_(G)) ! The vertical sum of h, in m or kg m-2.
real :: dilate ! The amount by which the thicknesses are dilated to
! create a z-star coordinate, nondim or in m3 kg-1.
- real :: missing ! The missing value for the tracer.
+ real :: missing ! The missing value for the tracer.
logical :: has_edges, use_missing, zero_surface
character(len=80) :: loc_msg
@@ -103,7 +81,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val)
! Find out the number of input levels and read the depth of the edges,
! also modifying their sign convention to be monotonically decreasing.
- call read_Z_edges(filename, tr_name, z_edges, nz_in, has_edges, use_missing, missing)
+ call read_Z_edges(filename, tr_name, z_edges, nz_in, has_edges, use_missing, &
+ missing, scale=1.0/G%Zd_to_m)
if (nz_in < 1) then
tracer_Z_init = .false.
return
@@ -288,28 +267,24 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val)
end function tracer_Z_init
-
+!> This subroutine reads the vertical coordinate data for a field from a NetCDF file.
+!! It also might read the missing value attribute for that same field.
subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, &
- use_missing, missing)
- character(len=*), intent(in) :: filename, tr_name
- real, allocatable, dimension(:), intent(out) :: z_edges
- integer, intent(out) :: nz_out
- logical, intent(out) :: has_edges
- logical, intent(inout) :: use_missing
- real, intent(inout) :: missing
-! This subroutine reads the vertical coordinate data for a field from a
-! NetCDF file. It also might read the missing value attribute for that
-! same field.
-! Arguments: filename - The file to be read from.
-! (in) tr_name - The name of the tracer to be read.
-! (out) z_edges - The depths of the vertical edges of the tracer array.
-! (out) nz_out - The number of vertical layers in the tracer array.
-! (out) has_edges - If true, the values in z_edges are the edges of the
-! tracer cells, otherwise they are the cell centers.
-! (inout) use_missing - If false on input, see whether the tracer has a
-! missing value, and if so return true.
-! (inout) missing - The missing value, if one has been found.
-
+ use_missing, missing, scale)
+ character(len=*), intent(in) :: filename !< The name of the file to read from.
+ character(len=*), intent(in) :: tr_name !< The name of the tracer in the file.
+ real, dimension(:), allocatable, &
+ intent(out) :: z_edges !< The depths of the vertical edges of the tracer array
+ integer, intent(out) :: nz_out !< The number of vertical layers in the tracer array
+ logical, intent(out) :: has_edges !< If true the values in z_edges are the edges of the
+ !! tracer cells, otherwise they are the cell centers
+ logical, intent(inout) :: use_missing !< If false on input, see whether the tracer has a
+ !! missing value, and if so return true
+ real, intent(inout) :: missing !< The missing value, if one has been found
+ real, intent(in) :: scale !< A scaling factor for z_edges into new units.
+
+ ! This subroutine reads the vertical coordinate data for a field from a
+ ! NetCDF file. It also might read the missing value attribute for that same field.
character(len=32) :: mdl
character(len=120) :: dim_name, edge_name, tr_msg, dim_msg
logical :: monotonic
@@ -415,6 +390,8 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, &
if (.not.monotonic) &
call MOM_error(WARNING,mdl//" "//trim(dim_msg)//" is not monotonic.")
+ if (scale /= 1.0) then ; do k=1,nz_edge ; z_edges(k) = scale*z_edges(k) ; enddo ; endif
+
end subroutine read_Z_edges
diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90
index 4d2bcd70f6..589ad07e19 100644
--- a/src/tracer/MOM_tracer_advect.F90
+++ b/src/tracer/MOM_tracer_advect.F90
@@ -34,12 +34,14 @@ module MOM_tracer_advect
logical :: debug !< If true, write verbose checksums for debugging purposes.
logical :: usePPM !< If true, use PPM instead of PLM
logical :: useHuynh !< If true, use the Huynh scheme for PPM interface values
- type(group_pass_type) :: pass_uhr_vhr_t_hprev ! For group pass
+ type(group_pass_type) :: pass_uhr_vhr_t_hprev !< A structred used for group passes
end type tracer_advect_CS
+!>@{ CPU time clocks
integer :: id_clock_advect
integer :: id_clock_pass
integer :: id_clock_sync
+!!@}
contains
@@ -380,7 +382,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
stencil = 1
if (usePPM .and. .not. useHuynh) stencil = 2
- min_h = 0.1*GV%Angstrom
+ min_h = 0.1*GV%Angstrom_H
h_neglect = GV%H_subroundoff
dt=1.0/Idt
@@ -562,13 +564,13 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index
idir=1 ! idir switches the sign of the flow so that positive is into the reservoir
if (segment%direction == OBC_DIRECTION_W) then
- ishift=1
- idir=-1
+ ishift=1
+ idir=-1
endif
! update the reservoir tracer concentration implicitly
! using Backward-Euler timestep
do m=1,ntr
- if (associated(segment%tr_Reg%Tr(m)%tres)) then
+ if (associated(segment%tr_Reg%Tr(m)%tres)) then
uhh(I)=uhr(I,j,k)
u_L_in=max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.)
u_L_out=min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.)
@@ -576,21 +578,18 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
segment%tr_Reg%Tr(m)%tres(I,j,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + &
dt*(u_L_in*Tr(m)%t(I+ishift,j,k) - &
u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k)))
-! if (j == 10 .and. segment%direction==OBC_DIRECTION_E .and. m==2 .and. k == 1) &
-! print *,'tres=',segment%tr_Reg%Tr(m)%tres(I,j,k),&
-! segment%tr_Reg%Tr(m)%t(I,j,k), fac1
endif
enddo
! Tracer fluxes are set to prescribed values only for inflows from masked areas.
if ((uhr(I,j,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. &
(uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then
- uhh(I) = uhr(I,j,k)
- do m=1,ntr
- if (associated(segment%tr_Reg%Tr(m)%tres)) then
- flux_x(I,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k)
- else; flux_x(I,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif
- enddo
+ uhh(I) = uhr(I,j,k)
+ do m=1,ntr
+ if (associated(segment%tr_Reg%Tr(m)%tres)) then
+ flux_x(I,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k)
+ else; flux_x(I,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif
+ enddo
endif
endif
enddo
@@ -712,7 +711,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
stencil = 1
if (usePPM .and. .not. useHuynh) stencil = 2
- min_h = 0.1*GV%Angstrom
+ min_h = 0.1*GV%Angstrom_H
h_neglect = GV%H_subroundoff
dt=1.0/Idt
!do i=is,ie ; ts2(i) = 0.0 ; enddo
diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90
index 8483bf2b6f..ae9690aca4 100644
--- a/src/tracer/MOM_tracer_flow_control.F90
+++ b/src/tracer/MOM_tracer_flow_control.F90
@@ -1,3 +1,4 @@
+!> Orchestrates the registration and calling of tracer packages
module MOM_tracer_flow_control
! This file is part of MOM6. See LICENSE.md for the license.
@@ -67,19 +68,21 @@ module MOM_tracer_flow_control
public call_tracer_column_fns, call_tracer_surface_state, call_tracer_stocks
public call_tracer_flux_init, get_chl_from_model, tracer_flow_control_end
+!> The control structure for orchestrating the calling of tracer packages
type, public :: tracer_flow_control_CS ; private
- logical :: use_USER_tracer_example = .false.
- logical :: use_DOME_tracer = .false.
- logical :: use_ISOMIP_tracer = .false.
- logical :: use_ideal_age = .false.
- logical :: use_regional_dyes = .false.
- logical :: use_oil = .false.
- logical :: use_advection_test_tracer = .false.
- logical :: use_OCMIP2_CFC = .false.
- logical :: use_MOM_generic_tracer = .false.
- logical :: use_pseudo_salt_tracer = .false.
- logical :: use_boundary_impulse_tracer = .false.
- logical :: use_dyed_obc_tracer = .false.
+ logical :: use_USER_tracer_example = .false. !< If true, use the USER_tracer_example package
+ logical :: use_DOME_tracer = .false. !< If true, use the DOME_tracer package
+ logical :: use_ISOMIP_tracer = .false. !< If true, use the ISOMPE_tracer package
+ logical :: use_ideal_age = .false. !< If true, use the ideal age tracer package
+ logical :: use_regional_dyes = .false. !< If true, use the regional dyes tracer package
+ logical :: use_oil = .false. !< If true, use the oil tracer package
+ logical :: use_advection_test_tracer = .false. !< If true, use the advection_test_tracer package
+ logical :: use_OCMIP2_CFC = .false. !< If true, use the OCMIP2_CFC tracer package
+ logical :: use_MOM_generic_tracer = .false. !< If true, use the MOM_generic_tracer packages
+ logical :: use_pseudo_salt_tracer = .false. !< If true, use the psuedo_salt tracer package
+ logical :: use_boundary_impulse_tracer = .false. !< If true, use the boundary impulse tracer package
+ logical :: use_dyed_obc_tracer = .false. !< If true, use the dyed OBC tracer package
+ !>@{ Pointers to the control strucures for the tracer packages
type(USER_tracer_example_CS), pointer :: USER_tracer_example_CSp => NULL()
type(DOME_tracer_CS), pointer :: DOME_tracer_CSp => NULL()
type(ISOMIP_tracer_CS), pointer :: ISOMIP_tracer_CSp => NULL()
@@ -94,6 +97,7 @@ module MOM_tracer_flow_control
type(pseudo_salt_tracer_CS), pointer :: pseudo_salt_tracer_CSp => NULL()
type(boundary_impulse_tracer_CS), pointer :: boundary_impulse_tracer_CSp => NULL()
type(dyed_obc_tracer_CS), pointer :: dyed_obc_tracer_CSp => NULL()
+ !!@}
end type tracer_flow_control_CS
contains
@@ -341,21 +345,14 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB
end subroutine tracer_flow_control_init
-! #@# This subroutine needs a doxygen description
+!> This subroutine extracts the chlorophyll concentrations from the model state, if possible
subroutine get_chl_from_model(Chl_array, G, CS)
- real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(out) :: Chl_array !< The array into which the
- !! model's Chlorophyll-A
- !! concentrations in mg m-3 are
- !! to be read.
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(tracer_flow_control_CS), pointer :: CS !< The control structure returned
- !! by a previous call to
- !! call_tracer_register.
-! Arguments: Chl_array - The array into which the model's Chlorophyll-A
-! concentrations in mg m-3 are to be read.
-! (in) G - The ocean's grid structure.
-! (in) CS - The control structure returned by a previous call to
-! call_tracer_register.
+ real, dimension(NIMEM_,NJMEM_,NKMEM_), &
+ intent(out) :: Chl_array !< The array in which to store the model's
+ !! Chlorophyll-A concentrations in mg m-3.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a
+ !! previous call to call_tracer_register.
#ifdef _USE_GENERIC_TRACER
if (CS%use_MOM_generic_tracer) then
diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90
index bdadb4e4e0..597b0fc822 100644
--- a/src/tracer/MOM_tracer_hor_diff.F90
+++ b/src/tracer/MOM_tracer_hor_diff.F90
@@ -32,53 +32,61 @@ module MOM_tracer_hor_diff
public tracer_hordiff, tracer_hor_diff_init, tracer_hor_diff_end
+!> The ocntrol structure for along-layer and epineutral tracer diffusion
type, public :: tracer_hor_diff_CS ; private
- real :: dt ! The baroclinic dynamics time step, in s.
- real :: KhTr ! The along-isopycnal tracer diffusivity in m2/s.
- real :: KhTr_Slope_Cff ! The non-dimensional coefficient in KhTr formula
- real :: KhTr_min ! Minimum along-isopycnal tracer diffusivity in m2/s.
- real :: KhTr_max ! Maximum along-isopycnal tracer diffusivity in m2/s.
- real :: KhTr_passivity_coeff ! Passivity coefficient that scales Rd/dx (default = 0)
- ! where passivity is the ratio between along-isopycnal
- ! tracer mixing and thickness mixing
- real :: KhTr_passivity_min ! Passivity minimum (default = 1/2)
- real :: ML_KhTR_scale ! With Diffuse_ML_interior, the ratio of the
- ! truly horizontal diffusivity in the mixed
- ! layer to the epipycnal diffusivity. Nondim.
- real :: max_diff_CFL ! If positive, locally limit the along-isopycnal
- ! tracer diffusivity to keep the diffusive CFL
- ! locally at or below this value. Nondim.
- logical :: Diffuse_ML_interior ! If true, diffuse along isopycnals between
- ! the mixed layer and the interior.
- logical :: check_diffusive_CFL ! If true, automatically iterate the diffusion
- ! to ensure that the diffusive equivalent of
- ! the CFL limit is not violated.
- logical :: use_neutral_diffusion ! If true, use the neutral_diffusion module from within
- ! tracer_hor_diff.
- type(neutral_diffusion_CS), pointer :: neutral_diffusion_CSp => NULL() ! Control structure for neutral diffusion.
- type(diag_ctrl), pointer :: diag ! structure to regulate timing of diagnostic output.
- logical :: debug ! If true, write verbose checksums for debugging purposes.
- logical :: show_call_tree ! Display the call tree while running. Set by VERBOSITY level.
- logical :: first_call = .true.
+ real :: dt !< The baroclinic dynamics time step, in s.
+ real :: KhTr !< The along-isopycnal tracer diffusivity in m2/s.
+ real :: KhTr_Slope_Cff !< The non-dimensional coefficient in KhTr formula
+ real :: KhTr_min !< Minimum along-isopycnal tracer diffusivity in m2/s.
+ real :: KhTr_max !< Maximum along-isopycnal tracer diffusivity in m2/s.
+ real :: KhTr_passivity_coeff !< Passivity coefficient that scales Rd/dx (default = 0)
+ !! where passivity is the ratio between along-isopycnal
+ !! tracer mixing and thickness mixing
+ real :: KhTr_passivity_min !< Passivity minimum (default = 1/2)
+ real :: ML_KhTR_scale !< With Diffuse_ML_interior, the ratio of the
+ !! truly horizontal diffusivity in the mixed
+ !! layer to the epipycnal diffusivity. Nondim.
+ real :: max_diff_CFL !< If positive, locally limit the along-isopycnal
+ !! tracer diffusivity to keep the diffusive CFL
+ !! locally at or below this value. Nondim.
+ logical :: Diffuse_ML_interior !< If true, diffuse along isopycnals between
+ !! the mixed layer and the interior.
+ logical :: check_diffusive_CFL !< If true, automatically iterate the diffusion
+ !! to ensure that the diffusive equivalent of
+ !! the CFL limit is not violated.
+ logical :: use_neutral_diffusion !< If true, use the neutral_diffusion module from within
+ !! tracer_hor_diff.
+ type(neutral_diffusion_CS), pointer :: neutral_diffusion_CSp => NULL() !< Control structure for neutral diffusion.
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ logical :: debug !< If true, write verbose checksums for debugging purposes.
+ logical :: show_call_tree !< Display the call tree while running. Set by VERBOSITY level.
+ logical :: first_call = .true. !< This is true until after the first call
+ !>@{ Diagnostic IDs
integer :: id_KhTr_u = -1
integer :: id_KhTr_v = -1
integer :: id_KhTr_h = -1
integer :: id_CFL = -1
integer :: id_khdt_x = -1
integer :: id_khdt_y = -1
+ !!@}
- type(group_pass_type) :: pass_t !For group halo pass, used in both
- !tracer_hordiff and tracer_epipycnal_ML_diff
+ type(group_pass_type) :: pass_t !< For group halo pass, used in both
+ !! tracer_hordiff and tracer_epipycnal_ML_diff
end type tracer_hor_diff_CS
+!> A type that can be used to create arrays of pointers to 2D arrays
type p2d
- real, dimension(:,:), pointer :: p => NULL()
+ real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array of reals
end type p2d
+!> A type that can be used to create arrays of pointers to 2D integer arrays
type p2di
- integer, dimension(:,:), pointer :: p => NULL()
+ integer, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array of integers
end type p2di
+!>@{ CPU time clocks
integer :: id_clock_diffuse, id_clock_epimix, id_clock_pass, id_clock_sync
+!!@}
contains
@@ -688,7 +696,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, &
enddo ; enddo
if (PEmax_kRho > nz) PEmax_kRho = nz ! PEmax_kRho could have been nz+1.
- h_exclude = 10.0*(GV%Angstrom + GV%H_subroundoff)
+ h_exclude = 10.0*(GV%Angstrom_H + GV%H_subroundoff)
!$OMP parallel default(none) shared(is,ie,js,je,nkmb,G,GV,h,h_exclude,num_srt,k0_srt, &
!$OMP rho_srt,h_srt,PEmax_kRho,k_end_srt,rho_coord,max_srt) &
!$OMP private(ns,tmp,itmp)
diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90
index 06ac26d120..6491006c7f 100644
--- a/src/tracer/MOM_tracer_registry.F90
+++ b/src/tracer/MOM_tracer_registry.F90
@@ -93,7 +93,7 @@ module MOM_tracer_registry
character(len=48) :: cmor_tendprefix = "" !< The CMOR variable prefix for tendencies of this
!! tracer, required because CMOR does not follow any
!! discernable pattern for these names.
- integer :: ind_tr_squared = -1
+ integer :: ind_tr_squared = -1 !< The tracer registry index for the square of this tracer
!### THESE CAPABILITIES HAVE NOT YET BEEN IMPLEMENTED.
logical :: advect_tr = .true. !< If true, this tracer should be advected
@@ -101,6 +101,7 @@ module MOM_tracer_registry
logical :: remap_tr = .true. !< If true, this tracer should be vertically remapped
integer :: diag_form = 1 !< An integer indicating which template is to be used to label diagnostics.
+ !>@{ Diagnostic IDs
integer :: id_tr = -1
integer :: id_adx = -1, id_ady = -1, id_dfx = -1, id_dfy = -1
integer :: id_adx_2d = -1, id_ady_2d = -1, id_dfx_2d = -1, id_dfy_2d = -1
@@ -109,6 +110,7 @@ module MOM_tracer_registry
integer :: id_remap_conc = -1, id_remap_cont = -1, id_remap_cont_2d = -1
integer :: id_tendency = -1, id_trxh_tendency = -1, id_trxh_tendency_2d = -1
integer :: id_tr_vardec = -1
+ !!@}
end type tracer_type
!> Type to carry basic tracer information
@@ -792,7 +794,7 @@ end subroutine tracer_registry_init
!> This routine closes the tracer registry module.
subroutine tracer_registry_end(Reg)
- type(tracer_registry_type), pointer :: Reg
+ type(tracer_registry_type), pointer :: Reg !< The tracer registry that will be deallocated
if (associated(Reg)) deallocate(Reg)
end subroutine tracer_registry_end
diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90
index 58c8955234..aeb1b3aae9 100644
--- a/src/tracer/advection_test_tracer.F90
+++ b/src/tracer/advection_test_tracer.F90
@@ -1,41 +1,8 @@
+!> This tracer package is used to test advection schemes
module advection_test_tracer
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, 2002 *
-!* *
-!* This file contains an example of the code that is needed to set *
-!* up and use a set (in this case eleven) of dynamically passive *
-!* tracers. These tracers dye the inflowing water or water initially *
-!* within a range of latitudes or water initially in a range of *
-!* depths. *
-!* *
-!* A single subroutine is called from within each file to register *
-!* each of the tracers for reinitialization and advection and to *
-!* register the subroutine that initializes the tracers and set up *
-!* their output and the subroutine that does any tracer physics or *
-!* chemistry along with diapycnal mixing (included here because some *
-!* tracers may float or swim vertically or dye diapycnal processes). *
-!* *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, tr *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_mediator, only : diag_ctrl
use MOM_diag_to_Z, only : diag_to_Z_CS
use MOM_error_handler, only : MOM_error, FATAL, WARNING
@@ -47,7 +14,7 @@ module advection_test_tracer
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : query_initialized, MOM_restart_CS
use MOM_sponge, only : set_up_sponge_field, sponge_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_variables, only : surface
@@ -64,39 +31,39 @@ module advection_test_tracer
public advection_test_tracer_surface_state, advection_test_tracer_end
public advection_test_tracer_column_physics, advection_test_stock
-! ntr is the number of tracers in this module.
-integer, parameter :: NTR = 11
+integer, parameter :: NTR = 11 !< The number of tracers in this module.
+!> The control structure for the advect_test_tracer module
type, public :: advection_test_tracer_CS ; private
- integer :: ntr = NTR ! Number of tracers in this module
- logical :: coupled_tracers = .false. ! These tracers are not offered to the
- ! coupler.
- character(len=200) :: tracer_IC_file ! The full path to the IC file, or " "
- ! to initialize internally.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
- real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this
- ! subroutine, in g m-3?
- real :: land_val(NTR) = -1.0 ! The value of tr used where land is masked out.
- logical :: use_sponge ! If true, sponges may be applied somewhere in the domain.
- logical :: tracers_may_reinit
-
- real :: x_origin, x_width ! Parameters describing the test functions
- real :: y_origin, y_width ! Parameters describing the test functions
-
- integer, dimension(NTR) :: ind_tr ! Indices returned by aof_set_coupler_flux
- ! if it is used and the surface tracer concentrations are to be
- ! provided to the coupler.
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- type(MOM_restart_CS), pointer :: restart_CSp => NULL()
-
- type(vardesc) :: tr_desc(NTR)
+ integer :: ntr = NTR !< Number of tracers in this module
+ logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
+ character(len=200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3?
+ real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out.
+ logical :: use_sponge !< If true, sponges may be applied somewhere in the domain.
+ logical :: tracers_may_reinit !< If true, the tracers may be set up via the initialization code if
+ !! they are not found in the restart files. Otherwise it is a fatal error
+ !! if the tracers are not found in the restart files of a restarted run.
+ real :: x_origin !< Parameters describing the test functions
+ real :: x_width !< Parameters describing the test functions
+ real :: y_origin !< Parameters describing the test functions
+ real :: y_width !< Parameters describing the test functions
+
+ integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and
+ !! the surface tracer concentrations are to be provided to the coupler.
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure.
+
+ type(vardesc) :: tr_desc(NTR) !< Descriptions and metadata for the tracers
end type advection_test_tracer_CS
contains
+!> Register tracer fields and subroutines to be used with MOM.
function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -107,17 +74,8 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_
!! structure for the tracer advection and
!! diffusion module
type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure
-! This subroutine is used to register tracer fields and subroutines
-! to be used with MOM.
-! Arguments: HI - A horizontal index type structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-! (in/out) tr_Reg - A pointer that is set to point to the control structure
-! for the tracer advection and diffusion module.
-! (in) restart_CS - A pointer to the restart control structure.
+
+ ! Local variables
character(len=80) :: name, longname
! This include declares and sets the variable "version".
#include "version_variable.h"
@@ -204,6 +162,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_
register_advection_test_tracer = .true.
end function register_advection_test_tracer
+!> Initializes the NTR tracer fields in tr(:,:,:,:) and it sets up the tracer output.
subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS, &
sponge_CSp, diag_to_Z_CSp)
logical, intent(in) :: restart !< .true. if the fields have already
@@ -223,24 +182,8 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS
type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges.
type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure
!! for diagnostics in depth space.
-! This subroutine initializes the NTR tracer fields in tr(:,:,:,:)
-! and it sets up the tracer output.
-
-! Arguments: restart - .true. if the fields have already been read from
-! a restart file.
-! (in) day - Time of the start of the run.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) h - Layer thickness, in m or kg m-2.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in) OBC - This open boundary condition type specifies whether, where,
-! and what open boundary conditions are used.
-! (in/out) CS - The control structure returned by a previous call to
-! register_advection_test_tracer.
-! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if
-! they are in use. Otherwise this may be unassociated.
-! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics
-! in depth space.
+
+ ! Local variables
real, allocatable :: temp(:,:,:)
real, pointer, dimension(:,:,:) :: &
OBC_tr1_u => NULL(), & ! These arrays should be allocated and set to
@@ -315,6 +258,8 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS
end subroutine initialize_advection_test_tracer
+!> Applies diapycnal diffusion and any other column tracer physics or chemistry to the tracers
+!! from this package. This is a simple example of a set of advected passive tracers.
subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, &
evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
@@ -344,24 +289,9 @@ subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes,
! tracer physics or chemistry to the tracers from this file.
! This is a simple example of a set of advected passive tracers.
-! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2.
-! (in) h_new - Layer thickness after entrainment, in m or kg m-2.
-! (in) ea - an array to which the amount of fluid entrained
-! from the layer above during this call will be
-! added, in m or kg m-2.
-! (in) eb - an array to which the amount of fluid entrained
-! from the layer below during this call will be
-! added, in m or kg m-2.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) dt - The amount of time covered by this call, in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_advection_test_tracer.
-!
! The arguments to this subroutine are redundant in that
! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1]
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
real :: b1(SZI_(G)) ! b1 and c1 are variables used by the
real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver.
@@ -420,34 +350,20 @@ subroutine advection_test_tracer_surface_state(state, h, G, CS)
end subroutine advection_test_tracer_surface_state
+!> Calculate the mass-weighted integral of all tracer stocks, returning the number of stocks it has calculated.
+!! If the stock_index is present, only the stock corresponding to that coded index is returned.
function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each
!! tracer, in kg times concentration units.
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_advection_test_tracer.
character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated.
character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated.
- integer, optional, intent(in) :: stock_index !< the coded index of a specific stock
- !! being sought.
- integer :: advection_test_stock
-! This function calculates the mass-weighted integral of all tracer stocks,
-! returning the number of stocks it has calculated. If the stock_index
-! is present, only the stock corresponding to that coded index is returned.
-
-! Arguments: h - Layer thickness, in m or kg m-2.
-! (out) stocks - the mass-weighted integrated amount of each tracer,
-! in kg times concentration units.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_ideal_age_tracer.
-! (out) names - the names of the stocks calculated.
-! (out) units - the units of the stocks calculated.
-! (in,opt) stock_index - the coded index of a specific stock being sought.
-! Return value: the number of stocks calculated here.
+ integer, optional, intent(in) :: stock_index !< the coded index of a specific stock being sought.
+ integer :: advection_test_stock !< the number of stocks calculated here.
integer :: i, j, k, is, ie, js, je, nz, m
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -476,6 +392,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index)
end function advection_test_stock
+!> Deallocate memory associated with this module
subroutine advection_test_tracer_end(CS)
type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_advection_test_tracer.
diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90
index 6cfa91049f..9b785fe41d 100644
--- a/src/tracer/boundary_impulse_tracer.F90
+++ b/src/tracer/boundary_impulse_tracer.F90
@@ -14,7 +14,7 @@ module boundary_impulse_tracer
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS
use MOM_sponge, only : set_up_sponge_field, sponge_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_Z_init, only : tracer_Z_init
@@ -33,34 +33,31 @@ module boundary_impulse_tracer
public boundary_impulse_tracer_column_physics, boundary_impulse_tracer_surface_state
public boundary_impulse_stock, boundary_impulse_tracer_end
-! NTR_MAX is the maximum number of tracers in this module.
+!> NTR_MAX is the maximum number of tracers in this module.
integer, parameter :: NTR_MAX = 1
+!> The control structure for the boundary impulse tracer package
type, public :: boundary_impulse_tracer_CS ; private
- integer :: ntr=NTR_MAX ! The number of tracers that are actually used.
- logical :: coupled_tracers = .false. ! These tracers are not offered to the
- ! coupler.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
- real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this
- ! subroutine, in g m-3?
- logical :: tracers_may_reinit ! If true, boundary_impulse can be initialized if
- ! not found in restart file
- integer, dimension(NTR_MAX) :: &
- ind_tr ! Indices returned by aof_set_coupler_flux if it is used and the
- ! surface tracer concentrations are to be provided to the coupler.
-
- integer :: nkml ! Number of layers in mixed layer
- real, dimension(NTR_MAX) :: land_val = -1.0
- real :: kw_eff ! An effective piston velocity used to flux tracer out at the surface
- real :: remaining_source_time ! How much longer (same units as the timestep) to
- ! inject the tracer at the surface
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- type(MOM_restart_CS), pointer :: restart_CSp => NULL()
-
- type(vardesc) :: tr_desc(NTR_MAX)
+ integer :: ntr=NTR_MAX !< The number of tracers that are actually used.
+ logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3?
+ logical :: tracers_may_reinit !< If true, boundary_impulse can be initialized if not found in restart file
+ integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the
+ !! surface tracer concentrations are to be provided to the coupler.
+
+ integer :: nkml !< Number of layers in mixed layer
+ real, dimension(NTR_MAX) :: land_val = -1.0 !< A value to use to fill in tracers over land
+ real :: kw_eff !< An effective piston velocity used to flux tracer out at the surface
+ real :: remaining_source_time !< How much longer (same units as the timestep) to
+ !! inject the tracer at the surface
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the retart control structure
+
+ type(vardesc) :: tr_desc(NTR_MAX) !< Descriptions and metadata for the tracers
end type boundary_impulse_tracer_CS
contains
@@ -76,26 +73,16 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar
!! structure for the tracer advection and
!! diffusion module
type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure
-! This subroutine is used to register tracer fields and subroutines
-! to be used with MOM.
-! Arguments: HI - A horizontal index type structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-! (in/out) tr_Reg - A pointer that is set to point to the control structure
-! for the tracer advection and diffusion module.
-! (in) restart_CS - A pointer to the restart control structure.
-
-! This include declares and sets the variable "version".
-#include "version_variable.h"
+
+ ! Local variables
character(len=40) :: mdl = "boundary_impulse_tracer" ! This module's name.
character(len=200) :: inputdir ! The directory where the input files are.
character(len=48) :: var_name ! The variable's name.
character(len=3) :: name_tag ! String for creating identifying boundary_impulse
character(len=48) :: flux_units ! The units for tracer fluxes, usually
! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1.
+ ! This include declares and sets the variable "version".
+#include "version_variable.h"
real, pointer :: tr_ptr(:,:,:) => NULL()
real, pointer :: rem_time_ptr => NULL()
logical :: register_boundary_impulse_tracer
@@ -182,24 +169,7 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC,
!! for diagnostics in depth space.
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables
-! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:)
-! and it sets up the tracer output.
-
-! Arguments: restart - .true. if the fields have already been read from
-! a restart file.
-! (in) day - Time of the start of the run.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) h - Layer thickness, in m or kg m-2.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in) OBC - This open boundary condition type specifies whether, where,
-! and what open boundary conditions are used.
-! (in/out) CS - The control structure returned by a previous call to
-! register_boundary_impulse_tracer.
-! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if
-! they are in use. Otherwise this may be unassociated.
-! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics
-! in depth space.
+ ! Local variables
character(len=16) :: name ! A variable's name in a NetCDF file.
character(len=72) :: longname ! The long name of that variable.
character(len=48) :: units ! The dimensions of the variable.
@@ -235,7 +205,7 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC,
end subroutine initialize_boundary_impulse_tracer
-! Apply source or sink at boundary and do vertical diffusion
+!> Apply source or sink at boundary and do vertical diffusion
subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, &
tv, debug, evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
@@ -269,31 +239,10 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes,
! tracer physics or chemistry to the tracers from this file.
! This is a simple example of a set of advected passive tracers.
-! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2.
-! (in) h_new - Layer thickness after entrainment, in m or kg m-2.
-! (in) ea - an array to which the amount of fluid entrained
-! from the layer above during this call will be
-! added, in m or kg m-2.
-! (in) eb - an array to which the amount of fluid entrained
-! from the layer below during this call will be
-! added, in m or kg m-2.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) dt - The amount of time covered by this call, in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_boundary_impulse_tracer.
-! (in) tv - Thermodynamic structure with T and S
-! (in) evap_CFL_limit - Limits how much water can be fluxed out of the top layer
-! Stored previously in diabatic CS.
-! (in) minimum_forcing_depth - The smallest depth over which fluxes can be applied
-! Stored previously in diabatic CS.
-! (in) debug - Calculates checksums
-!
! The arguments to this subroutine are redundant in that
! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1]
+ ! Local variables
real :: Isecs_per_year = 1.0 / (365.0*86400.0)
real :: year, h_total, scale, htot, Ih_limit
integer :: secs, days
@@ -353,18 +302,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index)
! returning the number of stocks it has calculated. If the stock_index
! is present, only the stock corresponding to that coded index is returned.
-! Arguments: h - Layer thickness, in m or kg m-2.
-! (out) stocks - the mass-weighted integrated amount of each tracer,
-! in kg times concentration units.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_boundary_impulse_tracer.
-! (out) names - the names of the stocks calculated.
-! (out) units - the units of the stocks calculated.
-! (in,opt) stock_index - the coded index of a specific stock being sought.
-! Return value: the number of stocks calculated here.
-
+ ! Local variables
integer :: i, j, k, is, ie, js, je, nz, m
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -427,7 +365,7 @@ subroutine boundary_impulse_tracer_surface_state(state, h, G, CS)
end subroutine boundary_impulse_tracer_surface_state
-! Performs finalization of boundary impulse tracer
+!> Performs finalization of boundary impulse tracer
subroutine boundary_impulse_tracer_end(CS)
type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_boundary_impulse_tracer.
@@ -440,7 +378,8 @@ subroutine boundary_impulse_tracer_end(CS)
end subroutine boundary_impulse_tracer_end
!> \namespace boundary_impulse_tracer
-!! \section Boundary Impulse Response Tracer and Transit Time Distributions
+!!
+!! \section section_BIT_desc Boundary Impulse Response Tracer and Transit Time Distributions
!! Transit time distributions (TTD) are the Green's function solution of the passive tracer equation between
!! the oceanic surface and interior. The name derives from the idea that the 'age' (e.g. time since last
!! contact with the atmosphere) of a water parcel is best characterized as a distribution of ages
@@ -457,18 +396,18 @@ end subroutine boundary_impulse_tracer_end
!! In the References section, both the theoretical discussion of TTDs and BIRs are listed along with
!! modeling studies which have this used framework in scientific investigations
!!
-!! \section Run-time parameters
+!! \section section_BIT_params Run-time parameters
!! -DO_BOUNDARY_IMPULSE_TRACER: Enables the boundary impulse tracer model
!! -IMPULSE_SOURCE_TIME: Length of time that the surface layer acts as a source of the BIR tracer
!!
-!! \section References
+!! \section section_BIT_refs References
!! \subsection TTD and BIR Theory
!! -Holzer, M., and T.M. Hall, 2000: Transit-time and tracer-age distributions in geophysical flows.
!! J. Atmos. Sci., 57, 3539-3558, doi:10.1175/1520-0469(2000)057<3539:TTATAD>2.0.CO;2.
!! -T.W.N. Haine, H. Zhang, D.W. Waugh, M. Holzer, On transit-time distributions in unsteady circulation
!! models, Ocean Modelling, Volume 21, Issues 1–2, 2008, Pages 35-45, ISSN 1463-5003
!! http://dx.doi.org/10.1016/j.ocemod.2007.11.004.
-!! \subsection BIR Modelling applications
+!! \subsection section_BIT_apps Modelling applications
!! -Peacock, S., and M. Maltrud (2006), Transit-time distributions in a global ocean model,
!! J. Phys. Oceanogr., 36(3), 474–495, doi:10.1175/JPO2860.1.
!! -Maltrud, M., Bryan, F. & Peacock, Boundary impulse response functions in a century-long eddying global
diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90
index 871b7cdc58..c9a8706e3c 100644
--- a/src/tracer/dye_example.F90
+++ b/src/tracer/dye_example.F90
@@ -1,3 +1,4 @@
+!> A tracer package for using dyes to diagnose regional flows.
module regional_dyes
! This file is part of MOM6. See LICENSE.md for the license.
@@ -13,7 +14,7 @@ module regional_dyes
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : query_initialized, MOM_restart_CS
use MOM_sponge, only : set_up_sponge_field, sponge_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_Z_init, only : tracer_Z_init
@@ -32,30 +33,28 @@ module regional_dyes
public dye_stock, regional_dyes_end
+!> The control structure for the regional dyes tracer package
type, public :: dye_tracer_CS ; private
- integer :: ntr ! The number of tracers that are actually used.
- logical :: coupled_tracers = .false. ! These tracers are not offered to the
- ! coupler.
- real, allocatable, dimension(:) :: dye_source_minlon, & ! Minimum longitude of region dye will be injected.
- dye_source_maxlon, & ! Maximum longitude of region dye will be injected.
- dye_source_minlat, & ! Minimum latitude of region dye will be injected.
- dye_source_maxlat, & ! Maximum latitude of region dye will be injected.
- dye_source_mindepth, & ! Minimum depth of region dye will be injected (m).
- dye_source_maxdepth ! Maximum depth of region dye will be injected (m).
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
- real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this
- ! subroutine, in g m-3?
-
- integer, allocatable, dimension(:) :: &
- ind_tr ! Indices returned by aof_set_coupler_flux if it is used and the
- ! surface tracer concentrations are to be provided to the coupler.
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- type(MOM_restart_CS), pointer :: restart_CSp => NULL()
-
- type(vardesc), allocatable :: tr_desc(:)
- logical :: tracers_may_reinit = .false. ! hard-coding here (mjh)
+ integer :: ntr !< The number of tracers that are actually used.
+ logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
+ real, allocatable, dimension(:) :: dye_source_minlon !< Minimum longitude of region dye will be injected.
+ real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be injected.
+ real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be injected.
+ real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be injected.
+ real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected, in Z.
+ real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected, in Z.
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3?
+
+ integer, allocatable, dimension(:) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the
+ !! surface tracer concentrations are to be provided to the coupler.
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure
+
+ type(vardesc), allocatable :: tr_desc(:) !< Descriptions and metadata for the tracers
+ logical :: tracers_may_reinit = .false. !< If true the tracers may be initialized if not found in a restart file
end type dye_tracer_CS
contains
@@ -136,18 +135,17 @@ function register_dye_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
CS%dye_source_mindepth(:) = -1.e30
call get_param(param_file, mdl, "DYE_SOURCE_MINDEPTH", CS%dye_source_mindepth, &
"This is the minumum depth at which we inject dyes.", &
- fail_if_missing=.true.)
- if (minval(CS%dye_source_mindepth(:)) < -1.e29) &
+ units="m", scale=GV%m_to_Z, fail_if_missing=.true.)
+ if (minval(CS%dye_source_mindepth(:)) < -1.e29*GV%m_to_Z) &
call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINDEPTH")
CS%dye_source_maxdepth(:) = -1.e30
call get_param(param_file, mdl, "DYE_SOURCE_MAXDEPTH", CS%dye_source_maxdepth, &
"This is the maximum depth at which we inject dyes.", &
- fail_if_missing=.true.)
- if (minval(CS%dye_source_maxdepth(:)) < -1.e29) &
+ units="m", scale=GV%m_to_Z, fail_if_missing=.true.)
+ if (minval(CS%dye_source_maxdepth(:)) < -1.e29*GV%m_to_Z) &
call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXDEPTH ")
-
allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0
do m = 1, CS%ntr
@@ -225,12 +223,12 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C
G%mask2dT(i,j) > 0.0 ) then
z_bot = -G%bathyT(i,j)
do k = GV%ke, 1, -1
- z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_m
+ z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_Z
if ( z_center > -CS%dye_source_maxdepth(m) .and. &
z_center < -CS%dye_source_mindepth(m) ) then
CS%tr(i,j,k,m) = 1.0
endif
- z_bot = z_bot + h(i,j,k)*GV%H_to_m
+ z_bot = z_bot + h(i,j,k)*GV%H_to_Z
enddo
endif
enddo ; enddo
@@ -308,12 +306,12 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS
G%mask2dT(i,j) > 0.0 ) then
z_bot = -G%bathyT(i,j)
do k=nz,1,-1
- z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_m
+ z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_Z
if ( z_center > -CS%dye_source_maxdepth(m) .and. &
z_center < -CS%dye_source_mindepth(m) ) then
CS%tr(i,j,k,m) = 1.0
endif
- z_bot = z_bot + h_new(i,j,k)*GV%H_to_m
+ z_bot = z_bot + h_new(i,j,k)*GV%H_to_Z
enddo
endif
enddo ; enddo
@@ -413,39 +411,13 @@ subroutine regional_dyes_end(CS)
endif
end subroutine regional_dyes_end
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, 2002 *
-!* *
-!* This file contains an example of the code that is needed to set *
-!* up and use a set (in this case two) of dynamically passive tracers *
-!* for diagnostic purposes. The tracers here are dye tracers which *
-!* are set to 1 within the geographical region specified. The depth *
-!* which a tracer is set is determined by calculating the depth from *
-!* the seafloor upwards through the column. *
-!* *
-!* A single subroutine is called from within each file to register *
-!* each of the tracers for reinitialization and advection and to *
-!* register the subroutine that initializes the tracers and set up *
-!* their output and the subroutine that does any tracer physics or *
-!* chemistry along with diapycnal mixing (included here because some *
-!* tracers may float or swim vertically or dye diapycnal processes). *
-!* *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, tr *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
+!> \namespace regional_dyes
+!!
+!! This file contains an example of the code that is needed to set
+!! up and use a set (in this case two) of dynamically passive tracers
+!! for diagnostic purposes. The tracers here are dye tracers which
+!! are set to 1 within the geographical region specified. The depth
+!! which a tracer is set is determined by calculating the depth from
+!! the seafloor upwards through the column.
end module regional_dyes
diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90
index 10d3d5108b..af69a39c52 100644
--- a/src/tracer/dyed_obc_tracer.F90
+++ b/src/tracer/dyed_obc_tracer.F90
@@ -1,3 +1,4 @@
+!> This tracer package dyes flow through open boundaries
module dyed_obc_tracer
! This file is part of MOM6. See LICENSE.md for the license.
@@ -12,7 +13,7 @@ module dyed_obc_tracer
use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : MOM_restart_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_variables, only : surface
@@ -28,32 +29,28 @@ module dyed_obc_tracer
public register_dyed_obc_tracer, initialize_dyed_obc_tracer
public dyed_obc_tracer_column_physics, dyed_obc_tracer_end
+!> The control structure for the dyed_obc tracer package
type, public :: dyed_obc_tracer_CS ; private
- integer :: ntr ! The number of tracers that are actually used.
- logical :: coupled_tracers = .false. ! These tracers are not offered to the
- ! coupler.
- character(len=200) :: tracer_IC_file ! The full path to the IC file, or " "
- ! to initialize internally.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
- real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this
- ! subroutine, in g m-3?
-
- integer, allocatable, dimension(:) :: &
- ind_tr ! Indices returned by aof_set_coupler_flux if it is used and the
- ! surface tracer concentrations are to be provided to the coupler.
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- type(MOM_restart_CS), pointer :: restart_CSp => NULL()
-
- type(vardesc), allocatable :: tr_desc(:)
+ integer :: ntr !< The number of tracers that are actually used.
+ logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
+ character(len=200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3?
+
+ integer, allocatable, dimension(:) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the
+ !! surface tracer concentrations are to be provided to the coupler.
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure
+
+ type(vardesc), allocatable :: tr_desc(:) !< Descriptions and metadata for the tracers
end type dyed_obc_tracer_CS
contains
-!> This subroutine is used to register tracer fields and subroutines
-!! to be used with MOM.
+!> Register tracer fields and subroutines to be used with MOM.
function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -134,10 +131,8 @@ function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
register_dyed_obc_tracer = .true.
end function register_dyed_obc_tracer
-!> This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:)
-!! and it sets up the tracer output.
-subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS, &
- diag_to_Z_CSp)
+!> Initializes the CS%ntr tracer fields in tr(:,:,:,:) and sets up the tracer output.
+subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS, diag_to_Z_CSp)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
logical, intent(in) :: restart !< .true. if the fields have already
@@ -274,35 +269,19 @@ subroutine dyed_obc_tracer_end(CS)
end subroutine dyed_obc_tracer_end
!> \namespace dyed_obc_tracer
-!! *
-!! By Kate Hedstrom, 2017, copied from DOME tracers and also *
-!! dye_example. *
-!! *
-!! This file contains an example of the code that is needed to set *
-!! up and use a set of dynamically passive tracers. These tracers *
-!! dye the inflowing water, one per open boundary segment. *
-!! *
-!! A single subroutine is called from within each file to register *
-!! each of the tracers for reinitialization and advection and to *
-!! register the subroutine that initializes the tracers and set up *
-!! their output and the subroutine that does any tracer physics or *
-!! chemistry along with diapycnal mixing (included here because some *
-!! tracers may float or swim vertically or dye diapycnal processes). *
-!! *
-!! Macros written all in capital letters are defined in MOM_memory.h. *
-!! *
-!! A small fragment of the grid is shown below: *
-!! *
-!! j+1 x ^ x ^ x At x: q *
-!! j+1 > o > o > At ^: v *
-!! j x ^ x ^ x At >: u *
-!! j > o > o > At o: h, tr *
-!! j-1 x ^ x ^ x *
-!! i-1 i i+1 At x & ^: *
-!! i i+1 At > & o: *
-!! *
-!! The boundaries always run through q grid points (x). *
-!! *
-!!*******+*********+*********+*********+*********+*********+*********+**
+!!
+!! By Kate Hedstrom, 2017, copied from DOME tracers and also
+!! dye_example.
+!!
+!! This file contains an example of the code that is needed to set
+!! up and use a set of dynamically passive tracers. These tracers
+!! dye the inflowing water, one per open boundary segment.
+!!
+!! A single subroutine is called from within each file to register
+!! each of the tracers for reinitialization and advection and to
+!! register the subroutine that initializes the tracers and set up
+!! their output and the subroutine that does any tracer physics or
+!! chemistry along with diapycnal mixing (included here because some
+!! tracers may float or swim vertically or dye diapycnal processes).
end module dyed_obc_tracer
diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90
index c284a4d452..d7fcb53324 100644
--- a/src/tracer/ideal_age_example.F90
+++ b/src/tracer/ideal_age_example.F90
@@ -1,42 +1,8 @@
+!> A tracer package of ideal age tracers
module ideal_age_example
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, 2002 *
-!* *
-!* This file contains an example of the code that is needed to set *
-!* up and use a set (in this case two) of dynamically passive tracers *
-!* for diagnostic purposes. The tracers here are an ideal age tracer *
-!* that ages at a rate of 1/year once it is isolated from the surface,*
-!* and a vintage tracer, whose surface concentration grows exponen- *
-!* with time with a 30-year timescale (similar to CFCs). *
-!* *
-!* A single subroutine is called from within each file to register *
-!* each of the tracers for reinitialization and advection and to *
-!* register the subroutine that initializes the tracers and set up *
-!* their output and the subroutine that does any tracer physics or *
-!* chemistry along with diapycnal mixing (included here because some *
-!* tracers may float or swim vertically or dye diapycnal processes). *
-!* *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, tr *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_mediator, only : diag_ctrl
use MOM_diag_to_Z, only : diag_to_Z_CS
use MOM_error_handler, only : MOM_error, FATAL, WARNING
@@ -48,7 +14,7 @@ module ideal_age_example
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : query_initialized, MOM_restart_CS
use MOM_sponge, only : set_up_sponge_field, sponge_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type, time_type_to_real
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_Z_init, only : tracer_Z_init
@@ -66,48 +32,44 @@ module ideal_age_example
public ideal_age_tracer_column_physics, ideal_age_tracer_surface_state
public ideal_age_stock, ideal_age_example_end
-! NTR_MAX is the maximum number of tracers in this module.
-integer, parameter :: NTR_MAX = 3
+integer, parameter :: NTR_MAX = 3 !< the maximum number of tracers in this module.
+!> The control structure for the ideal_age_tracer package
type, public :: ideal_age_tracer_CS ; private
- integer :: ntr ! The number of tracers that are actually used.
- logical :: coupled_tracers = .false. ! These tracers are not offered to the
- ! coupler.
- integer :: nkml ! The number of layers in the mixed layer. The ideal
- ! age tracers are reset in the top nkml layers.
- character(len=200) :: IC_file ! The file in which the age-tracer initial values
- ! can be found, or an empty string for internal initialization.
- logical :: Z_IC_file ! If true, the IC_file is in Z-space. The default is false.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
- real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this
- ! subroutine, in g m-3?
- real, dimension(NTR_MAX) :: &
- IC_val = 0.0, & ! The (uniform) initial condition value.
- young_val = 0.0, & ! The value assigned to tr at the surface.
- land_val = -1.0, & ! The value of tr used where land is masked out.
- sfc_growth_rate, & ! The exponential growth rate for the surface value,
- ! in units of year-1.
- tracer_start_year ! The year in which tracers start aging, or at which the
- ! surface value equals young_val, in years.
- logical :: tracers_may_reinit ! If true, tracers may go through the
- ! initialization code if they are not found in the
- ! restart files.
- logical :: tracer_ages(NTR_MAX)
-
- integer, dimension(NTR_MAX) :: &
- ind_tr ! Indices returned by aof_set_coupler_flux if it is used and the
- ! surface tracer concentrations are to be provided to the coupler.
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- type(MOM_restart_CS), pointer :: restart_CSp => NULL()
-
- type(vardesc) :: tr_desc(NTR_MAX)
+ integer :: ntr !< The number of tracers that are actually used.
+ logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
+ integer :: nkml !< The number of layers in the mixed layer. The ideal
+ !1 age tracers are reset in the top nkml layers.
+ character(len=200) :: IC_file !< The file in which the age-tracer initial values
+ !! can be found, or an empty string for internal initialization.
+ logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3?
+ real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value.
+ real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface.
+ real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out.
+ real, dimension(NTR_MAX) :: sfc_growth_rate !< The exponential growth rate for the surface value,
+ !! in units of year-1.
+ real, dimension(NTR_MAX) :: tracer_start_year !< The year in which tracers start aging, or at which the
+ !! surface value equals young_val, in years.
+ logical :: tracers_may_reinit !< If true, these tracers be set up via the initialization code if
+ !! they are not found in the restart files.
+ logical :: tracer_ages(NTR_MAX) !< Indicates whether each tracer ages.
+
+ integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the
+ !! surface tracer concentrations are to be provided to the coupler.
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart controls structure
+
+ type(vardesc) :: tr_desc(NTR_MAX) !< Descriptions and metadata for the tracers
end type ideal_age_tracer_CS
contains
+!> Register the ideal age tracer fields to be used with MOM.
function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -118,16 +80,6 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
!! structure for the tracer advection and
!! diffusion module
type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure
-! This subroutine is used to register tracer fields and subroutines
-! to be used with MOM.
-! Arguments: HI - A horizontal index type structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-! (in/out) tr_Reg - A pointer that is set to point to the control structure
-! for the tracer advection and diffusion module.
-! (in) restart_CS - A pointer to the restart control structure.
! This include declares and sets the variable "version".
#include "version_variable.h"
@@ -240,6 +192,7 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
register_ideal_age_tracer = .true.
end function register_ideal_age_tracer
+!> Sets the ideal age traces to their initial values and sets up the tracer output
subroutine initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS, &
sponge_CSp, diag_to_Z_CSp)
logical, intent(in) :: restart !< .true. if the fields have already
@@ -262,21 +215,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS, &
! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:)
! and it sets up the tracer output.
-! Arguments: restart - .true. if the fields have already been read from
-! a restart file.
-! (in) day - Time of the start of the run.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) h - Layer thickness, in m or kg m-2.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in) OBC - This open boundary condition type specifies whether, where,
-! and what open boundary conditions are used.
-! (in/out) CS - The control structure returned by a previous call to
-! register_ideal_age_tracer.
-! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if
-! they are in use. Otherwise this may be unassociated.
-! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics
-! in depth space.
+ ! Local variables
character(len=24) :: name ! A variable's name in a NetCDF file.
character(len=72) :: longname ! The long name of that variable.
character(len=48) :: units ! The dimensions of the variable.
@@ -341,6 +280,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS, &
end subroutine initialize_ideal_age_tracer
+!> Applies diapycnal diffusion, aging and regeneration at the surface to the ideal age tracers
subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, &
evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
@@ -370,29 +310,13 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G,
! tracer physics or chemistry to the tracers from this file.
! This is a simple example of a set of advected passive tracers.
-! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2.
-! (in) h_new - Layer thickness after entrainment, in m or kg m-2.
-! (in) ea - an array to which the amount of fluid entrained
-! from the layer above during this call will be
-! added, in m or kg m-2.
-! (in) eb - an array to which the amount of fluid entrained
-! from the layer below during this call will be
-! added, in m or kg m-2.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) dt - The amount of time covered by this call, in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_ideal_age_tracer.
-!
! The arguments to this subroutine are redundant in that
! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1]
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
real :: sfc_val ! The surface value for the tracers.
real :: Isecs_per_year ! The number of seconds in a year.
real :: year ! The time in years.
- integer :: secs, days ! Integer components of the time type.
integer :: i, j, k, is, ie, js, je, nz, m
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -417,8 +341,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G,
Isecs_per_year = 1.0 / (365.0*86400.0)
! Set the surface value of tracer 1 to increase exponentially
! with a 30 year time scale.
- call get_time(CS%Time, secs, days)
- year = (86400.0*days + real(secs)) * Isecs_per_year
+ year = time_type_to_real(CS%Time) * Isecs_per_year
do m=1,CS%ntr
if (CS%sfc_growth_rate(m) == 0.0) then
@@ -445,36 +368,26 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G,
end subroutine ideal_age_tracer_column_physics
+!> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it
+!! has calculated. If stock_index is present, only the stock corresponding to that coded index is found.
function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each
- !! tracer, in kg times concentration units.
+ !! tracer, in kg times concentration units.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous
- !! call to register_ideal_age_tracer.
+ type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous
+ !! call to register_ideal_age_tracer.
character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated.
character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated.
integer, optional, intent(in) :: stock_index !< the coded index of a specific stock
!! being sought.
- integer :: ideal_age_stock
+ integer :: ideal_age_stock !< The number of stocks calculated here.
! This function calculates the mass-weighted integral of all tracer stocks,
! returning the number of stocks it has calculated. If the stock_index
! is present, only the stock corresponding to that coded index is returned.
-! Arguments: h - Layer thickness, in m or kg m-2.
-! (out) stocks - the mass-weighted integrated amount of each tracer,
-! in kg times concentration units.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_ideal_age_tracer.
-! (out) names - the names of the stocks calculated.
-! (out) units - the units of the stocks calculated.
-! (in,opt) stock_index - the coded index of a specific stock being sought.
-! Return value: the number of stocks calculated here.
-
integer :: i, j, k, is, ie, js, je, nz, m
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -536,6 +449,7 @@ subroutine ideal_age_tracer_surface_state(state, h, G, CS)
end subroutine ideal_age_tracer_surface_state
+!> Deallocate any memory associated with this tracer package
subroutine ideal_age_example_end(CS)
type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_ideal_age_tracer.
@@ -548,4 +462,15 @@ subroutine ideal_age_example_end(CS)
endif
end subroutine ideal_age_example_end
+!> \namespace ideal_age_example
+!!
+!! Originally by Robert Hallberg, 2002
+!!
+!! This file contains an example of the code that is needed to set
+!! up and use a set (in this case two) of dynamically passive tracers
+!! for diagnostic purposes. The tracers here are an ideal age tracer
+!! that ages at a rate of 1/year once it is isolated from the surface,
+!! and a vintage tracer, whose surface concentration grows exponen-
+!! with time with a 30-year timescale (similar to CFCs).
+
end module ideal_age_example
diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90
index 47edfac6e6..3b98c19a73 100644
--- a/src/tracer/oil_tracer.F90
+++ b/src/tracer/oil_tracer.F90
@@ -1,42 +1,8 @@
+!> A tracer package to mimic dissolved oil.
module oil_tracer
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, 2002 *
-!* *
-!* This file contains an example of the code that is needed to set *
-!* up and use a set (in this case two) of dynamically passive tracers *
-!* for diagnostic purposes. The tracers here are an ideal age tracer *
-!* that ages at a rate of 1/year once it is isolated from the surface,*
-!* and a vintage tracer, whose surface concentration grows exponen- *
-!* with time with a 30-year timescale (similar to CFCs). *
-!* *
-!* A single subroutine is called from within each file to register *
-!* each of the tracers for reinitialization and advection and to *
-!* register the subroutine that initializes the tracers and set up *
-!* their output and the subroutine that does any tracer physics or *
-!* chemistry along with diapycnal mixing (included here because some *
-!* tracers may float or swim vertically or dye diapycnal processes). *
-!* *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, tr *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_mediator, only : diag_ctrl
use MOM_diag_to_Z, only : diag_to_Z_CS
use MOM_error_handler, only : MOM_error, FATAL, WARNING
@@ -48,7 +14,7 @@ module oil_tracer
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : query_initialized, MOM_restart_CS
use MOM_sponge, only : set_up_sponge_field, sponge_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type, time_type_to_real
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_Z_init, only : tracer_Z_init
@@ -67,52 +33,48 @@ module oil_tracer
public oil_tracer_column_physics, oil_tracer_surface_state
public oil_stock, oil_tracer_end
-! NTR_MAX is the maximum number of tracers in this module.
-integer, parameter :: NTR_MAX = 20
+integer, parameter :: NTR_MAX = 20 !< the maximum number of tracers in this module.
+!> The control structure for the oil tracer package
type, public :: oil_tracer_CS ; private
- integer :: ntr ! The number of tracers that are actually used.
- logical :: coupled_tracers = .false. ! These tracers are not offered to the
- ! coupler.
- character(len=200) :: IC_file ! The file in which the age-tracer initial values
- ! can be found, or an empty string for internal initialization.
- logical :: Z_IC_file ! If true, the IC_file is in Z-space. The default is false.
- real :: oil_source_longitude, oil_source_latitude ! Lat,lon of source location (geographic)
- integer :: oil_source_i=-999, oil_source_j=-999 ! Local i,j of source location (computational)
- real :: oil_source_rate ! Rate of oil injection (kg/s)
- real :: oil_start_year ! The year in which tracers start aging, or at which the
- ! surface value equals young_val, in years.
- real :: oil_end_year ! The year in which tracers start aging, or at which the
- ! surface value equals young_val, in years.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
- real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this
- ! subroutine, in g m-3?
- real, dimension(NTR_MAX) :: &
- IC_val = 0.0, & ! The (uniform) initial condition value.
- young_val = 0.0, & ! The value assigned to tr at the surface.
- land_val = -1.0, & ! The value of tr used where land is masked out.
- sfc_growth_rate ! The exponential growth rate for the surface value,
- ! in units of year-1.
- real, dimension(NTR_MAX) :: oil_decay_days, & ! Decay time scale of oil (in days)
- oil_decay_rate ! Decay rate of oil (in s^-1) calculated from oil_decay_days
- integer, dimension(NTR_MAX) :: oil_source_k ! Layer of source
- logical :: oil_may_reinit ! If true, oil may go through the
- ! initialization code if they are not found in the
- ! restart files.
- integer, dimension(NTR_MAX) :: &
- ind_tr ! Indices returned by aof_set_coupler_flux if it is used and the
- ! surface tracer concentrations are to be provided to the coupler.
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- type(MOM_restart_CS), pointer :: restart_CSp => NULL()
-
- type(vardesc) :: tr_desc(NTR_MAX)
+ integer :: ntr !< The number of tracers that are actually used.
+ logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
+ character(len=200) :: IC_file !< The file in which the age-tracer initial values
+ !! can be found, or an empty string for internal initialization.
+ logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false.
+ real :: oil_source_longitude !< Latitude of source location (geographic)
+ real :: oil_source_latitude !< Longitude of source location (geographic)
+ integer :: oil_source_i=-999 !< Local i of source location (computational)
+ integer :: oil_source_j=-999 !< Local j of source location (computational)
+ real :: oil_source_rate !< Rate of oil injection (kg/s)
+ real :: oil_start_year !< The year in which tracers start aging, or at which the
+ !! surface value equals young_val, in years.
+ real :: oil_end_year !< The year in which tracers start aging, or at which the
+ !! surface value equals young_val, in years.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3?
+ real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value.
+ real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface.
+ real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out.
+ real, dimension(NTR_MAX) :: sfc_growth_rate !< The exponential growth rate for the surface value, in units of year-1.
+ real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil (in days)
+ real, dimension(NTR_MAX) :: oil_decay_rate !< Decay rate of oil (in s^-1) calculated from oil_decay_days
+ integer, dimension(NTR_MAX) :: oil_source_k !< Layer of source
+ logical :: oil_may_reinit !< If true, oil tracers may be reset by the initialization code
+ !! if they are not found in the restart files.
+ integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the
+ !! surface tracer concentrations are to be provided to the coupler.
+ type(vardesc) :: tr_desc(NTR_MAX) !< Descriptions and metadata for the tracers
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure
end type oil_tracer_CS
contains
+!> Register oil tracer fields and subroutines to be used with MOM.
function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -123,21 +85,11 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
!! structure for the tracer advection and
!! diffusion module
type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure
-! This subroutine is used to register tracer fields and subroutines
-! to be used with MOM.
-! Arguments: HI - A horizontal index type structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-! (in/out) tr_Reg - A pointer that is set to point to the control structure
-! for the tracer advection and diffusion module.
-! (in) restart_CS - A pointer to the restart control structure.
+ ! Local variables
+ character(len=40) :: mdl = "oil_tracer" ! This module's name.
! This include declares and sets the variable "version".
#include "version_variable.h"
- character(len=40) :: mdl = "oil_tracer" ! This module's name.
character(len=200) :: inputdir ! The directory where the input files are.
character(len=48) :: var_name ! The variable's name.
character(len=3) :: name_tag ! String for creating identifying oils
@@ -248,6 +200,7 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
end function register_oil_tracer
+!> Initialize the oil tracers and set up tracer output
subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, &
sponge_CSp, diag_to_Z_CSp)
logical, intent(in) :: restart !< .true. if the fields have already
@@ -267,24 +220,8 @@ subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, &
type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges.
type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure
!! for diagnostics in depth space.
-! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:)
-! and it sets up the tracer output.
-
-! Arguments: restart - .true. if the fields have already been read from
-! a restart file.
-! (in) day - Time of the start of the run.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) h - Layer thickness, in m or kg m-2.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in) OBC - This open boundary condition type specifies whether, where,
-! and what open boundary conditions are used.
-! (in/out) CS - The control structure returned by a previous call to
-! register_oil_tracer.
-! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if
-! they are in use. Otherwise this may be unassociated.
-! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics
-! in depth space.
+
+ ! Local variables
character(len=16) :: name ! A variable's name in a NetCDF file.
character(len=72) :: longname ! The long name of that variable.
character(len=48) :: units ! The dimensions of the variable.
@@ -359,6 +296,7 @@ subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, &
end subroutine initialize_oil_tracer
+!> Apply sources, sinks, diapycnal mixing and rising motions to the oil tracers
subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, &
evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
@@ -389,29 +327,13 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS
! tracer physics or chemistry to the tracers from this file.
! This is a simple example of a set of advected passive tracers.
-! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2.
-! (in) h_new - Layer thickness after entrainment, in m or kg m-2.
-! (in) ea - an array to which the amount of fluid entrained
-! from the layer above during this call will be
-! added, in m or kg m-2.
-! (in) eb - an array to which the amount of fluid entrained
-! from the layer below during this call will be
-! added, in m or kg m-2.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) dt - The amount of time covered by this call, in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_oil_tracer.
-!
! The arguments to this subroutine are redundant in that
! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1]
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
real :: Isecs_per_year = 1.0 / (365.0*86400.0)
real :: year, h_total, ldecay
- integer :: secs, days
integer :: i, j, k, is, ie, js, je, nz, m, k_max
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -433,10 +355,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS
enddo
endif
- ! Set the surface value of tracer 1 to increase exponentially
- ! with a 30 year time scale.
- call get_time(CS%Time, secs, days)
- year = (86400.0*days + real(secs)) * Isecs_per_year
+ year = time_type_to_real(CS%Time) * Isecs_per_year
! Decay tracer (limit decay rate to 1/dt - just in case)
do m=2,CS%ntr
@@ -483,6 +402,8 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS
end subroutine oil_tracer_column_physics
+!> Calculate the mass-weighted integral of the oil tracer stocks, returning the number of stocks it
+!! has calculated. If the stock_index is present, only the stock corresponding to that coded index is returned.
function oil_stock(h, stocks, G, GV, CS, names, units, stock_index)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -495,23 +416,13 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index)
character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated.
integer, optional, intent(in) :: stock_index !< the coded index of a specific stock
!! being sought.
- integer :: oil_stock
+ integer :: oil_stock !< The number of stocks calculated here.
+
! This function calculates the mass-weighted integral of all tracer stocks,
! returning the number of stocks it has calculated. If the stock_index
! is present, only the stock corresponding to that coded index is returned.
-! Arguments: h - Layer thickness, in m or kg m-2.
-! (out) stocks - the mass-weighted integrated amount of each tracer,
-! in kg times concentration units.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_oil_tracer.
-! (out) names - the names of the stocks calculated.
-! (out) units - the units of the stocks calculated.
-! (in,opt) stock_index - the coded index of a specific stock being sought.
-! Return value: the number of stocks calculated here.
-
+ ! Local variables
integer :: i, j, k, is, ie, js, je, nz, m
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -573,6 +484,7 @@ subroutine oil_tracer_surface_state(state, h, G, CS)
end subroutine oil_tracer_surface_state
+!> Deallocate memory associated with this tracer package
subroutine oil_tracer_end(CS)
type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_oil_tracer.
@@ -584,4 +496,18 @@ subroutine oil_tracer_end(CS)
endif
end subroutine oil_tracer_end
+!> \namespace oil_tracer
+!!
+!! By Alistair Adcroft and Robert Hallberg, 2010 *
+!!
+!! In the midst of the Deepwater Horizon oil spill, it became evident that
+!! models were needed to predict the long-term fate of dissolved oil in the
+!! open ocean. This tracer packages mimics the transport, dilution and decay
+!! of dissolved oil plumes in the ocean.
+!!
+!! This tracer package was central to the simulations used by Adcroft et al.,
+!! GRL 2010, to prove that the Deepwater Horizon spill was an important regional
+!! event, with implications for dissolved oxygen levels in the Gulf of Mexico,
+!! but not one that would directly impact the East Coast of the U.S.
+
end module oil_tracer
diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90
index ec13de8df2..d9f4d3f682 100644
--- a/src/tracer/pseudo_salt_tracer.F90
+++ b/src/tracer/pseudo_salt_tracer.F90
@@ -1,40 +1,8 @@
+!> A tracer package that mimics salinity
module pseudo_salt_tracer
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Andrew Shao, 2016 *
-!* *
-!* This file contains the routines necessary to model a passive *
-!* tracer that uses the same boundary fluxes as salinity. At the *
-!* beginning of the run, salt is set to the same as tv%S. Any *
-!* deviations between this salt-like tracer and tv%S signifies a *
-!* difference between how active and passive tracers are treated. *
-!* A single subroutine is called from within each file to register *
-!* each of the tracers for reinitialization and advection and to *
-!* register the subroutine that initializes the tracers and set up *
-!* their output and the subroutine that does any tracer physics or *
-!* chemistry along with diapycnal mixing (included here because some *
-!* tracers may float or swim vertically or dye diapycnal processes). *
-!* *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, tr *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_debugging, only : hchksum
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
use MOM_diag_mediator, only : diag_ctrl
@@ -48,7 +16,7 @@ module pseudo_salt_tracer
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : query_initialized, MOM_restart_CS
use MOM_sponge, only : set_up_sponge_field, sponge_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_Z_init, only : tracer_Z_init
@@ -67,26 +35,28 @@ module pseudo_salt_tracer
public pseudo_salt_tracer_column_physics, pseudo_salt_tracer_surface_state
public pseudo_salt_stock, pseudo_salt_tracer_end
+!> The control structure for the pseudo-salt tracer
type, public :: pseudo_salt_tracer_CS ; private
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
- real, pointer :: ps(:,:,:) => NULL() ! The array of pseudo-salt tracer used in this
- ! subroutine, in psu
- real, pointer :: diff(:,:,:) => NULL() ! The difference between the pseudo-salt
- ! tracer and the real salt, in psu.
- logical :: pseudo_salt_may_reinit = .true. ! Hard coding since this should not matter
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry
+ real, pointer :: ps(:,:,:) => NULL() !< The array of pseudo-salt tracer used in this
+ !! subroutine, in psu
+ real, pointer :: diff(:,:,:) => NULL() !< The difference between the pseudo-salt
+ !! tracer and the real salt, in psu.
+ logical :: pseudo_salt_may_reinit = .true. !< Hard coding since this should not matter
- integer :: id_psd = -1
+ integer :: id_psd = -1 !< A diagnostic ID
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- type(MOM_restart_CS), pointer :: restart_CSp => NULL()
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure
- type(vardesc) :: tr_desc
+ type(vardesc) :: tr_desc !< A description and metadata for the pseudo-salt tracer
end type pseudo_salt_tracer_CS
contains
+!> Register the pseudo-salt tracer with MOM6
function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -99,22 +69,14 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure
! This subroutine is used to register tracer fields and subroutines
! to be used with MOM.
-! Arguments: HI - A horizontal index type structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-! (in/out) tr_Reg - A pointer that is set to point to the control structure
-! for the tracer advection and diffusion module.
-! (in) restart_CS - A pointer to the restart control structure.
-! This include declares and sets the variable "version".
-#include "version_variable.h"
+ ! Local variables
character(len=40) :: mdl = "pseudo_salt_tracer" ! This module's name.
character(len=200) :: inputdir ! The directory where the input files are.
character(len=48) :: var_name ! The variable's name.
character(len=3) :: name_tag ! String for creating identifying pseudo_salt
+! This include declares and sets the variable "version".
+#include "version_variable.h"
real, pointer :: tr_ptr(:,:,:) => NULL()
logical :: register_pseudo_salt_tracer
integer :: isd, ied, jsd, jed, nz, i, j
@@ -150,6 +112,7 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
end function register_pseudo_salt_tracer
+!> Initialize the pseudo-salt tracer
subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, &
sponge_CSp, diag_to_Z_CSp, tv)
logical, intent(in) :: restart !< .true. if the fields have already
@@ -172,21 +135,7 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS,
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
! This subroutine initializes the tracer fields in CS%ps(:,:,:).
-! Arguments: restart - .true. if the fields have already been read from
-! a restart file.
-! (in) day - Time of the start of the run.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) h - Layer thickness, in m or kg m-2.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in) OBC - This open boundary condition type specifies whether, where,
-! and what open boundary conditions are used.
-! (in/out) CS - The control structure returned by a previous call to
-! register_pseudo_salt_tracer.
-! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if
-! they are in use. Otherwise this may be unassociated.
-! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics
-! in depth space.
+ ! Local variables
character(len=16) :: name ! A variable's name in a NetCDF file.
character(len=72) :: longname ! The long name of that variable.
character(len=48) :: units ! The dimensions of the variable.
@@ -223,6 +172,7 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS,
end subroutine initialize_pseudo_salt_tracer
+!> Apply sources, sinks and diapycnal diffusion to the tracers in this package.
subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, &
evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
@@ -253,43 +203,17 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G
! This subroutine applies diapycnal diffusion and any other column
! tracer physics or chemistry to the tracers from this file.
-! This is a simple example of a set of advected passive tracers.
-
-! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2.
-! (in) h_new - Layer thickness after entrainment, in m or kg m-2.
-! (in) ea - an array to which the amount of fluid entrained
-! from the layer above during this call will be
-! added, in m or kg m-2.
-! (in) eb - an array to which the amount of fluid entrained
-! from the layer below during this call will be
-! added, in m or kg m-2.
-! (in) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) dt - The amount of time covered by this call, in s.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_pseudo_salt_tracer.
-! (in) tv - Thermodynamic structure with T and S
-! (in) evap_CFL_limit - Limits how much water can be fluxed out of the top layer
-! Stored previously in diabatic CS.
-! (in) minimum_forcing_depth - The smallest depth over which fluxes can be applied
-! Stored previously in diabatic CS.
-! (in) debug - Calculates checksums
-!
+
! The arguments to this subroutine are redundant in that
! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1]
- real :: Isecs_per_year = 1.0 / (365.0*86400.0)
+ ! Local variables
real :: year, h_total, scale, htot, Ih_limit
integer :: secs, days
integer :: i, j, k, is, ie, js, je, nz, k_max
- real, allocatable :: local_tr(:,:,:)
real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
- real, dimension(:,:), pointer :: net_salt
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
- net_salt=>fluxes%netSalt
if (.not.associated(CS)) return
if (.not.associated(CS%diff)) return
@@ -301,11 +225,11 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G
! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode
if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then
- do k=1,nz ;do j=js,je ; do i=is,ie
+ do k=1,nz ; do j=js,je ; do i=is,ie
h_work(i,j,k) = h_old(i,j,k)
enddo ; enddo ; enddo
call applyTracerBoundaryFluxesInOut(G, GV, CS%ps, dt, fluxes, h_work, &
- evap_CFL_limit, minimum_forcing_depth, out_flux_optional=net_salt)
+ evap_CFL_limit, minimum_forcing_depth, out_flux_optional=fluxes%netSalt)
call tracer_vertdiff(h_work, ea, eb, dt, CS%ps, G, GV)
else
call tracer_vertdiff(h_old, ea, eb, dt, CS%ps, G, GV)
@@ -324,6 +248,9 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G
end subroutine pseudo_salt_tracer_column_physics
+
+!> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has
+!! calculated. If the stock_index is present, only the stock corresponding to that coded index is returned.
function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -343,18 +270,6 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index)
! returning the number of stocks it has calculated. If the stock_index
! is present, only the stock corresponding to that coded index is returned.
-! Arguments: h - Layer thickness, in m or kg m-2.
-! (out) stocks - the mass-weighted integrated amount of each tracer,
-! in kg times concentration units.
-! (in) G - The ocean's grid structure.
-! (in) GV - The ocean's vertical grid structure.
-! (in) CS - The control structure returned by a previous call to
-! register_pseudo_salt_tracer.
-! (out) names - the names of the stocks calculated.
-! (out) units - the units of the stocks calculated.
-! (in,opt) stock_index - the coded index of a specific stock being sought.
-! Return value: the number of stocks calculated here.
-
integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -407,6 +322,7 @@ subroutine pseudo_salt_tracer_surface_state(state, h, G, CS)
end subroutine pseudo_salt_tracer_surface_state
+!> Deallocate memory associated with this tracer package
subroutine pseudo_salt_tracer_end(CS)
type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_pseudo_salt_tracer.
@@ -419,4 +335,14 @@ subroutine pseudo_salt_tracer_end(CS)
endif
end subroutine pseudo_salt_tracer_end
+!> \namespace pseudo_salt_tracer
+!!
+!! By Andrew Shao, 2016
+!!
+!! This file contains the routines necessary to model a passive
+!! tracer that uses the same boundary fluxes as salinity. At the
+!! beginning of the run, salt is set to the same as tv%S. Any
+!! deviations between this salt-like tracer and tv%S signifies a
+!! difference between how active and passive tracers are treated.
+
end module pseudo_salt_tracer
diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90
index c169ce768e..bf6b504658 100644
--- a/src/tracer/tracer_example.F90
+++ b/src/tracer/tracer_example.F90
@@ -1,38 +1,8 @@
+!> A sample tracer package that has striped initial conditions
module USER_tracer_example
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, 2002 *
-!* *
-!* This file contains an example of the code that is needed to set *
-!* up and use a set (in this case one) of dynamically passive tracers.*
-!* *
-!* A single subroutine is called from within each file to register *
-!* each of the tracers for reinitialization and advection and to *
-!* register the subroutine that initializes the tracers and set up *
-!* their output and the subroutine that does any tracer physics or *
-!* chemistry along with diapycnal mixing (included here because some *
-!* tracers may float or swim vertically or dye diapycnal processes). *
-!* *
-!* *
-!* Macros written all in capital letters are defined in MOM_memory.h. *
-!* *
-!* A small fragment of the grid is shown below: *
-!* *
-!* j+1 x ^ x ^ x At x: q *
-!* j+1 > o > o > At ^: v *
-!* j x ^ x ^ x At >: u *
-!* j > o > o > At o: h, tr *
-!* j-1 x ^ x ^ x *
-!* i-1 i i+1 At x & ^: *
-!* i i+1 At > & o: *
-!* *
-!* The boundaries always run through q grid points (x). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_mediator, only : diag_ctrl
use MOM_diag_to_Z, only : diag_to_Z_CS
use MOM_error_handler, only : MOM_error, FATAL, WARNING
@@ -44,7 +14,7 @@ module USER_tracer_example
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : MOM_restart_CS
use MOM_sponge, only : set_up_sponge_field, sponge_CS
-use MOM_time_manager, only : time_type, get_time
+use MOM_time_manager, only : time_type
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_variables, only : surface
use MOM_verticalGrid, only : verticalGrid_type
@@ -59,35 +29,30 @@ module USER_tracer_example
public USER_register_tracer_example, USER_initialize_tracer, USER_tracer_stock
public tracer_column_physics, USER_tracer_surface_state, USER_tracer_example_end
-! NTR is the number of tracers in this module.
-integer, parameter :: NTR = 1
+integer, parameter :: NTR = 1 !< The number of tracers in this module.
+!> The control structure for the USER_tracer_example module
type, public :: USER_tracer_example_CS ; private
- logical :: coupled_tracers = .false. ! These tracers are not offered to the
- ! coupler.
- character(len=200) :: tracer_IC_file ! The full path to the IC file, or " "
- ! to initialize internally.
- type(time_type), pointer :: Time ! A pointer to the ocean model's clock.
- type(tracer_registry_type), pointer :: tr_Reg => NULL()
- real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this
- ! subroutine, in g m-3?
- real :: land_val(NTR) = -1.0 ! The value of tr used where land is masked out.
- logical :: use_sponge ! If true, sponges may be applied somewhere in the domain.
-
- integer, dimension(NTR) :: ind_tr ! Indices returned by aof_set_coupler_flux
- ! if it is used and the surface tracer concentrations are to be
- ! provided to the coupler.
-
- type(diag_ctrl), pointer :: diag ! A pointer to a structure of shareable
- ! ocean diagnostic fields and control variables.
-
- type(vardesc) :: tr_desc(NTR)
+ logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
+ character(len=200) :: tracer_IC_file !< The full path to the IC file, or " "
+ !! to initialize internally.
+ type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
+ type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3?
+ real :: land_val(NTR) = -1.0 !< The value of tr that is used where land is masked out.
+ logical :: use_sponge !< If true, sponges may be applied somewhere in the domain.
+
+ integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the
+ !! surface tracer concentrations are to be provided to the coupler.
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the timing of diagnostic output.
+
+ type(vardesc) :: tr_desc(NTR) !< Descriptions of each of the tracers.
end type USER_tracer_example_CS
contains
-!> This subroutine is used to register tracer fields and subroutines
-!! to be used with MOM.
+!> This subroutine is used to register tracer fields and subroutines to be used with MOM.
function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -483,4 +448,17 @@ subroutine USER_tracer_example_end(CS)
endif
end subroutine USER_tracer_example_end
+!> \namespace user_tracer_example
+!!
+!! Original by Robert Hallberg, 2002
+!!
+!! This file contains an example of the code that is needed to set
+!! up and use a set (in this case one) of dynamically passive tracers.
+!!
+!! A single subroutine is called from within each file to register
+!! each of the tracers for reinitialization and advection and to
+!! register the subroutine that initializes the tracers and set up
+!! their output and the subroutine that does any tracer physics or
+!! chemistry along with diapycnal mixing (included here because some
+!! tracers may float or swim vertically or dye diapycnal processes).
end module USER_tracer_example
diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90
index b4d317d289..2eda7d2f1d 100644
--- a/src/user/BFB_initialization.F90
+++ b/src/user/BFB_initialization.F90
@@ -1,27 +1,8 @@
+!> Initialization of the boundary-forced-basing configuration
module BFB_initialization
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Robert Hallberg, April 1994 - June 2002 *
-!* *
-!* This subroutine initializes the fields for the simulations. *
-!* The one argument passed to initialize, Time, is set to the *
-!* current time of the simulation. The fields which are initialized *
-!* here are: *
-!* G%g_prime - The reduced gravity at each interface, in m s-2. *
-!* G%Rlay - Layer potential density (coordinate variable) in kg m-3.*
-!* If SPONGE is defined: *
-!* A series of subroutine calls are made to set up the damping *
-!* rates and reference profiles for all variables that are damped *
-!* in the sponge. *
-!* *
-!* These variables are all set in the set of subroutines (in this *
-!* file) BFB_initialize_sponges_southonly and BFB_set_coord. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_get_input, only : directories
@@ -38,6 +19,8 @@ module BFB_initialization
public BFB_set_coord
public BFB_initialize_sponges_southonly
+!> Unsafe model variable
+!! \todo Remove this module variable
logical :: first_call = .true.
contains
@@ -47,10 +30,14 @@ module BFB_initialization
!! southern edge of the domain. The temperatures are then converted to densities of the top and bottom layers
!! and linearly interpolated for the intermediate layers.
subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state)
- real, dimension(NKMEM_), intent(out) :: Rlay, g_prime
+ real, dimension(NKMEM_), intent(out) :: Rlay !< Layer potential density.
+ real, dimension(NKMEM_), intent(out) :: g_prime !< The reduced gravity at
+ !! each interface, in m2 Z-1 s-2.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- type(EOS_type), pointer :: eqn_of_state
+ type(EOS_type), pointer :: eqn_of_state !< Integer that selects the
+ !! equation of state.
+ ! Local variables
real :: drho_dt, SST_s, T_bot, rho_top, rho_bot
integer :: k, nz
character(len=40) :: mdl = "BFB_set_coord" ! This subroutine's name.
@@ -66,15 +53,12 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state)
rho_bot = GV%rho0 + drho_dt*T_bot
nz = GV%ke
- !call MOM_error(FATAL, &
- ! "BFB_initialization.F90, BFB_set_coord: " // &
- ! "Unmodified user routine called - you must edit the routine to use it")
do k = 1,nz
Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top
if (k >1) then
- g_prime(k) = (Rlay(k) - Rlay(k-1))*GV%g_earth/GV%rho0
+ g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth/GV%rho0
else
- g_prime(k) = GV%g_earth
+ g_prime(k) = GV%g_Earth
endif
!Rlay(:) = 0.0
!g_prime(:) = 0.0
@@ -86,22 +70,22 @@ end subroutine BFB_set_coord
!> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs
!! within 2 degrees lat of the boundary. The damping linearly decreases northward over the next 2 degrees.
-subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, CSp, h)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- logical, intent(in) :: use_temperature
- type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
- type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- type(sponge_CS), pointer :: CSp
- real, dimension(NIMEM_, NJMEM_, NKMEM_), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
- !call MOM_error(FATAL, &
- ! "BFB_initialization.F90, BFB_initialize_sponges: " // &
- ! "Unmodified user routine called - you must edit the routine to use it")
-
- real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta.
+subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_file, CSp, h)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ logical, intent(in) :: use_temperature !< If true, temperature and salinity are used as
+ !! state variables.
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure
+ real, dimension(NIMEM_, NJMEM_, NKMEM_), &
+ intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2)
+
+ ! Local variables
+ real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z).
real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1.
-
- real :: H0(SZK_(G))
- real :: min_depth
+ real :: H0(SZK_(G)) ! Resting layer thickesses in depth units (Z).
+ real :: min_depth ! The minimum ocean depth in depth units (Z).
real :: damp, e_dense, damp_new, slat, wlon, lenlat, lenlon, nlat
character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name.
integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
@@ -118,7 +102,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file,
! Set up sponges for DOME configuration
call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, &
- "The minimum depth of the ocean.", units="m", default=0.0)
+ "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z)
call get_param(param_file, mdl, "SOUTHLAT", slat, &
"The southern latitude of the domain.", units="degrees")
@@ -151,11 +135,12 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file,
! do k = 1,nz; eta(i,j,k) = H0(k); enddo
! if (G%geoLatT(i,j) > 40.0) then
! do k = 1,nz
- ! eta(i,j,k) = -G%Angstrom_z*(k-1)
+ ! eta(i,j,k) = -G%Angstrom_Z*(k-1)
! enddo
! elseif (G%geoLatT(i,j) > 20.0) then
! do k = 1,nz
- ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_z)/20.0, -(k-1)*G%angstrom_z)
+ ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_Z)/20.0, &
+ ! -(k-1)*G%Angstrom_Z)
! enddo
! endif
eta(i,j,nz+1) = -G%max_depth
@@ -167,7 +152,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file,
! This call sets up the damping rates and interface heights.
! This sets the inverse damping timescale fields in the sponges. !
- call initialize_sponge(Idamp, eta, G, param_file, CSp)
+ call initialize_sponge(Idamp, eta, G, param_file, CSp, GV)
! Now register all of the fields which are damped in the sponge. !
! By default, momentum is advected vertically within the sponge, but !
diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90
index e3aa923179..edcdb002cf 100644
--- a/src/user/BFB_surface_forcing.F90
+++ b/src/user/BFB_surface_forcing.F90
@@ -1,20 +1,8 @@
+!> Surface forcing for the boundary-forced-basin (BFB) configuration
module BFB_surface_forcing
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* Rewritten by Robert Hallberg, June 2009 *
-!* *
-!* This file contains subroutines for specifying surface buoyancy *
-!* forcing for the buoyancy-forced basin (BFB) case. *
-!* BFB_buoyancy_forcing is used to restore the surface buoayncy to *
-!* a linear meridional ramp of temperature. The extent of the ramp *
-!* can be specified by LFR_SLAT (linear forcing ramp southern *
-!* latitude) and LFR_NLAT. The temperatures at these edges of the *
-!* ramp can be specified by SST_S and SST_N. *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
use MOM_diag_mediator, only : post_data, query_averaging_enabled
use MOM_diag_mediator, only : register_diag_field, diag_ctrl
use MOM_domains, only : pass_var, pass_vector, AGRID
@@ -23,7 +11,8 @@ module BFB_surface_forcing
use MOM_forcing_type, only : forcing, allocate_forcing_type
use MOM_grid, only : ocean_grid_type
use MOM_io, only : file_exists, read_data
-use MOM_time_manager, only : time_type, operator(+), operator(/), get_time
+use MOM_safe_alloc, only : safe_alloc_ptr
+use MOM_time_manager, only : time_type, operator(+), operator(/)
use MOM_tracer_flow_control, only : call_tracer_set_forcing
use MOM_tracer_flow_control, only : tracer_flow_control_CS
use MOM_variables, only : surface
@@ -32,76 +21,52 @@ module BFB_surface_forcing
public BFB_buoyancy_forcing, BFB_surface_forcing_init
+!> Control structure for BFB_surface_forcing
type, public :: BFB_surface_forcing_CS ; private
- ! This control structure should be used to store any run-time variables
- ! associated with the user-specified forcing. It can be readily modified
- ! for a specific case, and because it is private there will be no changes
- ! needed in other code (although they will have to be recompiled).
- ! The variables in the cannonical example are used for some common
- ! cases, but do not need to be used.
- logical :: use_temperature ! If true, temperature and salinity are used as
- ! state variables.
- logical :: restorebuoy ! If true, use restoring surface buoyancy forcing.
- real :: Rho0 ! The density used in the Boussinesq
- ! approximation, in kg m-3.
- real :: G_Earth ! The gravitational acceleration in m s-2.
- real :: Flux_const ! The restoring rate at the surface, in m s-1.
- real :: gust_const ! A constant unresolved background gustiness
- ! that contributes to ustar, in Pa.
- real :: SST_s ! SST at the southern edge of the linear
- ! forcing ramp
- real :: SST_n ! SST at the northern edge of the linear
- ! forcing ramp
- real :: lfrslat ! Southern latitude where the linear forcing ramp
- ! begins
- real :: lfrnlat ! Northern latitude where the linear forcing ramp
- ! ends
- real :: drho_dt ! Rate of change of density with temperature.
- ! Note that temperature is being used as a dummy
- ! variable here. All temperatures are converted
- ! into density.
-
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
+ logical :: use_temperature !< If true, temperature and salinity are used as
+ !! state variables.
+ logical :: restorebuoy !< If true, use restoring surface buoyancy forcing.
+ real :: Rho0 !< The density used in the Boussinesq
+ !! approximation, in kg m-3.
+ real :: G_Earth !< The gravitational acceleration in m s-2.
+ real :: Flux_const !< The restoring rate at the surface, in m s-1.
+ real :: gust_const !< A constant unresolved background gustiness
+ !! that contributes to ustar, in Pa.
+ real :: SST_s !< SST at the southern edge of the linear
+ !! forcing ramp
+ real :: SST_n !< SST at the northern edge of the linear
+ !! forcing ramp
+ real :: lfrslat !< Southern latitude where the linear forcing ramp
+ !! begins
+ real :: lfrnlat !< Northern latitude where the linear forcing ramp
+ !! ends
+ real :: drho_dt !< Rate of change of density with temperature.
+ !! Note that temperature is being used as a dummy
+ !! variable here. All temperatures are converted
+ !! into density.
+
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
end type BFB_surface_forcing_CS
contains
+!> Bouyancy forcing for the boundary-forced-basin (BFB) configuration
subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS)
- type(surface), intent(inout) :: state
- type(forcing), intent(inout) :: fluxes
- type(time_type), intent(in) :: day
- real, intent(in) :: dt !< The amount of time over which
- !! the fluxes apply, in s
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(BFB_surface_forcing_CS), pointer :: CS
-
-! This subroutine specifies the current surface fluxes of buoyancy or
-! temperature and fresh water. It may also be modified to add
-! surface fluxes of user provided tracers.
-
-! When temperature is used, there are long list of fluxes that need to be
-! set - essentially the same as for a full coupled model, but most of these
-! can be simply set to zero. The net fresh water flux should probably be
-! set in fluxes%evap and fluxes%lprec, with any salinity restoring
-! appearing in fluxes%vprec, and the other water flux components
-! (fprec, lrunoff and frunoff) left as arrays full of zeros.
-! Evap is usually negative and precip is usually positive. All heat fluxes
-! are in W m-2 and positive for heat going into the ocean. All fresh water
-! fluxes are in kg m-2 s-1 and positive for water moving into the ocean.
-
-! Arguments: state - A structure containing fields that describe the
-! surface state of the ocean.
-! (out) fluxes - A structure containing pointers to any possible
-! forcing fields. Unused fields have NULL ptrs.
-! (in) day_start - Start time of the fluxes.
-! (in) day_interval - Length of time over which these fluxes
-! will be applied.
-! (in) G - The ocean's grid structure.
-! (in) CS - A pointer to the control structure returned by a previous
-! call to user_surface_forcing_init
-
+ type(surface), intent(inout) :: state !< A structure containing fields that
+ !! describe the surface state of the ocean.
+ type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any
+ !! possible forcing fields. Unused fields
+ !! have NULL ptrs.
+ type(time_type), intent(in) :: day !< Time of the fluxes.
+ real, intent(in) :: dt !< The amount of time over which
+ !! the fluxes apply, in s
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure
+ !! returned by a previous call to
+ !! BFB_surface_forcing_init.
+ ! Local variables
real :: Temp_restore ! The temperature that is being restored toward, in C.
real :: Salin_restore ! The salinity that is being restored toward, in PSU.
real :: density_restore ! The potential density that is being restored
@@ -115,32 +80,24 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS)
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- ! When modifying the code, comment out this error message. It is here
- ! so that the original (unmodified) version is not accidentally used.
- ! call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // &
- ! "User forcing routine called without modification." )
-
! Allocate and zero out the forcing arrays, as necessary. This portion is
! usually not changed.
if (CS%use_temperature) then
- call alloc_if_needed(fluxes%evap, isd, ied, jsd, jed)
- call alloc_if_needed(fluxes%lprec, isd, ied, jsd, jed)
- call alloc_if_needed(fluxes%fprec, isd, ied, jsd, jed)
- call alloc_if_needed(fluxes%lrunoff, isd, ied, jsd, jed)
- call alloc_if_needed(fluxes%frunoff, isd, ied, jsd, jed)
- call alloc_if_needed(fluxes%vprec, isd, ied, jsd, jed)
-
- call alloc_if_needed(fluxes%sw, isd, ied, jsd, jed)
- call alloc_if_needed(fluxes%lw, isd, ied, jsd, jed)
- call alloc_if_needed(fluxes%latent, isd, ied, jsd, jed)
- call alloc_if_needed(fluxes%sens, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%evap, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%lprec, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%fprec, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%lrunoff, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%frunoff, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%vprec, isd, ied, jsd, jed)
+
+ call safe_alloc_ptr(fluxes%sw, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%lw, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%latent, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%sens, isd, ied, jsd, jed)
else ! This is the buoyancy only mode.
- call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%buoy, isd, ied, jsd, jed)
endif
-
- ! MODIFY THE CODE IN THE FOLLOWING LOOPS TO SET THE BUOYANCY FORCING TERMS.
-
if ( CS%use_temperature ) then
! Set whichever fluxes are to be used here. Any fluxes that
! are always zero do not need to be changed here.
@@ -169,7 +126,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS)
if (CS%restorebuoy) then
if (CS%use_temperature) then
- call alloc_if_needed(fluxes%heat_added, isd, ied, jsd, jed)
+ call safe_alloc_ptr(fluxes%heat_added, isd, ied, jsd, jed)
! When modifying the code, comment out this error message. It is here
! so that the original (unmodified) version is not accidentally used.
call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // &
@@ -219,32 +176,14 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS)
end subroutine BFB_buoyancy_forcing
-subroutine alloc_if_needed(ptr, isd, ied, jsd, jed)
- ! If ptr is not associated, this routine allocates it with the given size
- ! and zeros out its contents. This is equivalent to safe_alloc_ptr in
- ! MOM_diag_mediator, but is here so as to be completely transparent.
- real, pointer :: ptr(:,:)
- integer :: isd, ied, jsd, jed
- if (.not.associated(ptr)) then
- allocate(ptr(isd:ied,jsd:jed))
- ptr(:,:) = 0.0
- endif
-end subroutine alloc_if_needed
-
+!> Initialization for forcing the boundary-forced-basin (BFB) configuration
subroutine BFB_surface_forcing_init(Time, G, param_file, diag, CS)
- type(time_type), intent(in) :: Time
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
- type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- type(diag_ctrl), target, intent(in) :: diag
- type(BFB_surface_forcing_CS), pointer :: CS
-! Arguments: Time - The current model time.
-! (in) G - The ocean's grid structure.
-! (in) param_file - A structure indicating the open file to parse for
-! model parameter values.
-! (in) diag - A structure that is used to regulate diagnostic output.
-! (in/out) CS - A pointer that is set to point to the control structure
-! for this module
-
+ type(time_type), intent(in) :: Time !< The current model time.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to
+ !! regulate diagnostic output.
+ type(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure for this module
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "BFB_surface_forcing" ! This module's name.
diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90
index 3b30e2ee31..7d282bffd5 100644
--- a/src/user/DOME2d_initialization.F90
+++ b/src/user/DOME2d_initialization.F90
@@ -1,3 +1,4 @@
+!> Initialization of the 2D DOME experiment with density water initialized on a coastal shelf.
module DOME2d_initialization
! This file is part of MOM6. See LICENSE.md for the license.
@@ -94,10 +95,10 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params
!! only read parameters without changing h.
! Local variables
- real :: e0(SZK_(GV)) ! The resting interface heights, in m, usually !
- ! negative because it is positive upward. !
- real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface !
- ! positive upward, in m. !
+ real :: e0(SZK_(GV)) ! The resting interface heights, in depth units (Z), usually
+ ! negative because it is positive upward.
+ real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface
+ ! positive upward, in depth units (Z).
integer :: i, j, k, is, ie, js, je, nz
real :: x
real :: delta_h
@@ -114,7 +115,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params
call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness")
call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, &
- default=1.e-3, do_not_log=.true.)
+ default=1.e-3, units="m", do_not_log=.true., scale=GV%m_to_Z)
call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, &
default=DEFAULT_COORDINATE_MODE, do_not_log=.true.)
call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, &
@@ -142,21 +143,21 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params
case ( REGRIDDING_LAYER, REGRIDDING_RHO )
do j=js,je ; do i=is,ie
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
eta1D(k) = e0(k)
- if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then
- eta1D(k) = eta1D(k+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom
+ if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then
+ eta1D(k) = eta1D(k+1) + GV%Angstrom_Z
+ h(i,j,k) = GV%Angstrom_H
else
- h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1))
+ h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1))
endif
enddo
x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon
if ( x <= dome2d_width_bay ) then
- h(i,j,1:nz-1) = GV%Angstrom
- h(i,j,nz) = GV%m_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom
+ h(i,j,1:nz-1) = GV%Angstrom_H
+ h(i,j,nz) = GV%Z_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H
endif
enddo ; enddo
@@ -164,21 +165,21 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params
! case ( IC_RHO_C )
!
! do j=js,je ; do i=is,ie
- ! eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ ! eta1D(nz+1) = -G%bathyT(i,j)
! do k=nz,1,-1
! eta1D(k) = e0(k)
! if (eta1D(k) < (eta1D(k+1) + min_thickness)) then
! eta1D(k) = eta1D(k+1) + min_thickness
- ! h(i,j,k) = GV%m_to_H * min_thickness
+ ! h(i,j,k) = GV%Z_to_H * min_thickness
! else
- ! h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1))
+ ! h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1))
! endif
! enddo
!
! x = G%geoLonT(i,j) / G%len_lon
! if ( x <= dome2d_width_bay ) then
- ! h(i,j,1:nz-1) = GV%m_to_H * min_thickness
- ! h(i,j,nz) = GV%m_to_H * (dome2d_depth_bay * G%max_depth - (nz-1) * min_thickness)
+ ! h(i,j,1:nz-1) = GV%Z_to_H * min_thickness
+ ! h(i,j,nz) = GV%Z_to_H * (dome2d_depth_bay * G%max_depth - (nz-1) * min_thickness)
! endif
!
! enddo ; enddo
@@ -186,22 +187,21 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params
case ( REGRIDDING_ZSTAR )
do j=js,je ; do i=is,ie
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
eta1D(k) = e0(k)
if (eta1D(k) < (eta1D(k+1) + min_thickness)) then
eta1D(k) = eta1D(k+1) + min_thickness
- h(i,j,k) = GV%m_to_H * min_thickness
+ h(i,j,k) = GV%Z_to_H * min_thickness
else
- h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1))
+ h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1))
endif
enddo
enddo ; enddo
case ( REGRIDDING_SIGMA )
do j=js,je ; do i=is,ie
- delta_h = G%bathyT(i,j) / nz
- h(i,j,:) = GV%m_to_H * delta_h
+ h(i,j,:) = GV%Z_to_H*G%bathyT(i,j) / nz
enddo ; enddo
case default
@@ -273,7 +273,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file,
do j=js,je ; do i=is,ie
xi0 = 0.0
do k = 1,nz
- xi1 = xi0 + (GV%H_to_m * h(i,j,k)) / G%max_depth
+ xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth
S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1)
xi0 = xi1
enddo
@@ -284,7 +284,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file,
do j=js,je ; do i=is,ie
xi0 = 0.0
do k = 1,nz
- xi1 = xi0 + (GV%H_to_m * h(i,j,k)) / G%max_depth
+ xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth
S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1)
xi0 = xi1
enddo
@@ -358,15 +358,16 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp)
real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp
real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt
real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO
- real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness
+ real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness, in m.
real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for thickness
real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1.
real :: S_ref, T_ref ! Reference salinity and temerature within surface layer
real :: S_range, T_range ! Range of salinities and temperatures over the vertical
- real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually !
- ! negative because it is positive upward. !
- real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface !
- ! positive upward, in m.
+ real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z),
+ ! usually negative because it is positive upward.
+ real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface
+ ! positive upward, in Z.
+ real :: d_eta(SZK_(G)) ! The layer thickness in a column, in Z.
real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay
real :: dome2d_west_sponge_time_scale, dome2d_east_sponge_time_scale
real :: dome2d_west_sponge_width, dome2d_east_sponge_width
@@ -443,14 +444,14 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp)
enddo
e0(nz+1) = -G%max_depth
do j=js,je ; do i=is,ie
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
eta1D(k) = e0(k)
- if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then
- eta1D(k) = eta1D(k+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom_z
+ if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then
+ eta1D(k) = eta1D(k+1) + GV%Angstrom_Z
+ h(i,j,k) = GV%Angstrom_H
else
- h(i,j,k) = eta1D(k) - eta1D(k+1)
+ h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1))
endif
enddo
enddo ; enddo
@@ -462,48 +463,48 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp)
do j=js,je ; do i=is,ie
z = -G%bathyT(i,j)
do k = nz,1,-1
- z = z + 0.5 * h(i,j,k) ! Position of the center of layer k
+ z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the center of layer k
S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth)
if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) &
S(i,j,k) = S_ref + S_range
- z = z + 0.5 * h(i,j,k) ! Position of the interface k
+ z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k
enddo
enddo ; enddo
if ( associated(tv%T) ) then
- call set_up_ALE_sponge_field(T,G,tv%T,ACSp)
+ call set_up_ALE_sponge_field(T, G, tv%T, ACSp)
endif
if ( associated(tv%S) ) then
- call set_up_ALE_sponge_field(S,G,tv%S,ACSp)
+ call set_up_ALE_sponge_field(S, G, tv%S, ACSp)
endif
else
- ! Construct thicknesses to restore to
+ ! Construct interface heights to restore toward
do j=js,je ; do i=is,ie
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
- eta1D(k) = -G%max_depth * real(k-1) / real(nz)
- if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then
- eta1D(k) = eta1D(k+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom_z
+ eta1D(K) = -G%max_depth * real(k-1) / real(nz)
+ if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then
+ eta1D(K) = eta1D(K+1) + GV%Angstrom_Z
+ d_eta(k) = GV%Angstrom_Z
else
- h(i,j,k) = eta1D(k) - eta1D(k+1)
+ d_eta(k) = (eta1D(K) - eta1D(K+1))
endif
enddo
x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon
if ( x <= dome2d_width_bay ) then
- h(i,j,1:nz-1) = GV%Angstrom
- h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom
+ do k=1,nz-1 ; d_eta(k) = GV%Angstrom_Z ; enddo
+ d_eta(nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_Z
endif
eta(i,j,nz+1) = -G%bathyT(i,j)
do K=nz,1,-1
- eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)
+ eta(i,j,K) = eta(i,j,K+1) + d_eta(k)
enddo
enddo ; enddo
- call initialize_sponge(Idamp, eta, G, param_file, CSp)
+ call initialize_sponge(Idamp, eta, G, param_file, CSp, GV)
endif
diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90
index 7d6d5644a9..4315420e9a 100644
--- a/src/user/DOME_initialization.F90
+++ b/src/user/DOME_initialization.F90
@@ -1,10 +1,12 @@
+!> Configures the model for the "DOME" experiment.
+!! DOME = Dynamics of Overflows and Mixing Experiment
module DOME_initialization
! This file is part of MOM6. See LICENSE.md for the license.
use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge
use MOM_dyn_horgrid, only : dyn_horgrid_type
-use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe
+use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_get_input, only : directories
use MOM_grid, only : ocean_grid_type
@@ -84,10 +86,10 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params)
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
- real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually !
- ! negative because it is positive upward. !
- real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface !
- ! positive upward, in m. !
+ real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually
+ ! negative because it is positive upward, in depth units (Z).
+ real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface
+ ! positive upward, in depth units (Z).
logical :: just_read ! If true, just read parameters but set nothing.
character(len=40) :: mdl = "DOME_initialize_thickness" ! This subroutine's name.
integer :: i, j, k, is, ie, js, je, nz
@@ -111,14 +113,14 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params)
! Angstrom thick, and 2. the interfaces are where they should be !
! based on the resting depths and interface height perturbations, !
! as long at this doesn't interfere with 1. !
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
eta1D(K) = e0(K)
- if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then
- eta1D(K) = eta1D(K+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom
+ if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then
+ eta1D(K) = eta1D(K+1) + GV%Angstrom_Z
+ h(i,j,k) = GV%Angstrom_H
else
- h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1))
+ h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1))
endif
enddo
enddo ; enddo
@@ -136,8 +138,8 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp)
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(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available
- !! thermodynamic fields, including potential temperature and
- !! salinity or mixed layer density. Absent fields have NULL ptrs.
+ !! thermodynamic fields, including potential temperature and
+ !! salinity or mixed layer density. Absent fields have NULL ptrs.
type(param_file_type), intent(in) :: PF !< A structure indicating the open file to
!! parse for model parameter values.
type(sponge_CS), pointer :: CSp !< A pointer that is set to point to the control
@@ -147,7 +149,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp)
real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. !
real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1.
- real :: H0(SZK_(G))
+ real :: H0(SZK_(G)) ! Interface heights in depth units (Z)
real :: min_depth
real :: damp, e_dense, damp_new
character(len=40) :: mdl = "DOME_initialize_sponges" ! This subroutine's name.
@@ -165,10 +167,10 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp)
! Set up sponges for DOME configuration
call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, &
- "The minimum depth of the ocean.", units="m", default=0.0)
+ "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z)
H0(1) = 0.0
- do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth/real(nz-1) ; enddo
+ do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth / real(nz-1) ; enddo
do i=is,ie; do j=js,je
if (G%geoLonT(i,j) < 100.0) then ; damp = 10.0
elseif (G%geoLonT(i,j) < 200.0) then
@@ -188,12 +190,12 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp)
! depth space for Boussinesq or non-Boussinesq models.
eta(i,j,1) = 0.0
do k=2,nz
-! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j))
+! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j))
e_dense = -G%bathyT(i,j)
if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense
else ; eta(i,j,K) = H0(k) ; endif
- if (eta(i,j,K) < GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j)) &
- eta(i,j,K) = GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j)
+ if (eta(i,j,K) < GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j)) &
+ eta(i,j,K) = GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j)
enddo
eta(i,j,nz+1) = -G%bathyT(i,j)
@@ -204,7 +206,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp)
! This call sets up the damping rates and interface heights.
! This sets the inverse damping timescale fields in the sponges. !
- call initialize_sponge(Idamp, eta, G, PF, CSp)
+ call initialize_sponge(Idamp, eta, G, PF, CSp, GV)
! Now register all of the fields which are damped in the sponge. !
! By default, momentum is advected vertically within the sponge, but !
@@ -250,9 +252,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg)
real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3.
! The following variables are used to set up the transport in the DOME example.
real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1
- real :: D_edge ! The thickness in m of the dense fluid at the
+ real :: D_edge ! The thickness in Z of the dense fluid at the
! inner edge of the inflow.
- real :: g_prime_tot ! The reduced gravity across all layers, m s-2.
+ real :: g_prime_tot ! The reduced gravity across all layers, m2 Z-1 s-2.
real :: Def_Rad ! The deformation radius, based on fluid of
! thickness D_edge, in the same units as lat.
real :: Ri_trans ! The shear Richardson number in the transition
@@ -261,15 +263,15 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg)
character(len=32) :: name
integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, nz, NTR
integer :: IsdB, IedB, JsdB, JedB
- type(OBC_segment_type), pointer :: segment
- type(tracer_type), pointer :: tr_ptr
+ type(OBC_segment_type), pointer :: segment => NULL()
+ type(tracer_type), pointer :: tr_ptr => NULL()
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
! The following variables should be transformed into runtime parameters.
- D_edge = 300.0 ! The thickness of dense fluid in the inflow.
+ D_edge = 300.0*GV%m_to_Z ! The thickness of dense fluid in the inflow.
Ri_trans = 1.0/3.0 ! The shear Richardson number in the transition region
! region of the specified shear profile.
@@ -277,10 +279,10 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg)
g_prime_tot = (GV%g_Earth/GV%Rho0)*2.0
Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0)
- tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%m_to_H
+ tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%Z_to_H
if (OBC%number_of_segments /= 1) then
- print *, 'Error in DOME OBC segment setup'
+ call MOM_error(WARNING, 'Error in DOME OBC segment setup', .true.)
return !!! Need a better error message here
endif
segment => OBC%segment(1)
@@ -375,8 +377,4 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg)
end subroutine DOME_set_OBC_data
-!> \namespace dome_initialization
-!!
-!! The module configures the model for the "DOME" experiment.
-!! DOME = Dynamics of Overflows and Mixing Experiment
end module DOME_initialization
diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90
index 34ef50b8cb..621c5046dd 100644
--- a/src/user/ISOMIP_initialization.F90
+++ b/src/user/ISOMIP_initialization.F90
@@ -1,3 +1,4 @@
+!> Configures the ISOMIP test case.
module ISOMIP_initialization
! This file is part of MOM6. See LICENSE.md for the license.
@@ -23,39 +24,26 @@ module ISOMIP_initialization
#include
-! -----------------------------------------------------------------------------
-! Private (module-wise) parameters
-! -----------------------------------------------------------------------------
+character(len=40) :: mdl = "ISOMIP_initialization" !< This module's name.
-character(len=40) :: mdl = "ISOMIP_initialization" ! This module's name.
-
-! -----------------------------------------------------------------------------
! The following routines are visible to the outside world
-! -----------------------------------------------------------------------------
public ISOMIP_initialize_topography
public ISOMIP_initialize_thickness
public ISOMIP_initialize_temperature_salinity
public ISOMIP_initialize_sponges
-! -----------------------------------------------------------------------------
-! This module contains the following routines
-! -----------------------------------------------------------------------------
contains
-!> Initialization of topography
+!> Initialization of topography for the ISOMIP configuration
subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth)
type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type
real, dimension(G%isd:G%ied,G%jsd:G%jed), &
intent(out) :: D !< Ocean bottom depth in m
type(param_file_type), intent(in) :: param_file !< Parameter file structure
real, intent(in) :: max_depth !< Maximum depth of model in m
-
-! This subroutine sets up the ISOMIP topography
+ ! Local variables
real :: min_depth ! The minimum and maximum depths in m.
-
-! The following variables are used to set up the bathymetry in the ISOMIP example.
-! check this paper: http://www.geosci-model-dev-discuss.net/8/9859/2015/gmdd-8-9859-2015.pdf
-
+ ! The following variables are used to set up the bathymetry in the ISOMIP example.
real :: bmax ! max depth of bedrock topography
real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeff
real :: xbar ! characteristic along-flow lenght scale of the bedrock
@@ -65,9 +53,6 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth)
real :: ly ! domain width (across ice flow)
real :: bx, by, xtil ! dummy vatiables
logical :: is_2D ! If true, use 2D setup
-
-! G%ieg and G%jeg are the last indices in the global domain
-
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "ISOMIP_initialize_topography" ! This subroutine's name.
@@ -75,7 +60,6 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth)
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
-
call MOM_mesg(" ISOMIP_initialization.F90, ISOMIP_initialize_topography: setting topography", 5)
call log_version(param_file, mdl, version, "")
@@ -83,7 +67,7 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth)
"The minimum depth of the ocean.", units="m", default=0.0)
call get_param(param_file, mdl, "ISOMIP_2D",is_2D,'If true, use a 2D setup.', default=.false.)
-! The following variables should be transformed into runtime parameters?
+ ! The following variables should be transformed into runtime parameters?
bmax=720.0; b0=-150.0; b2=-728.8; b4=343.91; b6=-50.57
xbar=300.0E3; dc=500.0; fc=4.0E3; wc=24.0E3; ly=80.0E3
bx = 0.0; by = 0.0; xtil = 0.0
@@ -131,7 +115,6 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth)
endif
end subroutine ISOMIP_initialize_topography
-! -----------------------------------------------------------------------------
!> Initialization of thicknesses
subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_params)
@@ -146,17 +129,17 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par
!! the eqn. of state.
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing h.
-
! Local variables
- real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually !
- ! negative because it is positive upward. !
- real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface !
- ! positive upward, in m. !
+ real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z),
+ ! usually negative because it is positive upward.
+ real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface
+ ! positive upward, in depth units (Z).
integer :: i, j, k, is, ie, js, je, nz, tmp1
real :: x
- real :: delta_h, rho_range
+ real :: rho_range
real :: min_thickness, s_sur, s_bot, t_sur, t_bot, rho_sur, rho_bot
logical :: just_read ! If true, just read parameters but set nothing.
+ character(len=256) :: mesg ! The text of an error message
character(len=40) :: verticalCoordinate
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
@@ -166,8 +149,8 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par
if (.not.just_read) &
call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness")
- call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, &
- 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read)
+ call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, &
+ 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read, scale=GV%m_to_Z)
call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, &
default=DEFAULT_COORDINATE_MODE, do_not_log=just_read)
@@ -186,12 +169,15 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par
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)
- !write (*,*)'Surface density is:', rho_sur
- call calculate_density(t_bot,s_bot,0.0,rho_bot,tv%eqn_of_state)
- !write (*,*)'Bottom density is:', rho_bot
+ call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state)
+ ! write(mesg,*) 'Surface density is:', rho_sur
+ ! call MOM_mesg(mesg,5)
+ call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state)
+ ! write(mesg,*) 'Bottom density is:', rho_bot
+ ! call MOM_mesg(mesg,5)
rho_range = rho_bot - rho_sur
- !write (*,*)'Density range is:', rho_range
+ ! write(mesg,*) 'Density range is:', rho_range
+ ! call MOM_mesg(mesg,5)
! Construct notional interface positions
e0(1) = 0.
@@ -199,21 +185,21 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par
e0(k) = -G%max_depth * ( 0.5 * ( GV%Rlay(k-1) + GV%Rlay(k) ) - rho_sur ) / rho_range
e0(k) = min( 0., e0(k) ) ! Bound by surface
e0(k) = max( -G%max_depth, e0(k) ) ! Bound by possible deepest point in model
- !write(*,*)'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)
-
+ ! write(mesg,*) 'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)
+ ! call MOM_mesg(mesg,5)
enddo
e0(nz+1) = -G%max_depth
! Calculate thicknesses
do j=js,je ; do i=is,ie
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
eta1D(k) = e0(k)
- if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then
- eta1D(k) = eta1D(k+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom
+ if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then
+ eta1D(k) = eta1D(k+1) + GV%Angstrom_Z
+ h(i,j,k) = GV%Angstrom_H
else
- h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1))
+ h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1))
endif
enddo
enddo ; enddo
@@ -221,14 +207,14 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par
case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates
if (just_read) return ! All run-time parameters have been read, so return.
do j=js,je ; do i=is,ie
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
eta1D(k) = -G%max_depth * real(k-1) / real(nz)
if (eta1D(k) < (eta1D(k+1) + min_thickness)) then
eta1D(k) = eta1D(k+1) + min_thickness
- h(i,j,k) = GV%m_to_H * min_thickness
+ h(i,j,k) = GV%Z_to_H * min_thickness
else
- h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1))
+ h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1))
endif
enddo
enddo ; enddo
@@ -236,8 +222,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par
case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates
if (just_read) return ! All run-time parameters have been read, so return.
do j=js,je ; do i=is,ie
- delta_h = G%bathyT(i,j) / dfloat(nz)
- h(i,j,:) = GV%m_to_H * delta_h
+ h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz)
enddo ; enddo
case default
@@ -260,12 +245,14 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file,
type(EOS_type), pointer :: eqn_of_state !< Equation of state structure
logical, optional, intent(in) :: just_read_params !< If present and true, this call will
!! only read parameters without changing T & S.
-
! Local variables
integer :: i, j, k, is, ie, js, je, nz, itt
real :: x, ds, dt, rho_sur, rho_bot
- real :: xi0, xi1, dxi, r, S_sur, T_sur, S_bot, T_bot, S_range, T_range
+ real :: xi0, xi1 ! Heights in depth units (Z).
+ real :: S_sur, T_sur, S_bot, T_bot
+ real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z.
real :: z ! vertical position in z space
+ character(len=256) :: mesg ! The text of an error message
character(len=40) :: verticalCoordinate, density_profile
real :: rho_tmp
logical :: just_read ! If true, just read parameters but set nothing.
@@ -293,109 +280,107 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file,
'Salinity at the bottom (interface)', default=34.55, do_not_log=just_read)
call calculate_density(t_sur,s_sur,0.0,rho_sur,eqn_of_state)
- !write (*,*)'Density in the surface layer:', rho_sur
+ ! 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)
- !write (*,*)'Density in the bottom layer::', rho_bot
+ ! write(mesg,*) 'Density in the bottom layer::', rho_bot
+ ! call MOM_mesg(mesg,5)
select case ( coordinateMode(verticalCoordinate) )
case ( REGRIDDING_RHO, REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_SIGMA )
if (just_read) return ! All run-time parameters have been read, so return.
- S_range = s_sur - s_bot
- T_range = t_sur - t_bot
- !write(*,*)'S_range,T_range',S_range,T_range
-
- S_range = S_range / G%max_depth ! Convert S_range into dS/dz
- T_range = T_range / G%max_depth ! Convert T_range into dT/dz
+ dS_dz = (s_sur - s_bot) / G%max_depth
+ dT_dz = (t_sur - t_bot) / G%max_depth
do j=js,je ; do i=is,ie
xi0 = -G%bathyT(i,j)
do k = nz,1,-1
- xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m ! Depth in middle of layer
- S(i,j,k) = S_sur + S_range * xi0
- T(i,j,k) = T_sur + T_range * xi0
- xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m ! Depth at top of layer
+ xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer
+ S(i,j,k) = S_sur + dS_dz * xi0
+ T(i,j,k) = T_sur + dT_dz * xi0
+ xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth at top of layer
enddo
enddo ; enddo
case ( REGRIDDING_LAYER )
- call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, &
- "If true, accept the prescribed temperature and fit the \n"//&
- "salinity; otherwise take salinity and fit temperature.", &
- default=.false., do_not_log=just_read)
- call get_param(param_file, mdl, "DRHO_DS", drho_dS1, &
- "Partial derivative of density with salinity.", &
- units="kg m-3 PSU-1", fail_if_missing=.not.just_read, do_not_log=just_read)
- call get_param(param_file, mdl, "DRHO_DT", drho_dT1, &
- "Partial derivative of density with temperature.", &
- units="kg m-3 K-1", fail_if_missing=.not.just_read, do_not_log=just_read)
- call get_param(param_file, mdl, "T_REF", T_Ref, &
- "A reference temperature used in initialization.", &
- units="degC", fail_if_missing=.not.just_read, do_not_log=just_read)
- call get_param(param_file, mdl, "S_REF", S_Ref, &
- "A reference salinity used in initialization.", units="PSU", &
- default=35.0, do_not_log=just_read)
- if (just_read) return ! All run-time parameters have been read, so return.
-
- !write(*,*)'read drho_dS, drho_dT', drho_dS1, drho_dT1
-
- S_range = s_bot - s_sur
- T_range = t_bot - t_sur
- !write(*,*)'S_range,T_range',S_range,T_range
- S_range = S_range / G%max_depth ! Convert S_range into dS/dz
- T_range = T_range / G%max_depth ! Convert T_range into dT/dz
-
- do j=js,je ; do i=is,ie
- xi0 = 0.0
- do k = 1,nz
- !T0(k) = T_Ref; S0(k) = S_Ref
- xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m
- S0(k) = S_sur + S_range * xi1
- T0(k) = T_sur + T_range * xi1
- xi0 = xi0 + h(i,j,k) * GV%H_to_m
- !write(*,*)'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k
- enddo
+ call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, &
+ "If true, accept the prescribed temperature and fit the \n"//&
+ "salinity; otherwise take salinity and fit temperature.", &
+ default=.false., do_not_log=just_read)
+ call get_param(param_file, mdl, "DRHO_DS", drho_dS1, &
+ "Partial derivative of density with salinity.", &
+ units="kg m-3 PSU-1", fail_if_missing=.not.just_read, do_not_log=just_read)
+ call get_param(param_file, mdl, "DRHO_DT", drho_dT1, &
+ "Partial derivative of density with temperature.", &
+ units="kg m-3 K-1", fail_if_missing=.not.just_read, do_not_log=just_read)
+ call get_param(param_file, mdl, "T_REF", T_Ref, &
+ "A reference temperature used in initialization.", &
+ units="degC", fail_if_missing=.not.just_read, do_not_log=just_read)
+ call get_param(param_file, mdl, "S_REF", S_Ref, &
+ "A reference salinity used in initialization.", units="PSU", &
+ default=35.0, do_not_log=just_read)
+ if (just_read) return ! All run-time parameters have been read, so return.
- call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state)
- !write(*,*)'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1)
- call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state)
+ ! write(mesg,*) 'read drho_dS, drho_dT', drho_dS1, drho_dT1
+ ! call MOM_mesg(mesg,5)
- if (fit_salin) then
- ! A first guess of the layers' salinity.
- do k=nz,1,-1
- S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS1)
- enddo
- ! Refine the guesses for each layer.
- do itt=1,6
- 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
- enddo
+ dS_dz = (s_sur - s_bot) / G%max_depth
+ dT_dz = (t_sur - t_bot) / G%max_depth
- else
- ! A first guess of the layers' temperatures.
- do k=nz,1,-1
- T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT1
- enddo
+ do j=js,je ; do i=is,ie
+ xi0 = 0.0
+ do k = 1,nz
+ !T0(k) = T_Ref; S0(k) = S_Ref
+ xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z
+ S0(k) = S_sur - dS_dz * xi1
+ T0(k) = T_sur - dT_dz * xi1
+ xi0 = xi0 + h(i,j,k) * GV%H_to_Z
+ ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k
+ ! call MOM_mesg(mesg,5)
+ enddo
- do itt=1,6
- 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
- enddo
- endif
+ 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),0.,rho_guess(1),eqn_of_state)
+
+ if (fit_salin) then
+ ! A first guess of the layers' salinity.
+ do k=nz,1,-1
+ S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS1)
+ enddo
+ ! Refine the guesses for each layer.
+ do itt=1,6
+ 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
+ enddo
- do k=1,nz
- T(i,j,k) = T0(k) ; S(i,j,k) = S0(k)
- enddo
+ else
+ ! A first guess of the layers' temperatures.
+ do k=nz,1,-1
+ T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT1
+ enddo
+
+ do itt=1,6
+ 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
+ enddo
+ endif
- enddo ; enddo
+ do k=1,nz
+ T(i,j,k) = T0(k) ; S(i,j,k) = S0(k)
+ enddo
+
+ enddo ; enddo
- case default
+ case default
call MOM_error(FATAL,"isomip_initialize: "// &
"Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE")
@@ -404,8 +389,9 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file,
! for debugging
!i=G%iec; j=G%jec
!do k = 1,nz
- ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,eqn_of_state)
- ! write(*,*) 'k,h,T,S,rho,Rlay',k,h(i,j,k),T(i,j,k),S(i,j,k),rho_tmp,GV%Rlay(k)
+ ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,eqn_of_state)
+ ! write(mesg,*) 'k,h,T,S,rho,Rlay',k,h(i,j,k),T(i,j,k),S(i,j,k),rho_tmp,GV%Rlay(k)
+ ! call MOM_mesg(mesg,5)
!enddo
end subroutine ISOMIP_initialize_temperature_salinity
@@ -427,26 +413,24 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp)
logical, intent(in) :: use_ALE !< If true, indicates model is in ALE mode
type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure
type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure
-
-! Local variables
+ ! Local variables
real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp
real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt
real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO
real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness
real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1.
real :: TNUDG ! Nudging time scale, days
- real :: S_sur, T_sur; ! Surface salinity and temerature in sponge
- real :: S_bot, T_bot; ! Bottom salinity and temerature in sponge
- real :: t_ref, s_ref ! reference T and S
- real :: rho_sur, rho_bot, rho_range, t_range, s_range
-
- real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually !
- ! negative because it is positive upward. !
- real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface !
- real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta.
-
- ! positive upward, in m.
- real :: min_depth, dummy1, z, delta_h
+ real :: S_sur, T_sur ! Surface salinity and temerature in sponge
+ real :: S_bot, T_bot ! Bottom salinity and temerature in sponge
+ real :: t_ref, s_ref ! reference T and S
+ real :: rho_sur, rho_bot, rho_range
+ real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z.
+
+ real :: e0(SZK_(G)+1) ! The resting interface heights, in Z, usually
+ ! negative because it is positive upward.
+ real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward, in Z.
+ real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in Z.
+ real :: min_depth, dummy1, z
real :: damp, rho_dummy, min_thickness, rho_tmp, xi0
character(len=40) :: verticalCoordinate, filename, state_file
character(len=40) :: temp_var, salt_var, eta_var, inputdir
@@ -458,6 +442,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp)
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
call get_param(PF, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3)
+ min_thickness = GV%m_to_Z * min_thickness
call get_param(PF, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, &
default=DEFAULT_COORDINATE_MODE)
@@ -470,57 +455,57 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp)
call get_param(PF, mdl, "S_REF", s_ref, 'Reference salinity', default=35.0,&
do_not_log=.true.)
- call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref)
+ call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref)
- call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref)
+ call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref)
- call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref)
+ call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref)
- call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref)
+ call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref)
T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; RHO(:,:,:) = 0.0
- S_range = s_sur - s_bot
- T_range = t_sur - t_bot
! Set up sponges for ISOMIP configuration
call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, &
- "The minimum depth of the ocean.", units="m", default=0.0)
+ "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z)
- if (associated(CSp)) call MOM_error(FATAL, &
- "ISOMIP_initialize_sponges called with an associated control structure.")
- if (associated(ACSp)) call MOM_error(FATAL, &
- "ISOMIP_initialize_sponges called with an associated ALE-sponge control structure.")
+ if (associated(CSp)) call MOM_error(FATAL, &
+ "ISOMIP_initialize_sponges called with an associated control structure.")
+ if (associated(ACSp)) call MOM_error(FATAL, &
+ "ISOMIP_initialize_sponges called with an associated ALE-sponge control structure.")
! Here the inverse damping time, in s-1, is set. Set Idamp to 0 !
! wherever there is no sponge, and the subroutines that are called !
! will automatically set up the sponges only where Idamp is positive!
! and mask2dT is 1.
- do i=is,ie; do j=js,je
- if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then
+ do i=is,ie; do j=js,je
+ if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then
! 1 / day
- dummy1=(G%geoLonT(i,j)-790.0)/(800.0-790.0)
- damp = 1.0/TNUDG * max(0.0,dummy1)
+ dummy1=(G%geoLonT(i,j)-790.0)/(800.0-790.0)
+ damp = 1.0/TNUDG * max(0.0,dummy1)
- else ; damp=0.0
- endif
+ else ; damp=0.0
+ endif
! convert to 1 / seconds
- if (G%bathyT(i,j) > min_depth) then
- Idamp(i,j) = damp/86400.0
- else ; Idamp(i,j) = 0.0 ; endif
-
+ if (G%bathyT(i,j) > min_depth) then
+ Idamp(i,j) = damp/86400.0
+ else ; Idamp(i,j) = 0.0 ; endif
- enddo ; enddo
+ 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)
- !write (*,*)'Surface density in sponge:', rho_sur
- call calculate_density(t_bot,s_bot,0.0,rho_bot,tv%eqn_of_state)
- !write (*,*)'Bottom density in sponge:', rho_bot
+ call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state)
+ !write (mesg,*) 'Surface density in sponge:', rho_sur
+ ! call MOM_mesg(mesg,5)
+ call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state)
+ !write (mesg,*) 'Bottom density in sponge:', rho_bot
+ ! call MOM_mesg(mesg,5)
rho_range = rho_bot - rho_sur
- !write (*,*)'Density range in sponge:', rho_range
+ !write (mesg,*) 'Density range in sponge:', rho_range
+ ! call MOM_mesg(mesg,5)
if (use_ALE) then
@@ -533,70 +518,71 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp)
e0(k) = -G%max_depth * ( 0.5 * ( GV%Rlay(k-1) + GV%Rlay(k) ) - rho_sur ) / rho_range
e0(k) = min( 0., e0(k) ) ! Bound by surface
e0(k) = max( -G%max_depth, e0(k) ) ! Bound by possible deepest point in model
- !write(*,*)'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)
-
+ ! write(mesg,*) 'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)
+ ! call MOM_mesg(mesg,5)
enddo
e0(nz+1) = -G%max_depth
! Calculate thicknesses
do j=js,je ; do i=is,ie
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
eta1D(k) = e0(k)
- if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then
- eta1D(k) = eta1D(k+1) + GV%Angstrom_z
- h(i,j,k) = GV%Angstrom_z
+ if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then
+ eta1D(k) = eta1D(k+1) + GV%Angstrom_Z
+ h(i,j,k) = GV%Angstrom_H
else
- h(i,j,k) = eta1D(k) - eta1D(k+1)
+ h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1))
endif
enddo
enddo ; enddo
case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates
do j=js,je ; do i=is,ie
- eta1D(nz+1) = -1.0*G%bathyT(i,j)
+ eta1D(nz+1) = -G%bathyT(i,j)
do k=nz,1,-1
eta1D(k) = -G%max_depth * real(k-1) / real(nz)
if (eta1D(k) < (eta1D(k+1) + min_thickness)) then
eta1D(k) = eta1D(k+1) + min_thickness
- h(i,j,k) = min_thickness
+ h(i,j,k) = min_thickness * GV%Z_to_H
else
- h(i,j,k) = eta1D(k) - eta1D(k+1)
+ h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1))
endif
enddo
enddo ; enddo
case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates
- do j=js,je ; do i=is,ie
- delta_h = G%bathyT(i,j) / dfloat(nz)
- h(i,j,:) = delta_h
- enddo ; enddo
+ do j=js,je ; do i=is,ie
+ h(i,j,:) = GV%Z_to_H * (G%bathyT(i,j) / dfloat(nz))
+ enddo ; enddo
case default
call MOM_error(FATAL,"ISOMIP_initialize_sponges: "// &
"Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE")
end select
+
! This call sets up the damping rates and interface heights.
! This sets the inverse damping timescale fields in the sponges.
call initialize_ALE_sponge(Idamp, G, PF, ACSp, h, nz)
- S_range = S_range / G%max_depth ! Convert S_range into dS/dz
- T_range = T_range / G%max_depth ! Convert T_range into dT/dz
+ dS_dz = (s_sur - s_bot) / G%max_depth
+ dT_dz = (t_sur - t_bot) / G%max_depth
do j=js,je ; do i=is,ie
xi0 = -G%bathyT(i,j)
do k = nz,1,-1
- xi0 = xi0 + 0.5 * h(i,j,k) ! Depth in middle of layer
- S(i,j,k) = S_sur + S_range * xi0
- T(i,j,k) = T_sur + T_range * xi0
- xi0 = xi0 + 0.5 * h(i,j,k) ! Depth at top of layer
+ xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer
+ S(i,j,k) = S_sur + dS_dz * xi0
+ T(i,j,k) = T_sur + dT_dz * xi0
+ xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth at top of layer
enddo
enddo ; enddo
! for debugging
!i=G%iec; j=G%jec
!do k = 1,nz
! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state)
- ! write(*,*) 'Sponge - k,h,T,S,rho,Rlay',k,h(i,j,k),T(i,j,k),S(i,j,k),rho_tmp,GV%Rlay(k)
+ ! write(mesg,*) 'Sponge - k,h,T,S,rho,Rlay',k,h(i,j,k),T(i,j,k),S(i,j,k),rho_tmp,GV%Rlay(k)
+ ! call MOM_mesg(mesg,5)
!enddo
! Now register all of the fields which are damped in the sponge. !
@@ -605,56 +591,57 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp)
! The remaining calls to set_up_sponge_field can be in any order. !
if ( associated(tv%T) ) then
- call set_up_ALE_sponge_field(T,G,tv%T,ACSp)
+ call set_up_ALE_sponge_field(T, G, tv%T, ACSp)
endif
if ( associated(tv%S) ) then
- call set_up_ALE_sponge_field(S,G,tv%S,ACSp)
+ call set_up_ALE_sponge_field(S, G, tv%S, ACSp)
endif
else ! layer mode
- ! 1) Read eta, salt and temp from IC file
- call get_param(PF, mdl, "INPUTDIR", inputdir, default=".")
- inputdir = slasher(inputdir)
- ! GM: get two different files, one with temp and one with salt values
- ! this is work around to avoid having wrong values near the surface
- ! because of the FIT_SALINITY option. To get salt values right in the
- ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can
- ! combined the *correct* temp and salt values in one file instead.
- call get_param(PF, mdl, "ISOMIP_SPONGE_FILE", state_file, &
- "The name of the file with temps., salts. and interfaces to \n"// &
- " damp toward.", fail_if_missing=.true.)
- call get_param(PF, mdl, "SPONGE_PTEMP_VAR", temp_var, &
- "The name of the potential temperature variable in \n"//&
- "SPONGE_STATE_FILE.", default="Temp")
- call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, &
- "The name of the salinity variable in \n"//&
- "SPONGE_STATE_FILE.", default="Salt")
- call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, &
- "The name of the interface height variable in \n"//&
- "SPONGE_STATE_FILE.", default="eta")
-
- !read temp and eta
- filename = trim(inputdir)//trim(state_file)
- if (.not.file_exists(filename, G%Domain)) &
- call MOM_error(FATAL, " ISOMIP_initialize_sponges: Unable to open "//trim(filename))
- call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain)
- call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain)
- call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain)
-
- ! for debugging
- !i=G%iec; j=G%jec
- !do k = 1,nz
- ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state)
- ! write(*,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),&
- ! S(i,j,k),rho_tmp,GV%Rlay(k)
- !enddo
-
- ! Set the inverse damping rates so that the model will know where to
- ! apply the sponges, along with the interface heights.
- call initialize_sponge(Idamp, eta, G, PF, CSp)
- ! Apply sponge in tracer fields
- call set_up_sponge_field(T, tv%T, G, nz, CSp)
- call set_up_sponge_field(S, tv%S, G, nz, CSp)
+ ! 1) Read eta, salt and temp from IC file
+ call get_param(PF, mdl, "INPUTDIR", inputdir, default=".")
+ inputdir = slasher(inputdir)
+ ! GM: get two different files, one with temp and one with salt values
+ ! this is work around to avoid having wrong values near the surface
+ ! because of the FIT_SALINITY option. To get salt values right in the
+ ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can
+ ! combined the *correct* temp and salt values in one file instead.
+ call get_param(PF, mdl, "ISOMIP_SPONGE_FILE", state_file, &
+ "The name of the file with temps., salts. and interfaces to \n"// &
+ "damp toward.", fail_if_missing=.true.)
+ call get_param(PF, mdl, "SPONGE_PTEMP_VAR", temp_var, &
+ "The name of the potential temperature variable in \n"//&
+ "SPONGE_STATE_FILE.", default="Temp")
+ call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, &
+ "The name of the salinity variable in \n"//&
+ "SPONGE_STATE_FILE.", default="Salt")
+ call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, &
+ "The name of the interface height variable in \n"//&
+ "SPONGE_STATE_FILE.", default="eta")
+
+ !read temp and eta
+ filename = trim(inputdir)//trim(state_file)
+ if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, &
+ "ISOMIP_initialize_sponges: Unable to open "//trim(filename))
+ call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z)
+ call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain)
+ call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain)
+
+ ! for debugging
+ !i=G%iec; j=G%jec
+ !do k = 1,nz
+ ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state)
+ ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),&
+ ! S(i,j,k),rho_tmp,GV%Rlay(k)
+ ! call MOM_mesg(mesg,5)
+ !enddo
+
+ ! Set the inverse damping rates so that the model will know where to
+ ! apply the sponges, along with the interface heights.
+ call initialize_sponge(Idamp, eta, G, PF, CSp, GV)
+ ! Apply sponge in tracer fields
+ call set_up_sponge_field(T, tv%T, G, nz, CSp)
+ call set_up_sponge_field(S, tv%S, G, nz, CSp)
endif
@@ -662,5 +649,5 @@ end subroutine ISOMIP_initialize_sponges
!> \namespace isomip_initialization
!!
-!! The module configures the ISOMIP test case.
+!! See this paper for details: http://www.geosci-model-dev-discuss.net/8/9859/2015/gmdd-8-9859-2015.pdf
end module ISOMIP_initialization
diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90
index 63d61bea35..8315833391 100644
--- a/src/user/Kelvin_initialization.F90
+++ b/src/user/Kelvin_initialization.F90
@@ -1,3 +1,8 @@
+!> Configures the model for the Kelvin wave experiment.
+!!
+!! Kelvin = coastally-trapped Kelvin waves from the ROMS examples.
+!! Initialize with level surfaces and drive the wave in at the west,
+!! radiate out at the east.
module Kelvin_initialization
! This file is part of MOM6. See LICENSE.md for the license.
@@ -12,7 +17,7 @@ module Kelvin_initialization
use MOM_open_boundary, only : OBC_DIRECTION_S, OBC_DIRECTION_W
use MOM_open_boundary, only : OBC_registry_type
use MOM_verticalGrid, only : verticalGrid_type
-use MOM_time_manager, only : time_type, set_time, time_type_to_real
+use MOM_time_manager, only : time_type, time_type_to_real
implicit none ; private
@@ -171,7 +176,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time)
integer :: IsdB, IedB, JsdB, JedB
real :: fac, x, y, x1, y1
real :: val1, val2, sina, cosa
- type(OBC_segment_type), pointer :: segment
+ type(OBC_segment_type), pointer :: segment => NULL()
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -218,12 +223,13 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time)
x = (x1 - CS%coast_offset1) * cosa + y1 * sina
y = - (x1 - CS%coast_offset1) * sina + y1 * cosa
if (CS%mode == 0) then
- cff = sqrt(G%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))
+ cff = sqrt(G%g_Earth * 0.5 * G%Zd_to_m * (G%bathyT(i+1,j) + G%bathyT(i,j)))
val2 = fac * exp(- CS%F_0 * y / cff)
segment%eta(I,j) = val2 * cos(CS%omega * time_sec)
segment%normal_vel_bt(I,j) = val1 * cff * cosa / &
- (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2
+ (0.5 * G%Zd_to_m * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2
else
+ ! Not rotated yet
segment%eta(I,j) = 0.0
segment%normal_vel_bt(I,j) = 0.0
if (segment%nudged) then
@@ -243,10 +249,27 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time)
endif
endif
enddo ; enddo
-! if (allocated(segment%tangential_vel)) then
-! do J=JsdB,JedB ; do I=IsdB,IedB
-! enddo ; enddo
-! endif
+ if (associated(segment%tangential_vel)) then
+ do J=JsdB+1,JedB-1 ; do I=IsdB,IedB
+ x1 = 1000. * G%geoLonBu(I,J)
+ y1 = 1000. * G%geoLatBu(I,J)
+ x = (x1 - CS%coast_offset1) * cosa + y1 * sina
+ y = - (x1 - CS%coast_offset1) * sina + y1 * cosa
+ !### Problem: val2 & cff could be a functions of space, but are not set in this loop.
+ !### Problem: Is val2 in the numerator or denominator below?
+ if (CS%mode == 0) then
+ do k=1,nz
+ segment%tangential_vel(I,J,k) = val1 * cff * sina / &
+ (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + &
+ G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2
+!### For rotational symmetry, this should be:
+! segment%tangential_vel(I,J,k) = val1 * cff * sina / &
+! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +&
+! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2
+ enddo
+ endif
+ enddo ; enddo
+ endif
else
isd = segment%HI%isd ; ied = segment%HI%ied
JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB
@@ -256,12 +279,13 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time)
x = (x1 - CS%coast_offset1) * cosa + y1 * sina
y = - (x1 - CS%coast_offset1) * sina + y1 * cosa
if (CS%mode == 0) then
- cff = sqrt(G%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j)))
+ cff = sqrt(G%g_Earth * 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)))
val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff)
segment%eta(I,j) = val2 * cos(CS%omega * time_sec)
- segment%normal_vel_bt(I,j) = val1 * cff * sina / &
- (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2
+ segment%normal_vel_bt(I,j) = val1 * cff * sina / &
+ (0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) * val2
else
+ ! Not rotated yet
segment%eta(i,J) = 0.0
segment%normal_vel_bt(i,J) = 0.0
if (segment%nudged) then
@@ -279,15 +303,30 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time)
endif
endif
enddo ; enddo
+ if (associated(segment%tangential_vel)) then
+ do J=JsdB,JedB ; do I=IsdB+1,IedB-1
+ x1 = 1000. * G%geoLonBu(I,J)
+ y1 = 1000. * G%geoLatBu(I,J)
+ x = (x1 - CS%coast_offset1) * cosa + y1 * sina
+ y = - (x1 - CS%coast_offset1) * sina + y1 * cosa
+ !### Problem: val2 & cff could be a functions of space, but are not set in this loop.
+ !### Problem: Is val2 in the numerator or denominator below?
+ if (CS%mode == 0) then
+ do k=1,nz
+ segment%tangential_vel(I,J,k) = val1 * cff * sina / &
+ (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + &
+ G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2
+!### This should be:
+! segment%tangential_vel(I,J,k) = val1 * cff * sina / &
+! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +&
+! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2
+ enddo
+ endif
+ enddo ; enddo
+ endif
endif
enddo
end subroutine Kelvin_set_OBC_data
-!> \class Kelvin_Initialization
-!!
-!! The module configures the model for the Kelvin wave experiment.
-!! Kelvin = coastally-trapped Kelvin waves from the ROMS examples.
-!! Initialize with level surfaces and drive the wave in at the west,
-!! radiate out at the east.
end module Kelvin_initialization
diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90
index 0a37ffb801..2034a16bb4 100644
--- a/src/user/MOM_controlled_forcing.F90
+++ b/src/user/MOM_controlled_forcing.F90
@@ -1,3 +1,9 @@
+!> Use control-theory to adjust the surface heat flux and precipitation.
+!!
+!! Adjustments are based on the time-mean or periodically (seasonally) varying
+!! anomalies from the observed state.
+!!
+!! The techniques behind this are described in Hallberg and Adcroft (2018, in prep.).
module MOM_controlled_forcing
! This file is part of MOM6. See LICENSE.md for the license.
@@ -12,13 +18,9 @@ module MOM_controlled_forcing
use MOM_io, only : vardesc, var_desc
use MOM_restart, only : register_restart_field, MOM_restart_CS
use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-)
-use MOM_time_manager, only : get_time, get_date, set_time, set_date
-use MOM_time_manager, only : time_type_to_real
+use MOM_time_manager, only : get_date, set_date
+use MOM_time_manager, only : time_type_to_real, real_to_time
use MOM_variables, only : surface
-! Forcing is a structure containing pointers to the forcing fields
-! which may be used to drive MOM. All fluxes are positive downward.
-! Surface is a structure containing pointers to various fields that
-! may be used describe the surface state of MOM.
implicit none ; private
@@ -27,30 +29,33 @@ module MOM_controlled_forcing
public apply_ctrl_forcing, register_ctrl_forcing_restarts
public controlled_forcing_init, controlled_forcing_end
+!> Control structure for MOM_controlled_forcing
type, public :: ctrl_forcing_CS ; private
- logical :: use_temperature ! If true, temperature and salinity are used as
- ! state variables.
- logical :: do_integrated ! If true, use time-integrated anomalies to control
- ! the surface state.
- integer :: num_cycle ! The number of elements in the forcing cycle.
- real :: heat_int_rate ! The rate at which heating anomalies accumulate, in s-1.
- real :: prec_int_rate ! The rate at which precipitation anomalies accumulate, in s-1.
- real :: heat_cyc_rate ! The rate at which cyclical heating anomaliess
- ! accumulate, in s-1.
- real :: prec_cyc_rate ! The rate at which cyclical precipitation anomaliess
- ! accumulate, in s-1.
- real :: Len2 ! The square of the length scale over which the anomalies
- ! are smoothed via a Laplacian filter, in m2.
- real :: lam_heat ! A constant of proportionality between SST anomalies
- ! and heat fluxes, in W m-2 K-1.
- real :: lam_prec ! A constant of proportionality between SSS anomalies
- ! (normalised by mean SSS) and precipitation, in kg m-2.
- real :: lam_cyc_heat ! A constant of proportionality between cyclical SST
- ! anomalies and corrective heat fluxes, in W m-2 K-1.
- real :: lam_cyc_prec ! A constant of proportionality between cyclical SSS
- ! anomalies (normalised by mean SSS) and corrective
- ! precipitation, in kg m-2.
-
+ logical :: use_temperature !< If true, temperature and salinity are used as
+ !! state variables.
+ logical :: do_integrated !< If true, use time-integrated anomalies to control
+ !! the surface state.
+ integer :: num_cycle !< The number of elements in the forcing cycle.
+ real :: heat_int_rate !< The rate at which heating anomalies accumulate, in s-1.
+ real :: prec_int_rate !< The rate at which precipitation anomalies accumulate, in s-1.
+ real :: heat_cyc_rate !< The rate at which cyclical heating anomaliess
+ !! accumulate, in s-1.
+ real :: prec_cyc_rate !< The rate at which cyclical precipitation anomaliess
+ !! accumulate, in s-1.
+ real :: Len2 !< The square of the length scale over which the anomalies
+ !! are smoothed via a Laplacian filter, in m2.
+ real :: lam_heat !< A constant of proportionality between SST anomalies
+ !! and heat fluxes, in W m-2 K-1.
+ real :: lam_prec !< A constant of proportionality between SSS anomalies
+ !! (normalised by mean SSS) and precipitation, in kg m-2.
+ real :: lam_cyc_heat !< A constant of proportionality between cyclical SST
+ !! anomalies and corrective heat fluxes, in W m-2 K-1.
+ real :: lam_cyc_prec !< A constant of proportionality between cyclical SSS
+ !! anomalies (normalised by mean SSS) and corrective
+ !! precipitation, in kg m-2.
+
+ !>@{ Pointers for data.
+ !! \todo Needs more complete documentation.
real, pointer, dimension(:) :: &
avg_time => NULL()
real, pointer, dimension(:,:) :: &
@@ -62,9 +67,10 @@ module MOM_controlled_forcing
avg_SST_anom => NULL(), &
avg_SSS_anom => NULL(), &
avg_SSS => NULL()
- type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
- integer :: id_heat_0 = -1 ! See if these are neede later...
+ !!@}
+ type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
+ !! regulate the timing of diagnostic output.
+ integer :: id_heat_0 = -1 !< Diagnostic handle
end type ctrl_forcing_CS
contains
@@ -115,7 +121,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec
if (.not.associated(CS)) return
if ((CS%num_cycle <= 0) .and. (.not.CS%do_integrated)) return
- day_end = day_start + set_time(floor(dt+0.5))
+ day_end = day_start + real_to_time(dt)
do j=js,je ; do i=is,ie
virt_heat(i,j) = 0.0 ; virt_precip(i,j) = 0.0
diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90
index c464a2b1f6..1a35ebccd2 100644
--- a/src/user/MOM_wave_interface.F90
+++ b/src/user/MOM_wave_interface.F90
@@ -1,36 +1,8 @@
+!> Interface for surface waves
module MOM_wave_interface
! This file is part of MOM6. See LICENSE.md for the license.
-!********+*********+*********+*********+*********+*********+*********+**
-!* *
-!* By Brandon Reichl, 2018. *
-!* *
-!* This module should be moved as wave coupling progresses and *
-!* likely will should mirror the iceberg or sea-ice model set-up. *
-!* *
-!* This module is meant to contain the routines to read in and *
-!* interpret surface wave data for MOM6. In its original form, the *
-!* capabilities include setting the Stokes drift in the model (from a *
-!* variety of sources including prescribed, empirical, and input *
-!* files). In short order, the plan is to also ammend the subroutine *
-!* to accept Stokes drift information from an external coupler. *
-!* Eventually, it will be necessary to break this file apart so that *
-!* general wave information may be stored in the control structure *
-!* and the Stokes drift effect can be isolated from processes such as *
-!* sea-state dependent momentum fluxes, gas fluxes, and other wave *
-!* related air-sea interaction and boundary layer phenomenon. *
-!* *
-!* The Stokes drift are stored on the C-grid with the conventional *
-!* protocol to interpolate to the h-grid to compute Langmuir number, *
-!* the primary quantity needed for Langmuir turbulence *
-!* parameterizations in both the ePBL and KPP approach. This module *
-!* also computes full 3d Stokes drift profiles, which will be useful *
-!* if second-order type boundary layer parameterizations are *
-!* implemented (perhaps via GOTM, work in progress). *
-!* *
-!********+*********+*********+*********+*********+*********+*********+**
-
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc
use MOM_diag_mediator, only : diag_ctrl
use MOM_domains, only : pass_var, pass_vector, AGRID
@@ -40,11 +12,13 @@ module MOM_wave_interface
use MOM_grid, only : ocean_grid_type
use MOM_verticalgrid, only : verticalGrid_type
use MOM_safe_alloc, only : safe_alloc_ptr
-use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,&
- time_type_to_real,real_to_time_type
+use MOM_time_manager, only : time_type, operator(+), operator(/)
use MOM_variables, only : thermo_var_ptrs, surface
use data_override_mod, only : data_override_init, data_override
-implicit none ; private
+
+implicit none
+
+private
#include
@@ -69,132 +43,146 @@ module MOM_wave_interface
!> Container for all surface wave related parameters
type, public:: wave_parameters_CS ; private
- !> Main surface wave options
- logical, public :: UseWaves ! Flag to enable surface gravity wave feature
- logical, public :: LagrangianMixing ! NOT READY
- ! True if Stokes drift is present and mixing
- ! should be applied to Lagrangian current
- ! (mean current + Stokes drift).
- ! See Reichl et al., 2016 KPP-LT approach
- logical, public :: StokesMixing ! NOT READY
- ! True if vertical mixing of momentum
- ! should be applied directly to Stokes current
- ! (with separate mixing parameter for Eulerian
- ! mixing contribution).
- ! See Harcourt 2013, 2015 Second-Moment approach
- logical, public :: CoriolisStokes ! NOT READY
+ !Main surface wave options
+ logical, public :: UseWaves !< Flag to enable surface gravity wave feature
+ logical, public :: LagrangianMixing !< This feature is in development and not ready
+ !! True if Stokes drift is present and mixing
+ !! should be applied to Lagrangian current
+ !! (mean current + Stokes drift).
+ !! See Reichl et al., 2016 KPP-LT approach
+ logical, public :: StokesMixing !< This feature is in development and not ready.
+ !! True if vertical mixing of momentum
+ !! should be applied directly to Stokes current
+ !! (with separate mixing parameter for Eulerian
+ !! mixing contribution).
+ !! See Harcourt 2013, 2015 Second-Moment approach
+ logical, public :: CoriolisStokes !< This feature is in development and not ready.
! True if Coriolis-Stokes acceleration should be applied.
- integer, public :: StkLevelMode=1 ! = 0 if mid-point value of Stokes drift is used
- ! = 1 if average value of Stokes drift over level.
- ! If advecting with Stokes transport, 1 is the correct
- ! approach.
+ integer, public :: StkLevelMode=1 !< Sets if Stokes drift is defined at mid-points
+ !! or layer averaged. Set to 0 if mid-point and set to
+ !! 1 if average value of Stokes drift over level.
+ !! If advecting with Stokes transport, 1 is the correct
+ !! approach.
- !> Surface Wave Dependent 1d/2d/3d vars
+ ! Surface Wave Dependent 1d/2d/3d vars
+ real, allocatable, dimension(:), public :: &
+ WaveNum_Cen !< Wavenumber bands for read/coupled (1/m)
+ real, allocatable, dimension(:), public :: &
+ Freq_Cen !< Frequency bands for read/coupled (1/s)
+ real, allocatable, dimension(:), public :: &
+ PrescribedSurfStkX !< Surface Stokes drift if prescribed (m/s)
real, allocatable, dimension(:), public :: &
- WaveNum_Cen,& ! Wavenumber bands for read/coupled
- Freq_Cen, & ! Frequency bands for read/coupled
- PrescribedSurfStkX,& ! Surface Stokes drift if prescribed
- PrescribedSurfStkY ! Surface Stokes drift if prescribed
+ PrescribedSurfStkY !< Surface Stokes drift if prescribed (m/s)
real, allocatable, dimension(:,:,:), public :: &
- Us_x ! 3d Stokes drift profile (zonal)
- ! Horizontal -> U points
- ! Vertical -> Mid-points
+ Us_x !< 3d Stokes drift profile (zonal, m/s)
+ !! Horizontal -> U points
+ !! Vertical -> Mid-points
real, allocatable, dimension(:,:,:), public :: &
- Us_y ! 3d Stokes drift profile (meridional)
- ! Horizontal -> V points
- ! Vertical -> Mid-points
- real, allocatable, dimension(:,:), public :: &
- LangNum, & ! Langmuir number (directionality factored later)
- ! Horizontal -> H points
- US0_x, & ! Surface Stokes Drift (zonal)
- ! Horizontal -> U points
- US0_y ! Surface Stokes Drift (meridional)
- ! Horizontal -> V points
+ Us_y !< 3d Stokes drift profile (meridional, m/s)
+ !! Horizontal -> V points
+ !! Vertical -> Mid-points
+ real, allocatable, dimension(:,:), public :: &
+ LangNum !< Langmuir number (directionality factored later)
+ !! Horizontal -> H points
+ real, allocatable, dimension(:,:), public :: &
+ US0_x !< Surface Stokes Drift (zonal, m/s)
+ !! Horizontal -> U points
+ real, allocatable, dimension(:,:), public :: &
+ US0_y !< Surface Stokes Drift (meridional, m/s)
+ !! Horizontal -> V points
real, allocatable, dimension(:,:,:), public :: &
- STKx0 ! Stokes Drift spectrum (zonal)
- ! Horizontal -> U points
- ! 3rd dimension -> Freq/Wavenumber
+ STKx0 !< Stokes Drift spectrum (zonal, m/s)
+ !! Horizontal -> U points
+ !! 3rd dimension -> Freq/Wavenumber
real, allocatable, dimension(:,:,:), public :: &
- STKy0 ! Stokes Drift spectrum (meridional)
- ! Horizontal -> V points
- ! 3rd dimension -> Freq/Wavenumber
+ STKy0 !< Stokes Drift spectrum (meridional, m/s)
+ !! Horizontal -> V points
+ !! 3rd dimension -> Freq/Wavenumber
real, allocatable, dimension(:,:,:), public :: &
- KvS !< Viscosity for Stokes Drift shear
+ KvS !< Viscosity for Stokes Drift shear (m2/s)
! Pointers to auxiliary fields
- type(time_type), pointer, public :: Time ! A pointer to the ocean model's clock.
- type(diag_ctrl), pointer, public :: diag ! A structure that is used to regulate the
- ! timing of diagnostic output.
+ type(time_type), pointer, public :: Time !< A pointer to the ocean model's clock.
+ type(diag_ctrl), pointer, public :: diag !< A structure that is used to regulate the
+ !! timing of diagnostic output.
- ! Diagnostic handles
+ !>@{ Diagnostic handles
integer, public :: id_surfacestokes_x, id_surfacestokes_y
integer, public :: id_3dstokes_x, id_3dstokes_y
+ !!@}
end type wave_parameters_CS
-!Options not needed outside of this module
+! Options not needed outside of this module
-!> Main Option
-integer :: WaveMethod=-99
- ! Options for including wave information
- ! Valid (tested) choices are:
- ! 0 - Test Profile
- ! 1 - Surface Stokes Drift Bands
- ! 2 - DHH85
- ! 3 - LF17
- ! -99 - No waves computed, but empirical Langmuir number used.
+integer :: WaveMethod=-99 !< Options for including wave information
+ !! Valid (tested) choices are:
+ !! 0 - Test Profile
+ !! 1 - Surface Stokes Drift Bands
+ !! 2 - DHH85
+ !! 3 - LF17
+ !! -99 - No waves computed, but empirical Langmuir number used.
+ !! \todo Module variable! Move into a control structure.
-!> Options if WaveMethod is Surface Stokes Drift Bands (1)
+! Options if WaveMethod is Surface Stokes Drift Bands (1)
integer, public :: NumBands =0 !< Number of wavenumber/frequency partitions to receive
!! This needs to match the number of bands provided
!! via either coupling or file.
+ !! \todo Module variable! Move into a control structure.
integer, public :: PartitionMode !< Method for partition mode (meant to check input)
!! 0 - wavenumbers
!! 1 - frequencies
-integer :: DataSource ! Integer that specifies where the Model Looks for Data
- ! Valid choices are:
- ! 1 - FMS DataOverride Routine
- ! 2 - Reserved For Coupler
- ! 3 - User input (fixed values, useful for 1d testing)
-!>> Options if using FMS DataOverride Routine
-character(len=40) :: SurfBandFileName ! Filename if using DataOverride
-logical :: dataoverrideisinitialized ! Flag for DataOverride Initialization
-
-!> Options for computing Langmuir number
+ !! \todo Module variable! Move into a control structure.
+integer :: DataSource !< Integer that specifies where the Model Looks for Data
+ !! Valid choices are:
+ !! 1 - FMS DataOverride Routine
+ !! 2 - Reserved For Coupler
+ !! 3 - User input (fixed values, useful for 1d testing)
+ !! \todo Module variable! Move into a control structure.
+
+! Options if using FMS DataOverride Routine
+character(len=40) :: SurfBandFileName !< Filename if using DataOverride
+ !! \todo Module variable! Move into a control structure.
+logical :: dataoverrideisinitialized !< Flag for DataOverride Initialization
+ !! \todo Module variable! Move into a control structure.
+
+! Options for computing Langmuir number
real :: LA_FracHBL !< Fraction of OSBL for averaging Langmuir number
+ !! \todo Module variable! Move into a control structure.
logical :: LA_Misalignment = .false. !< Flag to use misalignment in Langmuir number
+ !! \todo Module variable! Move into a control structure.
! This include declares and sets the variable "version".
#include "version_variable.h"
-character(len=40) :: mdl = "MOM_wave_interface" ! This module's name.
+character(len=40) :: mdl = "MOM_wave_interface" !< This module's name.
+!>@{ Undocumented parameters.
+!! \todo These module variables need to be documented as static/private variables or moved
+!! into a control structure.
! Switches needed in import_stokes_drift
integer, parameter :: TESTPROF = 0, SURFBANDS = 1, &
DHH85 = 2, LF17 = 3, NULL_WaveMethod=-99, &
DATAOVR = 1, COUPLER = 2, INPUT = 3
-! For Test Prof
+! Options For Test Prof
Real :: TP_STKX0, TP_STKY0, TP_WVL
-logical :: WaveAgePeakFreq !> Flag to use W
+logical :: WaveAgePeakFreq ! Flag to use W
real :: WaveAge, WaveWind
real :: PI
+!!@}
-CONTAINS
+contains
!> Initializes parameters related to MOM_wave_interface
subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag )
-
- !Arguments
- type(time_type), target, intent(in) :: Time !< Time
+ type(time_type), target, intent(in) :: Time !< Time (s)
type(ocean_grid_type), intent(inout) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
type(param_file_type), intent(in) :: param_file !< Input parameter structure
type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic Pointer
-
! Local variables
-
! I/O
character*(13) :: TMPSTRING1,TMPSTRING2
character*(5), parameter :: NULL_STRING = "EMPTY"
@@ -206,7 +194,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag )
character*(7), parameter :: COUPLER_STRING = "COUPLER"
character*(5), parameter :: INPUT_STRING = "INPUT"
- !/ Dummy Check
+ ! Dummy Check
if (associated(CS)) then
call MOM_error(FATAL, "wave_interface_init called with an associated"//&
"control structure.")
@@ -215,7 +203,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag )
PI=4.0*atan(1.0)
- !/ Allocate CS and set pointers
+ ! Allocate CS and set pointers
allocate(CS)
CS%diag => diag
@@ -235,25 +223,25 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag )
"Flag to use Lagrangian Mixing of momentum", units="", &
Default=.false.)
if (CS%LagrangianMixing) then
- !Force Code Intervention
+ ! Force Code Intervention
call MOM_error(FATAL,"Should you be enabling Lagrangian Mixing? Code not ready.")
endif
call get_param(param_file, mdl, "STOKES_MIXING", CS%StokesMixing, &
"Flag to use Stokes Mixing of momentum", units="", &
Default=.false.)
if (CS%StokesMixing) then
- !Force Code Intervention
+ ! Force Code Intervention
call MOM_error(FATAL,"Should you be enabling Stokes Mixing? Code not ready.")
endif
call get_param(param_file, mdl, "CORIOLIS_STOKES", CS%CoriolisStokes, &
"Flag to use Coriolis Stokes acceleration", units="", &
Default=.false.)
if (CS%CoriolisStokes) then
- !Force Code Intervention
+ ! Force Code Intervention
call MOM_error(FATAL,"Should you be enabling Coriolis-Stokes? Code not ready.")
endif
- ! 1. Get Wave Method and write to integer WaveMethod
+ ! Get Wave Method and write to integer WaveMethod
call get_param(param_file,mdl,"WAVE_METHOD",TMPSTRING1, &
"Choice of wave method, valid options include: \n"// &
" TEST_PROFILE - Prescribed from surface Stokes drift \n"// &
@@ -279,7 +267,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag )
units='m/s',default=0.0)
call get_param(param_file,mdl,"TP_WVL",TP_WVL,&
units='m',default=50.0)
- case (SURFBANDS_STRING)!Surface Stokes Drift Bands
+ case (SURFBANDS_STRING)! Surface Stokes Drift Bands
WaveMethod = SURFBANDS
call get_param(param_file, mdl, "SURFBAND_SOURCE",TMPSTRING2, &
"Choice of SURFACE_BANDS data mode, valid options include: \n"// &
@@ -288,27 +276,32 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag )
" INPUT - Testing with fixed values.", &
units='', default=NULL_STRING)
select case (TRIM(TMPSTRING2))
- case (NULL_STRING)!
+ case (NULL_STRING)! Default
call MOM_error(FATAL, "wave_interface_init called with SURFACE_BANDS"//&
" but no SURFBAND_SOURCE.")
- case (DATAOVR_STRING)!Using Data Override
+ case (DATAOVR_STRING)! Using Data Override
DataSource = DATAOVR
call get_param(param_file, mdl, "SURFBAND_FILENAME", SurfBandFileName, &
"Filename of surface Stokes drift input band data.", default="StkSpec.nc")
- case (COUPLER_STRING)!Reserved for coupling
+ case (COUPLER_STRING)! Reserved for coupling
DataSource = Coupler
- case (INPUT_STRING)
+ case (INPUT_STRING)! A method to input the Stokes band (globally uniform)
DataSource = Input
call get_param(param_file,mdl,"SURFBAND_NB",NumBands, &
"Prescribe number of wavenumber bands for Stokes drift. \n"// &
" Make sure this is consistnet w/ WAVENUMBERS, STOKES_X, and \n"// &
" STOKES_Y, there are no safety checks in the code.", &
units='', default=1)
- allocate( CS%WaveNum_Cen(1:NumBands) ) ; CS%WaveNum_Cen(:)=0.0
- allocate( CS%PrescribedSurfStkX(1:NumBands)) ; CS%PrescribedSurfStkX(:) = 0.0
- allocate( CS%PrescribedSurfStkY(1:NumBands)) ; CS%PrescribedSurfStkY(:) = 0.0
- allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:NumBands)) ; CS%STKx0(:,:,:) = 0.0
- allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:NumBands)) ; CS%STKy0(:,:,:) = 0.0
+ allocate( CS%WaveNum_Cen(1:NumBands) )
+ CS%WaveNum_Cen(:) = 0.0
+ allocate( CS%PrescribedSurfStkX(1:NumBands))
+ CS%PrescribedSurfStkX(:) = 0.0
+ allocate( CS%PrescribedSurfStkY(1:NumBands))
+ CS%PrescribedSurfStkY(:) = 0.0
+ allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:NumBands))
+ CS%STKx0(:,:,:) = 0.0
+ allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:NumBands))
+ CS%STKy0(:,:,:) = 0.0
partitionmode=0
call get_param(param_file,mdl,"SURFBAND_WAVENUMBERS",CS%WaveNum_Cen, &
"Central wavenumbers for surface Stokes drift bands.",units='rad/m', &
@@ -319,12 +312,14 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag )
call get_param(param_file,mdl,"SURFBAND_STOKES_Y",CS%PrescribedSurfStkY, &
"Y-direction surface Stokes drift for bands.",units='m/s', &
default=0.0)
- case default
+ case default! No method provided
call MOM_error(FATAL,'Check WAVE_METHOD.')
end select
case (DHH85_STRING)!Donelan et al., 1985 spectrum
WaveMethod = DHH85
+ call MOM_error(WARNING,"DHH85 only ever set-up for uniform cases w/"//&
+ " Stokes drift in x-direction.")
call get_param(param_file,mdl,"DHH85_AGE_FP",WaveAgePeakFreq, &
"Choose true to use waveage in peak frequency.", &
units='', default=.false.)
@@ -349,25 +344,27 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag )
"Flag (logical) if using misalignment bt shear and waves in LA",&
default=.false.)
- ! 2. Allocate and initialize
- ! Stokes drift
- ! Profiles
- allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke)) ; CS%Us_x(:,:,:) = 0.0
- allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke)) ; CS%Us_y(:,:,:) = 0.0
- ! Surface Values
- allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) ; CS%US0_x(:,:) = 0.0
- allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB)) ; CS%US0_y(:,:) = 0.0
- ! Langmuir number
- allocate(CS%LangNum(G%isc:G%iec,G%jsc:G%jec)) ; CS%LangNum(:,:) = 0.0
-
+ ! Allocate and initialize
+ ! a. Stokes driftProfiles
+ allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke))
+ CS%Us_x(:,:,:) = 0.0
+ allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke))
+ CS%Us_y(:,:,:) = 0.0
+ ! b. Surface Values
+ allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed))
+ CS%US0_x(:,:) = 0.0
+ allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB))
+ CS%US0_y(:,:) = 0.0
+ ! c. Langmuir number
+ allocate(CS%LangNum(G%isc:G%iec,G%jsc:G%jec))
+ CS%LangNum(:,:) = 0.0
+ ! d. Viscosity for Stokes drift
if (CS%StokesMixing) then
- ! Viscosity for Stokes drift
- allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,G%ke)) ; CS%KvS(:,:,:) = 0.0
+ allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,G%ke))
+ CS%KvS(:,:,:) = 0.0
endif
- !
- ! 3. Initialize Wave related outputs
- !
+ ! Initialize Wave related outputs
CS%id_surfacestokes_y = register_diag_field('ocean_model','surface_stokes_y', &
CS%diag%axesCu1,Time,'Surface Stokes drift (y)','m s-1')
CS%id_surfacestokes_x = register_diag_field('ocean_model','surface_stokes_x', &
@@ -378,18 +375,12 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag )
CS%diag%axesCuL,Time,'3d Stokes drift (y)','m s-1')
return
-
end subroutine MOM_wave_interface_init
-
+!> A 'lite' init subroutine to initialize a few inputs needed if using wave information
+!! with the wind-speed dependent Stokes drift formulation of LF17
subroutine MOM_wave_interface_init_lite(param_file)
- !It is possible to estimate Stokes drift without the Wave data (if WaveMethod=LF17).
- ! In this case there are still a couple inputs we need to read in, which is done
- ! here in a reduced wave_interface_init that doesn't allocate the CS.
-
- !Arguments
- type(param_file_type), intent(in) :: param_file !< Input parameter structure
-
+ type(param_file_type), intent(in) :: param_file !< Input parameter structure
! Langmuir number Options
call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, &
@@ -406,19 +397,18 @@ subroutine MOM_wave_interface_init_lite(param_file)
return
end subroutine MOM_wave_interface_init_lite
-! Place to add update of surface wave parameters.
+!> Subroutine that handles updating of surface wave/Stokes drift related properties
subroutine Update_Surface_Waves(G,GV,Day,DT,CS)
-!Arguments
- type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure
- type(ocean_grid_type), intent(inout) :: G !< Grid structure
- type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
- type(time_type), intent(in) :: Day !