diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/mom_ocean_model_mct.F90
similarity index 55%
rename from config_src/mct_driver/MOM_ocean_model.F90
rename to config_src/mct_driver/mom_ocean_model_mct.F90
index 8bb3346021..ec894f1ebb 100644
--- a/config_src/mct_driver/MOM_ocean_model.F90
+++ b/config_src/mct_driver/mom_ocean_model_mct.F90
@@ -1,21 +1,15 @@
-module MOM_ocean_model
+!> Top-level module for the MOM6 ocean model in coupled mode.
+module MOM_ocean_model_mct
! 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
@@ -25,7 +19,7 @@ module MOM_ocean_model
use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging
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, fill_symmetric_edges
+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 : callTree_enter, callTree_leave
use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type
@@ -35,18 +29,16 @@ module MOM_ocean_model
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_diagnostics, mech_forcing_diags
-use MOM_forcing_type, only : allocate_mech_forcing
use MOM_get_input, only : Get_MOM_Input, directories
use MOM_grid, only : ocean_grid_type
use MOM_io, only : close_file, file_exists, read_data, write_version_number
use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS
use MOM_restart, only : MOM_restart_CS, save_restart
use MOM_string_functions, only : uppercase
-use MOM_surface_forcing, only : surface_forcing_init
-use MOM_surface_forcing, only : convert_IOB_to_fluxes
-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_surface_forcing_mct, only : surface_forcing_init, convert_IOB_to_fluxes
+use MOM_surface_forcing_mct, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum
+use MOM_surface_forcing_mct, only : ice_ocean_boundary_type, surface_forcing_CS
+use MOM_surface_forcing_mct, 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(>=)
@@ -64,24 +56,15 @@ module MOM_ocean_model
use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data
use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain
use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain
+use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux
use fms_mod, only : stdout
use mpp_mod, only : mpp_chksum
use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct
-use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init
-use MOM_wave_interface, only : MOM_wave_interface_init_lite, Update_Surface_Waves
+use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init
+use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves
! MCT specfic routines
-use ocn_cpl_indices, only : cpl_indices_type
-use MOM_coms, only : reproducing_sum
-use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
-use MOM_spatial_means, only : adjust_area_mean_to_zero
-use MOM_diag_mediator, only : safe_alloc_ptr
use MOM_domains, only : MOM_infra_end
-use user_revise_forcing, only : user_alter_forcing
-use data_override_mod, only : data_override
-
-! FMS modules
-use time_interp_external_mod, only : time_interp_external
#include
@@ -92,35 +75,37 @@ module MOM_ocean_model
implicit none ; public
public ocean_model_init, ocean_model_end, update_ocean_model
-public get_ocean_grid ! add by Jiande
public ocean_model_save_restart, Ocean_stock_pe
+public ice_ocean_boundary_type
public ocean_model_init_sfc, ocean_model_flux_init
public ocean_model_restart
+public ice_ocn_bnd_type_chksum
public ocean_public_type_chksum
public ocean_model_data_get
-public ice_ocn_bnd_type_chksum
+public get_ocean_grid
+!> 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
end interface
+
!> This type is used for communication with other components via the FMS coupler.
!! The element names and types can be changed only with great deliberation, hence
!! the persistnce of things like the cutsy element name "avg_kount".
type, public :: ocean_public_type
type(domain2d) :: Domain !< The domain for the surface fields.
- logical :: is_ocean_pe !! .true. on processors that run the ocean model.
+ logical :: is_ocean_pe !< .true. on processors that run the ocean model.
character(len=32) :: instance_name = '' !< A name that can be used to identify
!! this instance of an ocean model, for example
!! in ensembles when writing messages.
integer, pointer, dimension(:) :: pelist => NULL() !< The list of ocean PEs.
logical, pointer, dimension(:,:) :: maskmap =>NULL() !< A pointer to an array
- !! indicating which logical processors are actually
- !! used for the ocean code. The other logical
- !! processors would be all land points and are not
- !! assigned to actual processors. This need not be
- !! assigned if all logical processors are used.
+ !! indicating which logical processors are actually used for
+ !! the ocean code. The other logical processors would be all
+ !! land points and are not assigned to actual processors.
+ !! This need not be assigned if all logical processors are used.
integer :: stagger = -999 !< The staggering relative to the tracer points
!! points of the two velocity components. Valid entries
@@ -140,38 +125,38 @@ 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.
- melt_potential => NULL(), & !< Accumulated heat used to melt sea ice (in W/m^2)
+ melt_potential => NULL(), & !< Instantaneous heat used to melt sea ice (in J/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.
+ type(coupler_2d_bc_type) :: fields !< A structure that may contain named
+ !! arrays of tracer-related surface fields.
+ integer :: avg_kount !< A count of contributions to running
+ !! sums, used externally by the FMS coupler
+ !! for accumulating averages of this type.
integer, dimension(2) :: axes = 0 !< Axis numbers that are available
- ! for I/O using this surface data.
+ !! for I/O using this surface data.
end type ocean_public_type
-!> Contains information about the ocean state, although it is not necessary that
-!! this is implemented with all models. This type is NOT private, and can therefore CANNOT vary
-!! between different ocean models.
-type, public :: ocean_state_type
- logical :: is_ocean_PE = .false. !< True if this is an ocean PE.
- type(time_type) :: Time !< The ocean model's time and master clock.
- 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
- !! files and +2 (bit 1) for time-stamped files. A
- !! restart file is saved at the end of a run segment
- !! unless Restart_control is negative.
+!> The ocean_state_type contains all information about the state of the ocean,
+!! with a format that is private so it can be readily changed without disrupting
+!! other coupled components.
+type, public :: ocean_state_type ;
+ ! 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.
+ 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
+ !! files and +2 (bit 1) for time-stamped files. A
+ !! 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.
logical :: use_ice_shelf !< If true, the ice shelf model is enabled.
- logical :: icebergs_apply_rigid_boundary !< If true, the icebergs can change ocean bd condition.
- real :: kv_iceberg !< The viscosity of the icebergs in m2/s (for ice rigidity)
- real :: berg_area_threshold !< Fraction of grid cell which iceberg must occupy
- !! so that fluxes below are set to zero. (0.5 is a
- !! good value to use. Not applied for negative values.
- real :: latent_heat_fusion !< Latent heat of fusion
- real :: density_iceberg !< A typical density of icebergs in kg/m3 (for ice rigidity)
- type(ice_shelf_CS), pointer :: Ice_shelf_CSp => NULL() !< ice shelf structure.
+ 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
@@ -186,23 +171,49 @@ module MOM_ocean_model
!! fields necessary to integrate only the tracer advection
!! and diffusion equation read in from files stored from
!! a previous integration of the prognostic model.
- type(directories) :: dirs !< A structure containing several relevant directory paths.
- type(mech_forcing) :: forces!< A structure with the driving mechanical surface forces
- type(forcing) :: fluxes !< A structure containing pointers to
- !! the ocean forcing fields.
- type(forcing) :: flux_tmp !< A secondary structure containing pointers to the
+
+ logical :: single_step_call !< If true, advance the state of MOM with a single
+ !! step including both dynamics and thermodynamics.
+ !! If false, the two phases are advanced with
+ !! separate calls. The default is true.
+ ! The following 3 variables are only used here if single_step_call is false.
+ real :: dt !< (baroclinic) dynamics time step (seconds)
+ real :: dt_therm !< thermodynamics time step (seconds)
+ logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time
+ !! steps can span multiple coupled time steps.
+ logical :: diabatic_first !< If true, apply diabatic and thermodynamic
+ !! processes before time stepping the dynamics.
+
+ type(directories) :: dirs !< A structure containing several relevant directory paths.
+ type(mech_forcing) :: forces !< A structure with the driving mechanical surface forces
+ type(forcing) :: fluxes !< A structure containing pointers to
+ !! the thermodynamic ocean forcing fields.
+ type(forcing) :: flux_tmp !< A secondary structure containing pointers to the
!! ocean forcing fields for when multiple coupled
!! timesteps are taken per thermodynamic step.
- type(surface) :: sfc_state !< A structure containing pointers to
+ type(surface) :: sfc_state !< A structure containing pointers to
!! the ocean surface state fields.
- type(ocean_grid_type), pointer :: grid => NULL() !< A pointer to a grid structure
- !! containing metrics and related information.
- type(verticalGrid_type), pointer :: GV => NULL() !< A pointer to a vertical grid
- !! structure containing metrics and related information.
+ type(ocean_grid_type), pointer :: &
+ grid => NULL() !< A pointer to a grid structure containing metrics
+ !! and related information.
+ type(verticalGrid_type), pointer :: &
+ GV => NULL() !< A pointer to a structure containing information
+ !! about the vertical grid.
type(unit_scale_type), pointer :: US => NULL() !< A pointer to a structure containing
!! dimensional unit scaling factors.
- type(MOM_control_struct), pointer :: MOM_CSp => NULL()
- type(surface_forcing_CS), pointer :: forcing_CSp => NULL()
+ type(MOM_control_struct), pointer :: &
+ MOM_CSp => NULL() !< A pointer to the MOM control structure
+ type(ice_shelf_CS), pointer :: &
+ Ice_shelf_CSp => NULL() !< A pointer to the control structure for the
+ !! ice shelf model that couples with MOM6. This
+ !! is null if there is no ice shelf.
+ type(marine_ice_CS), pointer :: &
+ marine_ice_CSp => NULL() !< A pointer to the control structure for the
+ !! marine ice effects module.
+ type(wave_parameters_cs), pointer :: &
+ Waves !< A structure containing pointers to the surface wave fields
+ type(surface_forcing_CS), pointer :: &
+ forcing_CSp => NULL() !< A pointer to the MOM forcing control structure
type(MOM_restart_CS), pointer :: &
restart_CSp => NULL() !< A pointer set to the restart control structure
!! that will be used for MOM restart files.
@@ -210,26 +221,19 @@ module MOM_ocean_model
diag => NULL() !< A pointer to the diagnostic regulatory structure
end type ocean_state_type
-integer :: id_clock_forcing
-
-!=======================================================================
contains
-!=======================================================================
-
-!=======================================================================
-!
-!
-!
-! Initialize the ocean model.
-!
-!> Initializes the ocean model, including registering fields
+!> 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, input_restart_file)
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.
@@ -242,28 +246,24 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
!! tracer fluxes, and can be used to spawn related
!! internal variables in the ice model.
character(len=*), optional, intent(in) :: input_restart_file !< If present, name of restart file to read
-
-! 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.
-
- real :: Rho0 !< The Boussinesq ocean density [kg m-3].
- real :: G_Earth !< The gravitational acceleration [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.
+ ! 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=40) :: mdl = "ocean_model_init" ! This module's name.
character(len=48) :: stagger
- logical :: use_temperature
integer :: secs, days
type(param_file_type) :: param_file !< A structure to parse for run-time parameters
+ logical :: use_temperature
- call callTree_enter("ocean_model_init(), ocn_comp_mct.F90")
+ call callTree_enter("ocean_model_init(), MOM_ocean_model_mct.F90")
if (associated(OS)) then
call MOM_error(WARNING, "ocean_model_init called with an associated "// &
"ocean_state_type structure. Model is already initialized.")
@@ -277,14 +277,41 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
OS%Time = 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, &
- input_restart_file=input_restart_file, diag_ptr=OS%diag, &
- count_calls=.true.)
- call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%fluxes%C_p, &
+ input_restart_file=input_restart_file, &
+ diag_ptr=OS%diag, count_calls=.true.)
+ call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, &
use_temp=use_temperature)
- OS%C_p = OS%fluxes%C_p
+ OS%fluxes%C_p = OS%C_p
! Read all relevant parameters and write them to the model log.
call log_version(param_file, mdl, version, "")
+
+ call get_param(param_file, mdl, "SINGLE_STEPPING_CALL", OS%single_step_call, &
+ "If true, advance the state of MOM with a single step "//&
+ "including both dynamics and thermodynamics. If false, "//&
+ "the two phases are advanced with separate calls.", default=.true.)
+ call get_param(param_file, mdl, "DT", OS%dt, &
+ "The (baroclinic) dynamics time step. The time-step that "//&
+ "is actually used will be an integer fraction of the "//&
+ "forcing time-step.", units="s", fail_if_missing=.true.)
+ call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, &
+ "The thermodynamic and tracer advection time step. "//&
+ "Ideally DT_THERM should be an integer multiple of DT "//&
+ "and less than the forcing or coupling time-step, unless "//&
+ "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//&
+ "can be an integer multiple of the coupling timestep. By "//&
+ "default DT_THERM is set to DT.", units="s", default=OS%dt)
+ call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, &
+ "If true, the MOM will take thermodynamic and tracer "//&
+ "timesteps that can be longer than the coupling timestep. "//&
+ "The actual thermodynamic timestep that is used in this "//&
+ "case is the largest integer multiple of the coupling "//&
+ "timestep that is less than or equal to DT_THERM.", default=.false.)
+ call get_param(param_file, mdl, "DIABATIC_FIRST", OS%diabatic_first, &
+ "If true, apply diabatic and thermodynamic processes, "//&
+ "including buoyancy forcing and mass gain or loss, "//&
+ "before stepping the dynamics forward.", default=.false.)
+
call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, &
"An integer whose bits encode which restart files are "//&
"written. Add 2 (bit 1) for a time-stamped file, and odd "//&
@@ -296,16 +323,11 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
"staggering of the surface velocity field that is "//&
"returned to the coupler. Valid values include "//&
"'A', 'B', or 'C'.", default="C")
- if (uppercase(stagger(1:1)) == 'A') then
- Ocean_sfc%stagger = AGRID
- elseif (uppercase(stagger(1:1)) == 'B') then
- Ocean_sfc%stagger = BGRID_NE
- elseif (uppercase(stagger(1:1)) == 'C') then
- Ocean_sfc%stagger = CGRID_NE
- else
- call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// &
- trim(stagger)//" is invalid.")
- end if
+ if (uppercase(stagger(1:1)) == 'A') then ; Ocean_sfc%stagger = AGRID
+ elseif (uppercase(stagger(1:1)) == 'B') then ; Ocean_sfc%stagger = BGRID_NE
+ elseif (uppercase(stagger(1:1)) == 'C') then ; Ocean_sfc%stagger = CGRID_NE
+ 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 "//&
@@ -328,27 +350,11 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
call get_param(param_file, mdl, "ICE_SHELF", OS%use_ice_shelf, &
"If true, enables the ice shelf model.", default=.false.)
- call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_apply_rigid_boundary, &
+ call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_alter_ocean, &
"If true, allows icebergs to change boundary condition felt by ocean", default=.false.)
- if (OS%icebergs_apply_rigid_boundary) then
- call get_param(param_file, mdl, "KV_ICEBERG", OS%kv_iceberg, &
- "The viscosity of the icebergs", units="m2 s-1",default=1.0e10)
- call get_param(param_file, mdl, "DENSITY_ICEBERGS", OS%density_iceberg, &
- "A typical density of icebergs.", units="kg m-3", default=917.0)
- call get_param(param_file, mdl, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, &
- "The latent heat of fusion.", units="J/kg", default=hlf)
- call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, &
- "Fraction of grid cell which iceberg must occupy, so that fluxes "//&
- "below berg are set to zero. Not applied for negative "//&
- " values.", units="non-dim", default=-1.0)
- endif
-
OS%press_to_z = 1.0/(Rho0*G_Earth)
- ! 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 get_param(param_file, mdl, "HFREEZE", HFrz, &
"If HFREEZE > 0, melt potential will be computed. The actual depth "//&
"over which melt potential is computed will be min(HFREEZE, OBLD), "//&
@@ -361,8 +367,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
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)
+ ! 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, use_meltpot=use_melt_pot)
call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, &
OS%forcing_CSp, OS%restore_salinity, OS%restore_temp)
@@ -371,10 +379,19 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, &
OS%diag, OS%forces, OS%fluxes)
endif
- if (OS%icebergs_apply_rigid_boundary) then
- !call allocate_forcing_type(OS%grid, OS%fluxes, iceberg=.true.)
- !This assumes that the iceshelf and ocean are on the same grid. I hope this is true
- if (.not. OS%use_ice_shelf) call allocate_forcing_type(OS%grid, OS%fluxes, ustar=.true., shelf=.true.)
+
+ if (OS%icebergs_alter_ocean) then
+ call marine_ice_init(OS%Time, OS%grid, param_file, OS%diag, OS%marine_ice_CSp)
+ if (.not. OS%use_ice_shelf) &
+ call allocate_forcing_type(OS%grid, OS%fluxes, shelf=.true.)
+ endif
+
+ call get_param(param_file, mdl, "USE_WAVES", OS%Use_Waves, &
+ "If true, enables surface wave modules.", default=.false.)
+ if (OS%use_waves) then
+ call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag)
+ else
+ call MOM_wave_interface_init_lite(param_file)
endif
if (associated(OS%grid%Domain%maskmap)) then
@@ -389,6 +406,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
! This call can only occur here if the coupler_bc_type variables have been
! initialized already using the information from gas_fields_ocn.
if (present(gas_fields_ocn)) then
+ call coupler_type_set_diags(Ocean_sfc%fields, "ocean_sfc", &
+ Ocean_sfc%axes(1:2), Time_in)
+
call extract_surface_state(OS%MOM_CSp, OS%sfc_state)
call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid)
@@ -397,60 +417,69 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
call close_param_file(param_file)
call diag_mediator_close_registration(OS%diag)
- call callTree_leave("ocean_model_init(")
+ if (is_root_pe()) &
+ write(*,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========'
+ 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.
-!
-!
-!> Updates the ocean model fields. This code wraps the call to step_MOM with MOM6's call.
-!! It uses the forcing 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.
+!> 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)
-
+ time_start_update, Ocean_coupling_time_step, &
+ update_dyn, update_thermo, Ocn_fluxes_used)
type(ice_ocean_boundary_type), &
intent(in) :: Ice_ocean_boundary !< A structure containing the
!! various forcing fields coming from the ice.
-
type(ocean_state_type), &
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.
-
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.
-
- ! local variables
- 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-ocn boundary type
- real :: weight !< Flux accumulation weight
- real :: time_step !< The time step of a call to step_MOM in seconds.
+ 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
+ !! due to the ocean thermodynamics or remapping.
+ 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.
+ ! Local variables
+ 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
integer :: is, ie, js, je
- call callTree_enter("update_ocean_model(), MOM_ocean_model.F90")
+ call callTree_enter("update_ocean_model(), MOM_ocean_model_mct.F90")
call get_time(Ocean_coupling_time_step, secs, days)
- time_step = 86400.0*real(days) + real(secs)
+ dt_coupling = 86400.0*real(days) + real(secs)
if (time_start_update /= OS%Time) then
call MOM_error(WARNING, "update_ocean_model: internal clock does not "//&
@@ -464,6 +493,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
return
endif
+ do_dyn = .true. ; if (present(update_dyn)) do_dyn = update_dyn
+ do_thermo = .true. ; if (present(update_thermo)) do_thermo = update_thermo
+
! 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
@@ -481,62 +513,70 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
if (OS%fluxes%fluxes_used) then
! GMM, is enable_averaging needed now?
- call enable_averaging(time_step, OS%Time + Ocean_coupling_time_step, OS%diag)
+ call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag)
+
+ if (do_thermo) &
+ call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, &
+ OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, &
+ OS%restore_salinity, OS%restore_temp)
- ! Import fluxes from coupler to ocean. Also, perform do SST and SSS restoring, if needed.
- call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%US, OS%forcing_CSp, &
- OS%sfc_state, OS%restore_salinity, OS%restore_temp)
+ ! Add ice shelf fluxes
+ if (OS%use_ice_shelf) then
+ if (do_thermo) &
+ 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) &
+ 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)
#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
#endif
- ! Add ice shelf fluxes
- if (OS%use_ice_shelf) then
- call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_CSp)
- call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces)
- endif
-
- ! GMM, check ocean_model_MOM.F90 to enable the following option
- !if (OS%icebergs_apply_rigid_boundary) then
- ! This assumes that the iceshelf and ocean are on the same grid. I hope this is true.
- ! call add_berg_flux_to_shelf(OS%grid, OS%forces,OS%fluxes,OS%use_ice_shelf,OS%density_iceberg, &
- ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold)
- !endif
-
! Indicate that there are new unused fluxes.
OS%fluxes%fluxes_used = .false.
- OS%fluxes%dt_buoy_accum = time_step
+ OS%fluxes%dt_buoy_accum = dt_coupling
else
OS%flux_tmp%C_p = OS%fluxes%C_p
- ! Import fluxes from coupler to ocean. Also, perform do SST and SSS restoring, if needed.
- call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%US, OS%forcing_CSp, &
- OS%sfc_state, OS%restore_salinity, OS%restore_temp)
+ if (do_thermo) &
+ call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, &
+ OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp)
if (OS%use_ice_shelf) then
- call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp)
- call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces)
+ if (do_thermo) &
+ 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) &
+ call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, &
+ OS%sfc_state, dt_coupling, OS%marine_ice_CSp)
endif
- ! GMM, check ocean_model_MOM.F90 to enable the following option
- !if (OS%icebergs_apply_rigid_boundary) then
- !This assumes that the iceshelf and ocean are on the same grid. I hope this is true
- ! call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf,OS%density_iceberg, &
- ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold)
- !endif
-
- ! Accumulate the forcing over time steps
- call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, time_step, OS%grid, weight)
+ 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
- ! are time-averages must be copied back to the forces type.
+ ! (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)
+
#ifdef _USE_GENERIC_TRACER
call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average
#endif
@@ -545,6 +585,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%US, OS%GV%Rho0)
call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid)
+ if (OS%use_waves) then
+ call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves)
+ endif
+
if (OS%nstep==0) then
call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp)
endif
@@ -553,16 +597,81 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
Master_time = OS%Time ; Time1 = OS%Time
if(OS%offline_tracer_mode) then
- call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MOM_CSp)
+ 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, &
+ reset_therm=Ocn_fluxes_used)
+
+ 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
- call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MOM_CSp)
+ 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))
+
+ if (thermo_does_span_coupling) then
+ dt_therm = dt_coupling * floor(OS%dt_therm / dt_coupling + 0.001)
+ nts = floor(dt_therm/dt_dyn + 0.001)
+ else
+ nts = MAX(1,MIN(n_max,floor(OS%dt_therm/dt_dyn + 0.001)))
+ n_last_thermo = 0
+ endif
+
+ Time2 = Time1 ; t_elapsed_seg = 0.0
+ do n=1,n_max
+ if (OS%diabatic_first) then
+ if (thermo_does_span_coupling) call MOM_error(FATAL, &
+ "MOM is not yet set up to have restarts that work with "//&
+ "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, &
+ 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, &
+ 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, &
+ Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., &
+ start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling)
+
+ step_thermo = .false.
+ if (thermo_does_span_coupling) then
+ dtdia = dt_therm
+ step_thermo = MOM_state_is_synchronized(OS%MOM_CSp, adv_dyn=.true.)
+ elseif ((modulo(n,nts)==0) .or. (n==n_max)) then
+ dtdia = dt_dyn*(n - n_last_thermo)
+ n_last_thermo = n
+ step_thermo = .true.
+ 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, &
+ 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)))
+ enddo
endif
OS%Time = Master_time + Ocean_coupling_time_step
OS%nstep = OS%nstep + 1
- call enable_averaging(time_step, OS%Time, OS%diag)
- call mech_forcing_diags(OS%forces, time_step, OS%grid, OS%diag, OS%forcing_CSp%handles)
+ call enable_averaging(dt_coupling, OS%Time, OS%diag)
+ call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles)
call disable_averaging(OS%diag)
if (OS%fluxes%fluxes_used) then
@@ -576,28 +685,20 @@ 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)
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.
-!
-!
-subroutine ocean_model_restart(OS, timestamp)
+!> This subroutine writes out the ocean model restart file.
+subroutine ocean_model_restart(OS, timestamp, restartname)
type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the
!! internal ocean state being saved to a restart file
character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be
!! prepended to the file name. (Currently this is unused.)
+ character(len=*), optional, intent(in) :: restartname !< Name of restart file to use
+ !! This option distinguishes the cesm interface from the
+ !! non-cesm interface
if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) &
call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//&
@@ -607,54 +708,56 @@ subroutine ocean_model_restart(OS, timestamp)
"was called with unused buoyancy fluxes. For conservation, the ocean "//&
"restart files can only be created after the buoyancy forcing is applied.")
- if (BTEST(OS%Restart_control,1)) then
- call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
- OS%restart_CSp, .true., GV=OS%GV)
- call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
- OS%dirs%restart_output_dir, .true.)
- if (OS%use_ice_shelf) then
- call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.)
- endif
- endif
- if (BTEST(OS%Restart_control,0)) then
- call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
- OS%restart_CSp, GV=OS%GV)
- call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
- OS%dirs%restart_output_dir)
- if (OS%use_ice_shelf) then
- call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir)
- endif
- endif
+ if (present(restartname)) then
+ call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
+ OS%restart_CSp, GV=OS%GV, filename=restartname)
+ call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
+ OS%dirs%restart_output_dir) ! Is this needed?
+ if (OS%use_ice_shelf) then
+ call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, &
+ OS%dirs%restart_output_dir)
+ endif
+ else
+ if (BTEST(OS%Restart_control,1)) then
+ call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
+ OS%restart_CSp, .true., GV=OS%GV)
+ call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
+ OS%dirs%restart_output_dir, .true.)
+ if (OS%use_ice_shelf) then
+ call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.)
+ endif
+ endif
+ if (BTEST(OS%Restart_control,0)) then
+ call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
+ OS%restart_CSp, GV=OS%GV)
+ call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
+ OS%dirs%restart_output_dir)
+ if (OS%use_ice_shelf) then
+ call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir)
+ endif
+ endif
+ end if
end subroutine ocean_model_restart
! NAME="ocean_model_restart"
-!=======================================================================
-!
-!
-!
-! Close down the ocean model
-!
-
-!> Terminates the model run, saving the ocean state in a
-!! restart file and deallocating any data associated with the ocean.
+!> 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)
- type(ocean_public_type), intent(inout) :: Ocean_sfc !< An ocean_public_type structure that is to be
- !! deallocated upon termination.
- type(ocean_state_type), pointer :: Ocean_state!< pointer to the structure containing the internal
- ! !! ocean state to be deallocated upon termination.
- type(time_type), intent(in) :: Time !< The model time, used for writing restarts.
-
+ type(ocean_public_type), intent(inout) :: Ocean_sfc !< An ocean_public_type structure that is
+ !! to be deallocated upon termination.
+ type(ocean_state_type), pointer :: Ocean_state !< A pointer to the structure containing
+ !! the internal ocean state to be deallocated
+ !! upon termination.
+ type(time_type), intent(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, end_diag_manager=.true.)
! print time stats
call MOM_infra_end
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.
@@ -666,12 +769,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.
@@ -685,11 +782,8 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix)
"was called with unused buoyancy fluxes. For conservation, the ocean "//&
"restart files can only be created after the buoyancy forcing is applied.")
- if (present(directory)) then
- restart_dir = directory
- else
- restart_dir = OS%dirs%restart_output_dir
- endif
+ if (present(directory)) then ; restart_dir = directory
+ else ; restart_dir = OS%dirs%restart_output_dir ; endif
call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV)
@@ -701,23 +795,25 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix)
end subroutine ocean_model_save_restart
-!=======================================================================
-
-!> Initializes domain and state variables contained in the ocean public type.
+!> 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 !< The FMS domain for the input structure
- type(ocean_public_type), intent(inout) :: Ocean_sfc !< Ocean surface state
- type(diag_ctrl), intent(in) :: diag !< A structure used to control diagnostics.
- logical, intent(in), optional :: maskmap(:,:) !< A pointer to an array indicating which
- !! logical processors are actually used for the ocean code.
+ 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 !< 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
- !! in the calculation of additional gas or other
- !! tracer fluxes.
- ! local variables
+ !! ocean and surface-ice fields that will participate
+ !! in the calculation of additional gas or other
+ !! tracer fluxes.
integer :: xsz, ysz, layout(2)
+ ! ice-ocean-boundary fields are always allocated using absolute indicies
+ ! and have no halos.
integer :: isc, iec, jsc, jec
call mpp_get_layout(input_domain,layout)
@@ -757,25 +853,31 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap,
end subroutine initialize_ocean_public_type
-!> Translates the coupler's ocean_data_type into MOM6's surface state variable.
-!! This may eventually be folded into the MOM6's code that calculates the
-!! surface state in the first place.
-subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z)
- type(surface), intent(inout) :: state
- type(ocean_public_type), target, intent(inout) :: Ocean_sfc !< Ocean surface state
- type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
- real, optional, intent(in) :: patm(:,:) !< Atmospheric pressure.
- real, optional, intent(in) :: press_to_z !< Factor to tranform atmospheric
- !! pressure to z?
-
- ! local variables
+!> 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 !< 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
integer :: i, j, i0, j0, is, ie, js, je
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
- call pass_vector(state%u,state%v,G%Domain)
+ call pass_vector(sfc_state%u,sfc_state%v,G%Domain)
call mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, &
jsc_bnd, jec_bnd)
@@ -786,55 +888,76 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z)
endif
i0 = is - isc_bnd ; j0 = js - jsc_bnd
- if (state%T_is_conT) then
+ if (sfc_state%T_is_conT) then
! Convert the surface T from conservative T to potential T.
do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
- Ocean_sfc%t_surf(i,j) = gsw_pt_from_ct(state%SSS(i+i0,j+j0), &
- state%SST(i+i0,j+j0)) + CELSIUS_KELVIN_OFFSET
+ Ocean_sfc%t_surf(i,j) = gsw_pt_from_ct(sfc_state%SSS(i+i0,j+j0), &
+ sfc_state%SST(i+i0,j+j0)) + CELSIUS_KELVIN_OFFSET
enddo ; enddo
else
do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
- Ocean_sfc%t_surf(i,j) = state%SST(i+i0,j+j0) + CELSIUS_KELVIN_OFFSET
+ Ocean_sfc%t_surf(i,j) = sfc_state%SST(i+i0,j+j0) + CELSIUS_KELVIN_OFFSET
enddo ; enddo
endif
- if (state%S_is_absS) then
+ if (sfc_state%S_is_absS) then
! Convert the surface S from absolute salinity to practical salinity.
do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
- Ocean_sfc%s_surf(i,j) = gsw_sp_from_sr(state%SSS(i+i0,j+j0))
+ Ocean_sfc%s_surf(i,j) = gsw_sp_from_sr(sfc_state%SSS(i+i0,j+j0))
+ enddo ; enddo
+ else
+ do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
+ Ocean_sfc%s_surf(i,j) = sfc_state%SSS(i+i0,j+j0)
+ enddo ; enddo
+ endif
+
+ if (present(patm)) then
+ do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
+ Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z
+ Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0)
enddo ; enddo
else
do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
- Ocean_sfc%s_surf(i,j) = state%SSS(i+i0,j+j0)
+ Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0)
+ Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0)
+ enddo ; enddo
+ endif
+
+ if (associated(sfc_state%frazil)) then
+ do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
+ Ocean_sfc%frazil(i,j) = sfc_state%frazil(i+i0,j+j0)
enddo ; enddo
endif
- 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)) &
- Ocean_sfc%frazil(i,j) = state%frazil(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 (allocated(sfc_state%melt_potential)) then
+ do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
+ Ocean_sfc%melt_potential(i,j) = sfc_state%melt_potential(i+i0,j+j0)
+ enddo ; enddo
+ endif
+
+ if (allocated(sfc_state%Hml)) then
+ do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
+ Ocean_sfc%OBLD(i,j) = sfc_state%Hml(i+i0,j+j0)
+ enddo ; enddo
+ endif
if (Ocean_sfc%stagger == AGRID) then
do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
- Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0)*0.5*(state%u(I+i0,j+j0)+state%u(I-1+i0,j+j0))
- Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0)*0.5*(state%v(i+i0,J+j0)+state%v(i+i0,J-1+j0))
+ Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0) * &
+ 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I-1+i0,j+j0))
+ Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0) * &
+ 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0,J-1+j0))
enddo ; enddo
elseif (Ocean_sfc%stagger == BGRID_NE) then
do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
- Ocean_sfc%u_surf(i,j) = G%mask2dBu(I+i0,J+j0)*0.5*(state%u(I+i0,j+j0)+state%u(I+i0,j+j0+1))
- Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0)*0.5*(state%v(i+i0,J+j0)+state%v(i+i0+1,J+j0))
+ Ocean_sfc%u_surf(i,j) = G%mask2dBu(I+i0,J+j0) * &
+ 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I+i0,j+j0+1))
+ Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0) * &
+ 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0+1,J+j0))
enddo ; enddo
elseif (Ocean_sfc%stagger == CGRID_NE) then
do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
- Ocean_sfc%u_surf(i,j) = G%mask2dCu(I+i0,j+j0)*state%u(I+i0,j+j0)
- Ocean_sfc%v_surf(i,j) = G%mask2dCv(i+i0,J+j0)*state%v(i+i0,J+j0)
+ Ocean_sfc%u_surf(i,j) = G%mask2dCu(I+i0,j+j0)*sfc_state%u(I+i0,j+j0)
+ Ocean_sfc%v_surf(i,j) = G%mask2dCv(i+i0,J+j0)*sfc_state%v(i+i0,J+j0)
enddo ; enddo
else
write(val_str, '(I8)') Ocean_sfc%stagger
@@ -842,25 +965,25 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z)
"Ocean_sfc%stagger has the unrecognized value of "//trim(val_str))
endif
- if (coupler_type_initialized(state%tr_fields)) then
+ if (coupler_type_initialized(sfc_state%tr_fields)) then
if (.not.coupler_type_initialized(Ocean_sfc%fields)) then
call MOM_error(FATAL, "convert_state_to_ocean_type: "//&
"Ocean_sfc%fields has not been initialized.")
endif
- call coupler_type_copy_data(state%tr_fields, Ocean_sfc%fields)
+ call coupler_type_copy_data(sfc_state%tr_fields, Ocean_sfc%fields)
endif
end subroutine convert_state_to_ocean_type
-!> This subroutine extracts the surface properties from the ocean's internal
+!> 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 !< A pointer to the structure containing the
- !! internal ocean state (in).
- type(ocean_public_type), intent(inout) :: Ocean_sfc !< Ocean surface state
-
+ 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
@@ -872,9 +995,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
@@ -899,16 +1019,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
@@ -944,13 +1061,18 @@ subroutine Ocean_stock_pe(OS, index, value, time_index)
end subroutine Ocean_stock_pe
+!> 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
@@ -1006,33 +1128,39 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc)
case('sin_rot')
array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0
case default
- call MOM_error(FATAL,'ocean_model_data2D_get: unknown argument name='//name)
+ 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
select case(name)
case('c_p')
- value = OS%C_p
+ value = OS%C_p
case default
- call MOM_error(FATAL,'ocean_model_data1D_get: unknown argument name='//name)
+ 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()
@@ -1043,28 +1171,20 @@ 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)
+
end subroutine ocean_public_type_chksum
-!=======================================================================
-!
-!
-!
-! Obtain the ocean grid.
-!
-!
subroutine get_ocean_grid(OS, Gridp)
+ ! Obtain the ocean grid.
type(ocean_state_type) :: OS
- type(ocean_grid_type) , pointer :: Gridp
+ type(ocean_grid_type) , pointer :: Gridp
Gridp => OS%grid
return
-
end subroutine get_ocean_grid
-! NAME="get_ocean_grid"
-end module MOM_ocean_model
+end module MOM_ocean_model_mct
diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90
similarity index 66%
rename from config_src/mct_driver/MOM_surface_forcing.F90
rename to config_src/mct_driver/mom_surface_forcing_mct.F90
index 5d30f3c9cb..100b08e678 100644
--- a/config_src/mct_driver/MOM_surface_forcing.F90
+++ b/config_src/mct_driver/mom_surface_forcing_mct.F90
@@ -1,4 +1,4 @@
-module MOM_surface_forcing
+module MOM_surface_forcing_mct
! This file is part of MOM6. See LICENSE.md for the license.
@@ -35,42 +35,39 @@ module MOM_surface_forcing
use coupler_types_mod, only : coupler_type_copy_data
use data_override_mod, only : data_override_init, data_override
use fms_mod, only : stdout
-use fms_mod, only : read_data
use mpp_mod, only : mpp_chksum
use time_interp_external_mod, only : init_external_field, time_interp_external
use time_interp_external_mod, only : time_interp_external_init
-! MCT specfic routines
-use ocn_cpl_indices, only : cpl_indices_type
-
implicit none ; private
#include
-public IOB_allocate
public convert_IOB_to_fluxes
public convert_IOB_to_forces
public surface_forcing_init
-public ice_ocn_bnd_type_chksum
public forcing_save_restart
-public apply_flux_adjustments
+public ice_ocn_bnd_type_chksum
+
+private apply_flux_adjustments
+private apply_force_adjustments
+private surface_forcing_end
!> Contains pointers to the forcing fields which may be used to drive MOM.
!! All fluxes are positive downward.
-type, public :: surface_forcing_CS ;
+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. CIME uses AGRID, so this option
- !! is being hard coded for now.
- logical :: use_temperature !< If true, temp and saln used as state variables
+ !! 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 [m2]
- real :: latent_heat_fusion !< Latent heat of fusion [J kg-1]
- real :: latent_heat_vapor !< Latent heat of vaporization [J kg-1]
+ real :: area_surf = -1.0 !< total ocean surface area [m2]
+ real :: latent_heat_fusion !< latent heat of fusion [J kg-1]
+ real :: latent_heat_vapor !< latent heat of vaporization [J kg-1]
+
real :: max_p_surf !< maximum surface pressure that can be
!! exerted by the atmosphere and floating sea-ice,
!! [Pa]. This is needed because the FMS coupling
@@ -86,132 +83,126 @@ module MOM_surface_forcing
!! 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.
+ !! bottom boundary layer by drag on the tidal flows [W m-2]
gust => NULL(), & !< spatially varying unresolved background
- !! gustiness that contributes to ustar (Pa).
+ !! 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-1]
- real :: cd_tides !< drag coefficient that applies to the tides (nondimensional)
- real :: utide !< constant tidal velocity to use if read_tideamp
- !! is false [m s-1].
+ 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 [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 :: G_Earth !< Gravitational acceleration [m s-2]
- real :: Kv_sea_ice !< viscosity in sea-ice that resists sheared vertical motions [m2 s-1]
- 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 :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m2 s-1]
+ 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.
+ !! 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-1]
- 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)
+ 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 :: 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)
+ !< 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
+ 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
+ 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
+ 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.
+
type(forcing_diags), public :: handles !< diagnostics handles
- type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< restart pointer
- type(user_revise_forcing_CS), pointer :: urf_CS => NULL()!< user revise pointer
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< restart pointer
+ type(user_revise_forcing_CS), pointer :: urf_CS => NULL() !< user revise pointer
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.
+!> Structure corresponding to forcing, but with the elements, units, and conventions
+!! that exactly conform to the use for MOM-based coupled models.
type, public :: ice_ocean_boundary_type
- real, pointer, dimension(:,:) :: latent_flux =>NULL() !< latent flux (W/m2)
- real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (W/m2)
- real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (W/m2)
- real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa)
- real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa)
- real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux (W/m2)
- real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux (W/m2)
- real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< water flux due to sea ice and snow melting (kg/m2/s)
- real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux (kg/m2/s)
- real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux (kg/m2/s)
- real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2)
- real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation (W/m2)
- real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation (W/m2)
- real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation (W/m2)
- real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation (W/m2)
- real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip (kg/m2/s)
- 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(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m s-1]
- real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2)
- real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2)
- real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff (W/m2)
- real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff (W/m2)
- real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere
- !< on ocean surface (Pa)
- real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice (kg/m2)
- real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and
- !! 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.
+ real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff [W/m2]
+ real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff [W/m2]
+ real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress [Pa]
+ real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress [Pa]
+ real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux [W/m2]
+ real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux [kg/m2/s]
+ real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux [kg/m2/s]
+ real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux [W/m2]
+ real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< water flux due to sea ice and snow melting [kg/m2/s]
+ real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation [W/m2]
+ real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation [W/m2]
+ real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation [W/m2]
+ real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation [W/m2]
+ real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation [W/m2]
+ real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip [kg/m2/s]
+ 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(:,:) :: 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)
+ real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff [W/m2]
+ real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff [W/m2]
+ real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere
+ !< on ocean surface [Pa]
+ real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice [kg/m2]
+ real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and
+ !! 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.
end type ice_ocean_boundary_type
integer :: id_clock_forcing
-!=======================================================================
contains
-!=======================================================================
-
-!> This function has a few purposes: 1) it allocates and initializes the data
-!! in the fluxes structure; 2) it imports surface fluxes using data from
-!! the coupler; and 3) it can apply restoring in SST and SSS.
-!! See \ref section_ocn_import for a summary of the surface fluxes that are
-!! passed from MCT to MOM6, including fluxes that need to be included in
-!! the future.
-subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
+
+!> 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, US, CS, &
sfc_state, restore_salt, restore_temp)
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
!! salinity to the right time, when it is being restored.
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
@@ -225,34 +216,37 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
! local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
- data_restore, & ! The surface value toward which to restore (g/kg or degC)
- SST_anom, & ! Instantaneous sea surface temperature anomalies from a target value (deg C)
- SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target value (g/kg)
- SSS_mean, & ! A (mean?) salinity about which to normalize local salinity
- ! anomalies when calculating restorative precipitation anomalies (g/kg)
- PmE_adj, & ! The adjustment to PminusE that will cause the salinity
- ! to be restored toward its target value (kg/(m^2 * s))
- net_FW, & ! The area integrated net freshwater flux into the ocean (kg/s)
- net_FW2, & ! The area integrated net freshwater flux into the ocean (kg/s)
- work_sum, & ! A 2-d array that is used as the work space for a global
- ! sum, used with units of m2 or (kg/s)
- open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria
-
- integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0
+ data_restore, & !< The surface value toward which to restore [g/kg or degC]
+ SST_anom, & !< Instantaneous sea surface temperature anomalies from a target value [deg C]
+ SSS_anom, & !< Instantaneous sea surface salinity anomalies from a target value [g/kg]
+ SSS_mean, & !< A (mean?) salinity about which to normalize local salinity
+ !! anomalies when calculating restorative precipitation anomalies [g/kg]
+ PmE_adj, & !< The adjustment to PminusE that will cause the salinity
+ !! to be restored toward its target value [kg/(m^2 * s)]
+ net_FW, & !< The area integrated net freshwater flux into the ocean [kg/s]
+ net_FW2, & !< The area integrated net freshwater flux into the ocean [kg/s]
+ work_sum, & !< A 2-d array that is used as the work space for a global
+ !! sum, used with units of m2 or [kg/s]
+ open_ocn_mask !< a binary field indicating where ice is present based on frazil criteria
+
+ 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
- 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
+ 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
- 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.
+ 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)
+ isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2)
+ jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4)
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
@@ -287,6 +281,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed)
call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed)
+ if (CS%use_limited_P_SSH) then
+ fluxes%p_surf_SSH => fluxes%p_surf
+ else
+ fluxes%p_surf_SSH => fluxes%p_surf_full
+ endif
call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed)
call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed)
@@ -310,11 +309,26 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
fluxes%dt_buoy_accum = 0.0
endif ! endif for allocation and initialization
+
+ if (((associated(IOB%ustar_berg) .and. (.not.associated(fluxes%ustar_berg))) &
+ .or. (associated(IOB%area_berg) .and. (.not.associated(fluxes%area_berg)))) &
+ .or. (associated(IOB%mass_berg) .and. (.not.associated(fluxes%mass_berg)))) &
+ call allocate_forcing_type(G, fluxes, iceberg=.true.)
+
+ if ((.not.coupler_type_initialized(fluxes%tr_fluxes)) .and. &
+ coupler_type_initialized(IOB%fluxes)) &
+ call coupler_type_spawn(IOB%fluxes, fluxes%tr_fluxes, &
+ (/is,is,ie,ie/), (/js,js,je,je/))
+ ! It might prove valuable to use the same array extents as the rest of the
+ ! 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
endif
+ ! allocation and initialization on first call to this routine
if (CS%area_surf < 0.0) then
do j=js,je ; do i=is,ie
work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j)
@@ -342,7 +356,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
delta_sss = data_restore(i,j)- sfc_state%SSS(i,j)
delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore)
fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* &
- (CS%basin_mask(i,j)*open_ocn_mask(i,j)) *delta_sss ! kg Salt m-2 s-1
+ (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! kg Salt m-2 s-1
enddo; enddo
if (CS%adjust_net_srestore_to_zero) then
if (CS%adjust_net_srestore_by_scaling) then
@@ -360,7 +374,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
if (G%mask2dT(i,j) > 0.5) then
delta_sss = sfc_state%SSS(i,j) - data_restore(i,j)
delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore)
- fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j))* &
+ fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j))* &
(CS%Rho0*CS%Flux_const) * &
delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j)))
endif
@@ -386,77 +400,79 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
do j=js,je ; do i=is,ie
delta_sst = data_restore(i,j)- sfc_state%SST(i,j)
delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore)
- fluxes%heat_added(i,j) = G%mask2dT(i,j) * (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2
+ fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * &
+ (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2
enddo; enddo
endif
- ! obtain fluxes from IOB
+ ! obtain fluxes from IOB; note the staggering of indices
i0 = 0; j0 = 0
do j=js,je ; do i=is,ie
! liquid precipitation (rain)
- if (associated(fluxes%lprec)) &
- fluxes%lprec(i,j) = G%mask2dT(i,j) * IOB%lprec(i-i0,j-j0)
+ if (associated(IOB%lprec)) &
+ fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j)
! frozen precipitation (snow)
- if (associated(fluxes%fprec)) &
- fluxes%fprec(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)
+ if (associated(IOB%fprec)) &
+ fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j)
! evaporation
- if (associated(fluxes%evap)) &
- fluxes%evap(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)
+ if (associated(IOB%q_flux)) &
+ fluxes%evap(i,j) = IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j)
- ! river runoff flux
- if (associated(fluxes%lrunoff)) &
- fluxes%lrunoff(i,j) = G%mask2dT(i,j) * IOB%rofl_flux(i-i0,j-j0)
+ ! liquid runoff flux
+ if (associated(IOB%rofl_flux)) then
+ fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j)
+ else if (associated(IOB%runoff)) then
+ fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j)
+ end if
! ice runoff flux
- if (associated(fluxes%frunoff)) &
- fluxes%frunoff(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)
-
- ! GMM, we don't have an icebergs yet so the following is not needed
- !if (((associated(IOB%ustar_berg) .and. (.not. associated(fluxes%ustar_berg))) &
- ! .or. (associated(IOB%area_berg) .and. (.not. associated(fluxes%area_berg)))) &
- ! .or. (associated(IOB%mass_berg) .and. (.not. associated(fluxes%mass_berg)))) &
- ! call allocate_forcing_type(G, fluxes, iceberg=.true.)
- !if (associated(IOB%ustar_berg)) &
- ! fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j)
- !if (associated(IOB%area_berg)) &
- ! fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j)
- !if (associated(IOB%mass_berg)) &
- ! fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j)
+ if (associated(IOB%rofi_flux)) then
+ fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j)
+ else if (associated(IOB%calving)) then
+ fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j)
+ end if
+
+ if (associated(IOB%ustar_berg)) &
+ fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j)
+
+ if (associated(IOB%area_berg)) &
+ fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j)
+
+ if (associated(IOB%mass_berg)) &
+ fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j)
! GMM, cime does not not have an equivalent for heat_content_lrunoff and
! heat_content_frunoff. I am seeting these to zero for now.
if (associated(fluxes%heat_content_lrunoff)) &
fluxes%heat_content_lrunoff(i,j) = 0.0 * G%mask2dT(i,j)
-
if (associated(fluxes%heat_content_frunoff)) &
fluxes%heat_content_frunoff(i,j) = 0.0 * G%mask2dT(i,j)
+ if (associated(IOB%calving_hflx)) &
+ fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j)
+
! longwave radiation, sum up and down (W/m2)
- if (associated(fluxes%LW)) &
- fluxes%LW(i,j) = G%mask2dT(i,j) * IOB%lw_flux(i-i0,j-j0)
+ if (associated(IOB%lw_flux)) &
+ fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j)
! sensible heat flux (W/m2)
- if (associated(fluxes%sens)) &
- fluxes%sens(i,j) = G%mask2dT(i,j) * IOB%t_flux(i-i0,j-j0)
+ if (associated(IOB%t_flux)) &
+ fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j)
- ! sea ice and snow melt heat flux (W/m2)
- if (associated(fluxes%seaice_melt_heat)) &
- fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0)
+ ! sea ice and snow melt heat flux [W/m2]
+ if (associated(IOB%seaice_melt_heat)) &
+ fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0)
- ! water flux due to sea ice and snow melt (kg/m2/s)
- if (associated(fluxes%seaice_melt)) &
- fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0)
+ ! water flux due to sea ice and snow melt [kg/m2/s]
+ if (associated(IOB%seaice_melt)) &
+ fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0)
! latent heat flux (W/m^2)
- ! old method, latent = IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor
- !if (associated(fluxes%latent)) &
- ! fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0)
- ! new method
fluxes%latent(i,j) = 0.0
! contribution from frozen ppt
- if (associated(fluxes%fprec)) then
+ if (associated(IOB%fprec)) then
fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion
fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion
endif
@@ -474,25 +490,43 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
if (associated(IOB%sw_flux_vis_dir)) &
fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0)
+
if (associated(IOB%sw_flux_vis_dif)) &
fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0)
+
if (associated(IOB%sw_flux_nir_dir)) &
fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0)
+
if (associated(IOB%sw_flux_nir_dif)) &
fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0)
fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + &
fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j)
- ! salt flux
- ! more salt restoring logic
- if (associated(fluxes%salt_flux)) &
- fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0))
+ enddo; enddo
- if (associated(fluxes%salt_flux_in)) &
- fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*(-IOB%salt_flux(i-i0,j-j0))
+ ! applied surface pressure from atmosphere and cryosphere
+ if (associated(IOB%p)) then
+ if (CS%max_p_surf >= 0.0) then
+ do j=js,je ; do i=is,ie
+ fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0)
+ fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf)
+ enddo; enddo
+ else
+ do j=js,je ; do i=is,ie
+ fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0)
+ fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j)
+ enddo; enddo
+ endif
+ fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure.
+ endif
- enddo; enddo
+ if (associated(IOB%salt_flux)) then
+ do j=js,je ; do i=is,ie
+ fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(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
+ endif
! adjust the NET fresh-water flux to zero, if flagged
if (CS%adjust_net_fresh_water_to_zero) then
@@ -502,17 +536,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + &
(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + &
(fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j)
- ! The following contribution appears to be calculating the volume flux of sea-ice
- ! melt. This calculation is clearly WRONG if either sea-ice has variable
- ! salinity or the sea-ice is completely fresh.
- ! 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
- ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and
- ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively.
- 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)
net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j)
enddo; enddo
@@ -530,6 +553,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
endif
endif
+ if (coupler_type_initialized(fluxes%tr_fluxes) .and. &
+ coupler_type_initialized(IOB%fluxes)) &
+ call coupler_type_copy_data(IOB%fluxes, fluxes%tr_fluxes)
+
if (CS%allow_flux_adjustments) then
! Apply adjustments to fluxes
call apply_flux_adjustments(G, CS, Time, fluxes)
@@ -542,8 +569,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, &
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.
@@ -560,52 +585,53 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a
!! previous call to surface_forcing_init.
+ ! local variables
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)
+ taux_at_q, & !< Zonal wind stresses at q points [Pa]
+ tauy_at_q !< Meridional wind stresses at q points [Pa]
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)
-
- 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_Earth [s2 m-1]
- real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) )
- real :: mass_ice ! mass of sea ice at a face (kg/m^2)
- real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2)
-
- integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains)
+ 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]
+
+ real :: gustiness !< unresolved gustiness that contributes to ustar [Pa]
+ real :: Irho0 !< inverse of the mean density in [m3 kg-1]
+ real :: taux2, tauy2 !< squared wind stresses [Pa2]
+ real :: tau_mag !< magnitude of the wind stress [Pa]
+ real :: I_GEarth !< 1.0 / G%G_Earth [s2 m-1]
+ real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1]
+ real :: mass_ice !< mass of sea ice at a face [kg m-2]
+ real :: mass_eff !< effective mass of sea ice for rigidity [kg m-2]
+
+ 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
call cpu_clock_begin(id_clock_forcing)
+ isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2)
+ jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4)
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
isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1
-
- !isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2)
- !jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4)
- !if (is_root_pe()) write(*,*)'isc_bnd, jsc_bnd, iec_bnd, jec_bnd',isc_bnd, jsc_bnd, iec_bnd, jec_bnd
!i0 = is - isc_bnd ; j0 = js - jsc_bnd
- i0 = 0; j0 = 0 ! TODO: is this right?
+ i0 = 0; j0 = 0
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
- call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., &
- press=.true.)
+
+ call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true.)
+
call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed)
call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed)
+
if (CS%rigid_sea_ice) then
call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed)
call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB)
@@ -614,29 +640,44 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
forces%initialized = .true.
endif
+ 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)
+ call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB)
+ endif
+
+ forces%accumulate_rigidity = .true. ! Multiple components may contribute to rigidity.
if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0
if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0
!applied surface pressure from atmosphere and cryosphere
- !sea-level pressure (Pa)
- do j=js,je ; do i=is,ie
- if (associated(forces%p_surf_full) .and. associated(forces%p_surf)) then
- forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0)
-
- if (CS%max_p_surf >= 0.0) then
+ if (CS%use_limited_P_SSH) then
+ forces%p_surf_SSH => forces%p_surf
+ else
+ forces%p_surf_SSH => forces%p_surf_full
+ endif
+ if (associated(IOB%p)) then
+ if (CS%max_p_surf >= 0.0) then
+ do j=js,je ; do i=is,ie
+ forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0)
forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf)
- else
+ enddo ; enddo
+ else
+ do j=js,je ; do i=is,ie
+ forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0)
forces%p_surf(i,j) = forces%p_surf_full(i,j)
- endif
-
+ enddo ; enddo
endif
- enddo; enddo
-
- if (CS%use_limited_P_SSH) then
- forces%p_surf_SSH => forces%p_surf
else
- forces%p_surf_SSH => forces%p_surf_full
+ do j=js,je ; do i=is,ie
+ forces%p_surf_full(i,j) = 0.0
+ forces%p_surf(i,j) = 0.0
+ enddo ; enddo
endif
+ forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure.
! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later
wind_stagger = AGRID
@@ -652,6 +693,15 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
! 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
@@ -669,7 +719,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
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)
+ 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
@@ -706,7 +756,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
enddo; enddo
elseif (wind_stagger == AGRID) then
- call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID)
+ 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
@@ -734,7 +784,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
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)
+ call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1)
do j=js,je ; do i=is,ie
taux2 = 0.0
@@ -757,6 +807,18 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
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) + &
+ min(rigidity_at_h(i,j), rigidity_at_h(i+1,j))
+ enddo ; enddo
+ do i=is,ie ; do J=js-1,je
+ forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + &
+ min(rigidity_at_h(i,j), rigidity_at_h(i,j+1))
+ enddo ; enddo
+ endif
+
if (CS%rigid_sea_ice) then
call pass_var(forces%p_surf_full, G%Domain, halo=1)
I_GEarth = 1.0 / CS%G_Earth
@@ -792,129 +854,52 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
call cpu_clock_end(id_clock_forcing)
end subroutine convert_IOB_to_forces
-!=======================================================================
-
-!> Allocates ice-ocean boundary type containers and sets to 0.
-subroutine IOB_allocate(IOB, isc, iec, jsc, jec)
- type(ice_ocean_boundary_type), intent(inout) :: IOB !< An ice-ocean boundary type with fluxes to drive
- integer, intent(in) :: isc, iec, jsc, jec !< The ocean's local grid size
-
- allocate ( IOB% latent_flux (isc:iec,jsc:jec), &
- IOB% rofl_flux (isc:iec,jsc:jec), &
- IOB% rofi_flux (isc:iec,jsc:jec), &
- IOB% u_flux (isc:iec,jsc:jec), &
- IOB% v_flux (isc:iec,jsc:jec), &
- IOB% t_flux (isc:iec,jsc:jec), &
- IOB% seaice_melt_heat (isc:iec,jsc:jec),&
- IOB% seaice_melt (isc:iec,jsc:jec), &
- IOB% q_flux (isc:iec,jsc:jec), &
- IOB% salt_flux (isc:iec,jsc:jec), &
- IOB% lw_flux (isc:iec,jsc:jec), &
- IOB% sw_flux_vis_dir (isc:iec,jsc:jec), &
- IOB% sw_flux_vis_dif (isc:iec,jsc:jec), &
- IOB% sw_flux_nir_dir (isc:iec,jsc:jec), &
- IOB% sw_flux_nir_dif (isc:iec,jsc:jec), &
- IOB% lprec (isc:iec,jsc:jec), &
- IOB% fprec (isc:iec,jsc:jec), &
- IOB% ustar_berg (isc:iec,jsc:jec), &
- IOB% area_berg (isc:iec,jsc:jec), &
- IOB% mass_berg (isc:iec,jsc:jec), &
- IOB% calving (isc:iec,jsc:jec), &
- IOB% runoff_hflx (isc:iec,jsc:jec), &
- IOB% calving_hflx (isc:iec,jsc:jec), &
- IOB% mi (isc:iec,jsc:jec), &
- IOB% p (isc:iec,jsc:jec))
-
- IOB%latent_flux = 0.0
- IOB%rofl_flux = 0.0
- IOB%rofi_flux = 0.0
- IOB%u_flux = 0.0
- IOB%v_flux = 0.0
- IOB%t_flux = 0.0
- IOB%seaice_melt_heat = 0.0
- IOB%seaice_melt = 0.0
- IOB%q_flux = 0.0
- IOB%salt_flux = 0.0
- IOB%lw_flux = 0.0
- IOB%sw_flux_vis_dir = 0.0
- IOB%sw_flux_vis_dif = 0.0
- IOB%sw_flux_nir_dir = 0.0
- IOB%sw_flux_nir_dif = 0.0
- IOB%lprec = 0.0
- IOB%fprec = 0.0
- IOB%ustar_berg = 0.0
- IOB%area_berg = 0.0
- IOB%mass_berg = 0.0
- IOB%calving = 0.0
- IOB%runoff_hflx = 0.0
- IOB%calving_hflx = 0.0
- IOB%mi = 0.0
- IOB%p = 0.0
-
-end subroutine IOB_allocate
-
-!=======================================================================
-
-!> Adds flux adjustments obtained via data_override
+!> Adds thermodynamic flux adjustments obtained via data_override
!! Component name is 'OCN'
!! Available adjustments are:
-!! - taux_adj (Zonal wind stress delta, positive to the east, in Pa)
-!! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa)
+!! - hflx_adj (Heat flux into the ocean, in W m-2)
+!! - sflx_adj (Salt flux into the ocean, in kg salt m-2 s-1)
+!! - prcme_adj (Fresh water flux into the ocean, in kg m-2 s-1)
subroutine apply_flux_adjustments(G, CS, Time, fluxes)
type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure
type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure
type(time_type), intent(in) :: Time !< Model time structure
- type(forcing), optional, intent(inout) :: fluxes !< Surface fluxes structure
+ type(forcing), intent(inout) :: fluxes !< Surface fluxes structure
! Local variables
- real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points (Pa)
- real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points (Pa)
- real, dimension(SZI_(G),SZJ_(G)) :: temp_at_h ! Fluxes at h points (W m-2 or kg m-2 s-1)
+ real, dimension(SZI_(G),SZJ_(G)) :: temp_at_h !< Fluxes at h points [W m-2 or kg m-2 s-1]
integer :: isc, iec, jsc, jec, i, j
- real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau
- logical :: overrode_x, overrode_y, overrode_h
+ logical :: overrode_h
- isc = G%isc; iec = G%iec
- jsc = G%jsc; jec = G%jec
+ isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec
overrode_h = .false.
call data_override('OCN', 'hflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h)
- if (overrode_h) then
- do j=G%jsc,G%jec ; do i=G%isc,G%iec
- fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j)
- enddo; enddo
- endif
-
- call pass_var(fluxes%heat_added, G%Domain)
+ if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec
+ fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j)
+ enddo ; enddo ; endif
+ ! Not needed? ! if (overrode_h) call pass_var(fluxes%heat_added, G%Domain)
overrode_h = .false.
call data_override('OCN', 'sflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h)
- if (overrode_h) then
- do j=G%jsc,G%jec ; do i=G%isc,G%iec
- fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j)
- enddo; enddo
- endif
+ if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec
+ fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j)
+ enddo ; enddo ; endif
+ ! Not needed? ! if (overrode_h) call pass_var(fluxes%salt_flux_added, G%Domain)
- call pass_var(fluxes%salt_flux_added, G%Domain)
overrode_h = .false.
-
call data_override('OCN', 'prcme_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h)
- if (overrode_h) then
- do j=G%jsc,G%jec ; do i=G%isc,G%iec
- fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j)
- enddo; enddo
- endif
-
- call pass_var(fluxes%vprec, G%Domain)
+ if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec
+ fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j)
+ enddo ; enddo ; endif
+ ! Not needed? ! if (overrode_h) call pass_var(fluxes%vprec, G%Domain)
end subroutine apply_flux_adjustments
-!=======================================================================
-
!> Adds mechanical forcing adjustments obtained via data_override
!! Component name is 'OCN'
!! Available adjustments are:
@@ -927,8 +912,8 @@ subroutine apply_force_adjustments(G, CS, Time, forces)
type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces
! Local variables
- real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points (Pa)
- real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points (Pa)
+ real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h !< Delta to zonal wind stress at h points [Pa]
+ real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h !< Delta to meridional wind stress at h points [Pa]
integer :: isc, iec, jsc, jec, i, j
real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau
@@ -973,54 +958,52 @@ subroutine apply_force_adjustments(G, CS, Time, forces)
end subroutine apply_force_adjustments
-!=======================================================================
-
-!> Saves restart fields associated with the forcing
+!> 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 !< pointer to the control structure
- !! returned by a previous call to
- !! surface_forcing_init
+ 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 !< model time at this call
- character(len=*), intent(in) :: directory !< optional directory into which
- !! to write these restart files
- logical, optional, intent(in) :: time_stamped !< If true, the restart file
- !! names include a unique time
- !! stamp
- character(len=*), optional, intent(in) :: filename_suffix !< 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
call save_restart(directory, Time, G, CS%restart_CSp, time_stamped)
end subroutine forcing_save_restart
-!=======================================================================
-
-!> Initializes surface forcing: get relevant parameters and allocate arrays.
+!> Initialize the surface forcing, including setting parameters and allocating permanent memory.
subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, restore_temp)
type(time_type), intent(in) :: Time !< The current model time
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- 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
- logical, optional, intent(in) :: restore_salt, restore_temp !< If present and true,
- !! temp/salt restoring will be applied
+ 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
+ logical, optional, intent(in) :: restore_salt !< If present and true surface salinity
+ !! restoring will be applied in this model.
+ logical, optional, intent(in) :: restore_temp !< If present and true surface temperature
+ !! restoring will be applied in this model.
- ! local variables
- real :: utide !< The RMS tidal velocity [m s-1].
+ ! Local variables
+ real :: utide ! The RMS tidal velocity, in m s-1.
type(directories) :: dirs
logical :: new_sim, iceberg_flux_diags
type(time_type) :: Time_frc
character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names.
! This include declares and sets the variable "version".
#include "version_variable.h"
- character(len=40) :: mdl = "ocn_comp_mct" ! This module's name.
+ character(len=40) :: mdl = "MOM_surface_forcing_mct" ! This module's name.
character(len=48) :: stagger
+ character(len=48) :: flnam
character(len=240) :: basin_file
integer :: i, j, isd, ied, jsd, jed
@@ -1038,7 +1021,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
CS%diag => diag
- call write_version_number (version)
+ call write_version_number(version)
! Read all relevant parameters and write them to the model log.
call log_version(param_file, mdl, version, "")
@@ -1102,11 +1085,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
"limited by max_p_surf instead of the full atmospheric "//&
"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, "WIND_STAGGER", stagger, &
"A case-insensitive character string to indicate the "//&
"staggering of the input wind stress field. Valid "//&
@@ -1158,12 +1136,15 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
basin_file = trim(CS%inputdir) // trim(basin_file)
call safe_alloc_ptr(CS%basin_mask,isd,ied,jsd,jed) ; CS%basin_mask(:,:) = 1.0
if (CS%mask_srestore_marginal_seas) then
- call read_data(basin_file,'basin',CS%basin_mask,domain=G%domain%mpp_domain,timelevel=1)
+ call MOM_read_data(basin_file,'basin',CS%basin_mask,G%domain, timelevel=1)
do j=jsd,jed ; do i=isd,ied
if (CS%basin_mask(i,j) >= 6.0) then ; CS%basin_mask(i,j) = 0.0
else ; CS%basin_mask(i,j) = 1.0 ; endif
enddo ; enddo
endif
+ call get_param(param_file, mdl, "MASK_SRESTORE", CS%mask_srestore, &
+ "If true, read a file (salt_restore_mask) containing "//&
+ "a mask for SSS restoring.", default=.false.)
endif
if (restore_temp) then
@@ -1179,16 +1160,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
"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, &
"The maximum sst difference used in restoring terms.", &
units="degC ", default=999.0)
+ call get_param(param_file, mdl, "MASK_TRESTORE", CS%mask_trestore, &
+ "If true, read a file (temp_restore_mask) containing "//&
+ "a mask for SST restoring.", default=.false.)
endif
-! Optionally read tidal amplitude from input file [m s-1] on model grid.
+! Optionally read tidal amplitude from input file (m s-1) on model grid.
! Otherwise use default tidal amplitude for bottom frictionally-generated
! dissipation. Default cd_tides is chosen to yield approx 1 TWatt of
! work done against tides globally using OSU tidal amplitude.
@@ -1215,7 +1199,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
if (CS%read_TIDEAMP) then
TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file)
- call read_data(TideAmp_file,'tideamp',CS%TKE_tidal,domain=G%domain%mpp_domain,timelevel=1)
+ call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1)
do j=jsd, jed; do i=isd, ied
utide = CS%TKE_tidal(i,j)
CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide)
@@ -1247,8 +1231,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed)
gust_file = trim(CS%inputdir) // trim(gust_file)
- call read_data(gust_file,'gustiness',CS%gust,domain=G%domain%mpp_domain, &
- timelevel=1) ! units should be Pa
+ call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1) ! units should be Pa
endif
! See whether sufficiently thick sea ice should be treated as rigid.
@@ -1289,11 +1272,21 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
if (present(restore_salt)) then ; if (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
+ if (CS%mask_srestore) then ! read a 2-d file containing a mask for restoring fluxes
+ flnam = trim(CS%inputdir) // 'salt_restore_mask.nc'
+ call MOM_read_data(flnam,'mask', CS%srestore_mask, G%domain, timelevel=1)
+ endif
endif ; endif
if (present(restore_temp)) then ; if (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
+ if (CS%mask_trestore) then ! read a 2-d file containing a mask for restoring fluxes
+ flnam = trim(CS%inputdir) // 'temp_restore_mask.nc'
+ call MOM_read_data(flnam, 'mask', CS%trestore_mask, G%domain, timelevel=1)
+ endif
endif ; endif
! Set up any restart fields associated with the forcing.
@@ -1317,16 +1310,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
call cpu_clock_end(id_clock_forcing)
end subroutine surface_forcing_init
-!=======================================================================
-
-!> Finalizes surface forcing: deallocate surface forcing control structure
+!> 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)
@@ -1335,46 +1326,48 @@ 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
+ 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
+
+ ! local variables
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%seaice_melt_heat', mpp_chksum( iobt%seaice_melt_heat)
- write(outunit,100) 'iobt%seaice_melt ', mpp_chksum( iobt%seaice_melt )
- write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux )
- write(outunit,100) 'iobt%rofl_flux ', mpp_chksum( iobt%rofl_flux )
- write(outunit,100) 'iobt%rofi_flux ', mpp_chksum( iobt%rofi_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%calving ', mpp_chksum( iobt%calving )
- write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p )
+ 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%seaice_melt_heat' , mpp_chksum( iobt%seaice_melt_heat)
+ write(outunit,100) 'iobt%seaice_melt ' , mpp_chksum( iobt%seaice_melt )
+ 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 )
+ 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 )
+ 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 )
+ 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%')
end subroutine ice_ocn_bnd_type_chksum
-end module MOM_surface_forcing
+end module MOM_surface_forcing_mct
diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90
index 7723f51a6c..b42fa8ca7e 100644
--- a/config_src/mct_driver/ocn_cap_methods.F90
+++ b/config_src/mct_driver/ocn_cap_methods.F90
@@ -1,13 +1,13 @@
module ocn_cap_methods
- use ESMF, only: ESMF_clock, ESMF_time, ESMF_ClockGet, ESMF_TimeGet
- use MOM_ocean_model, only: ocean_public_type, ocean_state_type
- use MOM_surface_forcing, only: ice_ocean_boundary_type
- use MOM_grid, only: ocean_grid_type
- use MOM_domains, only: pass_var
- use MOM_error_handler, only: is_root_pe
- use mpp_domains_mod, only: mpp_get_compute_domain
- use ocn_cpl_indices, only: cpl_indices_type
+ use ESMF, only: ESMF_clock, ESMF_time, ESMF_ClockGet, ESMF_TimeGet
+ use MOM_ocean_model_mct, only: ocean_public_type, ocean_state_type
+ use MOM_surface_forcing_mct, only: ice_ocean_boundary_type
+ use MOM_grid, only: ocean_grid_type
+ use MOM_domains, only: pass_var
+ use MOM_error_handler, only: is_root_pe
+ use mpp_domains_mod, only: mpp_get_compute_domain
+ use ocn_cpl_indices, only: cpl_indices_type
implicit none
private
@@ -71,9 +71,6 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit,
! sensible heat flux (W/m2)
ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k)
- ! latent heat flux (W/m^2)
- ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k)
-
! snow&ice melt heat flux (W/m^2)
ice_ocean_boundary%seaice_melt_heat(i,j) = x2o(ind%x2o_Fioi_melth,k)
@@ -89,8 +86,8 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit,
! surface pressure
ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(i,j)
- ! salt flux (minus sign needed here -GMM)
- ice_ocean_boundary%salt_flux(i,j) = -x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(i,j)
+ ! salt flux
+ ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(i,j)
! 1) visible, direct shortwave (W/m2)
! 2) visible, diffuse shortwave (W/m2)
@@ -127,8 +124,6 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit,
day,secs,j,i,ice_ocean_boundary%seaice_melt_heat(i,j)
write(logunit,F01)'import: day, secs, j, i, seaice_melt = ',&
day,secs,j,i,ice_ocean_boundary%seaice_melt(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 = ',&
diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90
index 5698335b6f..5b581e0427 100644
--- a/config_src/mct_driver/ocn_comp_mct.F90
+++ b/config_src/mct_driver/ocn_comp_mct.F90
@@ -24,8 +24,6 @@ module ocn_comp_mct
shr_file_getLogUnit, shr_file_getLogLevel, &
shr_file_setLogUnit, shr_file_setLogLevel
-use MOM_surface_forcing, only: IOB_allocate, ice_ocean_boundary_type
-
! MOM6 modules
use MOM, only: extract_surface_state
use MOM_variables, only: surface
@@ -46,10 +44,10 @@ module ocn_comp_mct
use mpp_domains_mod, only: mpp_get_compute_domain
! Previously inlined - now in separate modules
-use MOM_ocean_model, only: ocean_public_type, ocean_state_type
-use MOM_ocean_model, only: ocean_model_init , update_ocean_model, ocean_model_end
-use MOM_ocean_model, only: convert_state_to_ocean_type
-use MOM_surface_forcing, only: surface_forcing_CS, forcing_save_restart
+use MOM_ocean_model_mct, only: ocean_public_type, ocean_state_type
+use MOM_ocean_model_mct, only: ocean_model_init , update_ocean_model, ocean_model_end
+use MOM_ocean_model_mct, only: convert_state_to_ocean_type
+use MOM_surface_forcing_mct, only: surface_forcing_CS, forcing_save_restart, ice_ocean_boundary_type
use ocn_cap_methods, only: ocn_import, ocn_export
! FMS modules
@@ -813,4 +811,61 @@ end subroutine ocean_model_init_sfc
!! CO2
!! DMS
+!> Allocates ice-ocean boundary type containers and sets to 0.
+subroutine IOB_allocate(IOB, isc, iec, jsc, jec)
+ type(ice_ocean_boundary_type), intent(inout) :: IOB !< An ice-ocean boundary type with fluxes to drive
+ integer, intent(in) :: isc, iec, jsc, jec !< The ocean's local grid size
+
+ allocate ( IOB% rofl_flux (isc:iec,jsc:jec), &
+ IOB% rofi_flux (isc:iec,jsc:jec), &
+ IOB% u_flux (isc:iec,jsc:jec), &
+ IOB% v_flux (isc:iec,jsc:jec), &
+ IOB% t_flux (isc:iec,jsc:jec), &
+ IOB% seaice_melt_heat (isc:iec,jsc:jec),&
+ IOB% seaice_melt (isc:iec,jsc:jec), &
+ IOB% q_flux (isc:iec,jsc:jec), &
+ IOB% salt_flux (isc:iec,jsc:jec), &
+ IOB% lw_flux (isc:iec,jsc:jec), &
+ IOB% sw_flux_vis_dir (isc:iec,jsc:jec), &
+ IOB% sw_flux_vis_dif (isc:iec,jsc:jec), &
+ IOB% sw_flux_nir_dir (isc:iec,jsc:jec), &
+ IOB% sw_flux_nir_dif (isc:iec,jsc:jec), &
+ IOB% lprec (isc:iec,jsc:jec), &
+ IOB% fprec (isc:iec,jsc:jec), &
+ IOB% ustar_berg (isc:iec,jsc:jec), &
+ IOB% area_berg (isc:iec,jsc:jec), &
+ IOB% mass_berg (isc:iec,jsc:jec), &
+ IOB% calving (isc:iec,jsc:jec), &
+ IOB% runoff_hflx (isc:iec,jsc:jec), &
+ IOB% calving_hflx (isc:iec,jsc:jec), &
+ IOB% mi (isc:iec,jsc:jec), &
+ IOB% p (isc:iec,jsc:jec))
+
+ IOB%rofl_flux = 0.0
+ IOB%rofi_flux = 0.0
+ IOB%u_flux = 0.0
+ IOB%v_flux = 0.0
+ IOB%t_flux = 0.0
+ IOB%seaice_melt_heat = 0.0
+ IOB%seaice_melt = 0.0
+ IOB%q_flux = 0.0
+ IOB%salt_flux = 0.0
+ IOB%lw_flux = 0.0
+ IOB%sw_flux_vis_dir = 0.0
+ IOB%sw_flux_vis_dif = 0.0
+ IOB%sw_flux_nir_dir = 0.0
+ IOB%sw_flux_nir_dif = 0.0
+ IOB%lprec = 0.0
+ IOB%fprec = 0.0
+ IOB%ustar_berg = 0.0
+ IOB%area_berg = 0.0
+ IOB%mass_berg = 0.0
+ IOB%calving = 0.0
+ IOB%runoff_hflx = 0.0
+ IOB%calving_hflx = 0.0
+ IOB%mi = 0.0
+ IOB%p = 0.0
+
+end subroutine IOB_allocate
+
end module ocn_comp_mct
diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90
index 3992aae530..d6a7837c83 100644
--- a/config_src/nuopc_driver/mom_cap.F90
+++ b/config_src/nuopc_driver/mom_cap.F90
@@ -35,11 +35,11 @@
!! of model code, making calls into it and exposing model data structures in a
!! standard way.
!!
-!! The MOM cap package includes the cap code itself (mom_cap.F90, mom_cap_methods.F90
-!! and mom_cap_time.F90), a set of time utilities (time_utils.F90) for converting between ESMF and FMS
-!! time type and two modules MOM_ocean_model.F90 and MOM_surface_forcing.F90. MOM_surface_forcing.F90
+!! The MOM cap package includes the cap code itself (MOM_cap.F90, MOM_cap_methods.F90
+!! and MOM_cap_time.F90), a set of time utilities (time_utils.F90) for converting between ESMF and FMS
+!! time type and two modules MOM_ocean_model_nuopc.F90 and MOM_surface_forcing_nuopc.F90. MOM_surface_forcing_nuopc.F90
!! converts the input ESMF data (import data) to a MOM-specific data type (surface_forcing_CS).
-!! MOM_ocean_model.F90 contains routines for initialization, update and finalization of the ocean model state.
+!! MOM_ocean_model_nuopc.F90 contains routines for initialization, update and finalization of the ocean model state.
!!
!! @subsection CapSubroutines Cap Subroutines
!!
@@ -60,15 +60,15 @@
!!
!! Phase | MOM Cap Subroutine | Description
!! ---------|--------------------------------------------------------------------|--------------------------------------
-!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition
+!! Init | [InitializeP0] (@ref MOM_cap_mod::initializep0) | Sets the Initialize Phase Definition
!! | (IPD) version to use
-!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import
+!! Init | [InitializeAdvertise] (@ref MOM_cap_mod::initializeadvertise) | Advertises standard names of import
!! | and export fields
-!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid or ESMF_Mesh
+!! Init | [InitializeRealize] (@ref MOM_cap_mod::initializerealize) | Creates an ESMF_Grid or ESMF_Mesh
!! | as well as ESMF_Fields for import
!! | and export fields
-!! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep
-!! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up
+!! Run | [ModelAdvance] (@ref MOM_cap_mod::modeladvance) | Advances the model by a timestep
+!! Final | [Finalize] (@ref MOM_cap_mod::ocean_model_finalize) | Cleans up
!!
!! @section UnderlyingModelInterfaces Underlying Model Interfaces
!!
@@ -81,7 +81,7 @@
!! Note that for either the `ESMF_Grid` or `ESMF_Mesh` representation, the fields are translated into
!! a 2D MOM specific surface boundary type and the distinction between the two is no longer there.
!! Calls related to creating the grid are located in the [InitializeRealize]
-!! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure
+!! (@ref MOM_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure
!! during the intialization sequence.
!!
!! The cap determines parameters for setting up the grid by calling subroutines in the
@@ -112,7 +112,7 @@
!!
!! @subsection Initialization Initialization
!!
-!! During the [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase, calls are
+!! During the [InitializeAdvertise] (@ref MOM_cap_mod::initializeadvertise) phase, calls are
!! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`,
!! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator
!! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set
@@ -121,7 +121,7 @@
!!
!! @subsection Run Run
!!
-!! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC
+!! The [ModelAdvance] (@ref MOM_cap_mod::modeladvance) subroutine is called by the NUOPC
!! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a
!! call into the MOM update routine:
!!
@@ -184,7 +184,7 @@
!! \f]
!! @subsection Finalization Finalization
!!
-!! NUOPC infrastructure calls [ocean_model_finalize] (@ref mom_cap_mod::ocean_model_finalize)
+!! NUOPC infrastructure calls [ocean_model_finalize] (@ref MOM_cap_mod::ocean_model_finalize)
!! at the end of the run. This subroutine is a hook to call into MOM's native shutdown
!! procedures:
!!
@@ -272,11 +272,11 @@
!! so that it can maintain state there if desired.
!! The member of type `ice_ocean_boundary_type` is populated by this cap
!! with incoming coupling fields from other components. These three derived types are allocated during the
-!! [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase. Also during that
+!! [InitializeAdvertise] (@ref MOM_cap_mod::initializeadvertise) phase. Also during that
!! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved
!! from `mpp_get_compute_domain()`.
!!
-!! During the [InitializeRealize] (@ref mom_cap_mod::initializerealize) phase,
+!! During the [InitializeRealize] (@ref MOM_cap_mod::initializerealize) phase,
!! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary`
!! and `ocean_public_type` members of the internal state. These fields directly reference into the members of
!! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move
@@ -289,7 +289,7 @@
!! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files
!! with names "field_ocn_import_.nc" and "field_ocn_export_.nc".
!! Additionally, calls will be made to the cap subroutine [dumpMomInternal]
-!! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files
+!! (@ref MOM_cap_mod::dumpmominternal) to write out model internal fields to files
!! named "field_ocn_internal_.nc". In all cases these NetCDF files will
!! contain a time series of field data.
!!
@@ -303,7 +303,7 @@
!! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields
!! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this
!! information is written when entering and leaving the [ModelAdvance]
-!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to
+!! (@ref MOM_cap_mod::modeladvance) subroutine and before and after the call to
!! `update_ocean_model()`.
!! * `restart_interval` - integer number of seconds indicating the interval at
!! which to call `ocean_model_restart()`; no restarts written if set to 0
@@ -311,7 +311,7 @@
!!
!> This module contains a set of subroutines that are required by NUOPC.
-module mom_cap_mod
+module MOM_cap_mod
use constants_mod, only: constants_init
use diag_manager_mod, only: diag_manager_init, diag_manager_end
use field_manager_mod, only: field_manager_init, field_manager_end
@@ -340,13 +340,13 @@ module mom_cap_mod
use MOM_get_input, only: Get_MOM_Input, directories
use MOM_domains, only: pass_var
use MOM_error_handler, only: is_root_pe
-use MOM_ocean_model, only: ice_ocean_boundary_type
+use MOM_ocean_model_nuopc, only: ice_ocean_boundary_type
use MOM_grid, only: ocean_grid_type, get_global_grid_size
-use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type
-use MOM_ocean_model, only: ocean_model_init_sfc
-use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid
-use mom_cap_time, only: AlarmInit
-use mom_cap_methods, only: mom_import, mom_export, mom_set_geomtype
+use MOM_ocean_model_nuopc, only: ocean_model_restart, ocean_public_type, ocean_state_type
+use MOM_ocean_model_nuopc, only: ocean_model_init_sfc
+use MOM_ocean_model_nuopc, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid
+use MOM_cap_time, only: AlarmInit
+use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype
#ifdef CESMCOUPLED
use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit
#endif
@@ -465,7 +465,7 @@ subroutine SetServices(gcomp, rc)
integer, intent(out) :: rc !< return code
! local variables
- character(len=*),parameter :: subname='(mom_cap:SetServices)'
+ character(len=*),parameter :: subname='(MOM_cap:SetServices)'
rc = ESMF_SUCCESS
@@ -559,7 +559,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
logical :: isPresent, isSet
integer :: iostat
character(len=64) :: value, logmsg
- character(len=*),parameter :: subname='(mom_cap:InitializeP0)'
+ character(len=*),parameter :: subname='(MOM_cap:InitializeP0)'
rc = ESMF_SUCCESS
@@ -581,7 +581,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true")
write(logmsg,*) write_diagnostics
- call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite('MOM_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -596,7 +596,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
return
if (isPresent .and. isSet) profile_memory=(trim(value)=="true")
write(logmsg,*) profile_memory
- call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite('MOM_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -611,7 +611,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
return
if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true")
write(logmsg,*) grid_attach_area
- call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite('MOM_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -626,7 +626,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
return
if (isPresent .and. isSet) then
scalar_field_name = trim(value)
- call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite('MOM_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -649,7 +649,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
return
endif
write(logmsg,*) scalar_field_count
- call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite('MOM_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -672,7 +672,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
return
endif
write(logmsg,*) scalar_field_idx_grid_nx
- call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite('MOM_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -695,7 +695,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
return
endif
write(logmsg,*) scalar_field_idx_grid_ny
- call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite('MOM_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -755,7 +755,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
logical :: existflag
integer :: userRc
character(len=512) :: restartfile ! Path/Name of restart file
- character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)'
+ character(len=*), parameter :: subname='(MOM_cap:InitializeAdvertise)'
character(len=32) :: calendar
!--------------------------------
@@ -890,7 +890,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
if (isPresent .and. isSet) then
read(cvalue,*) starttype
else
- call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', &
+ call ESMF_LogWrite('MOM_cap:start_type unset - using input.nml for restart option', &
ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
@@ -913,7 +913,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
endif
if (len_trim(runtype) > 0) then
- call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite('MOM_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -938,7 +938,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
file=__FILE__)) &
return ! bail out
if (existflag) then
- call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite('MOM_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -953,13 +953,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
return
if (isPresent .and. isSet) then
restartfile = trim(cvalue)
- call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite('MOM_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return
else
- call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',&
+ call ESMF_LogWrite('MOM_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',&
ESMF_LOGMSG_WARNING, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
@@ -1159,7 +1159,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
integer, allocatable :: gindex(:) ! global index space
character(len=128) :: fldname
character(len=256) :: cvalue
- character(len=*), parameter :: subname='(mom_cap:InitializeRealize)'
+ character(len=*), parameter :: subname='(MOM_cap:InitializeRealize)'
!--------------------------------
rc = ESMF_SUCCESS
@@ -1637,7 +1637,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
endif
!---------------------------------
- ! Set module variable geomtype in mom_cap_methods
+ ! Set module variable geomtype in MOM_cap_methods
!---------------------------------
call mom_set_geomtype(geomtype)
@@ -1674,7 +1674,7 @@ subroutine DataInitialize(gcomp, rc)
integer :: fieldCount, n
type(ESMF_Field) :: field
character(len=64),allocatable :: fieldNameList(:)
- character(len=*),parameter :: subname='(mom_cap:DataInitialize)'
+ character(len=*),parameter :: subname='(MOM_cap:DataInitialize)'
!--------------------------------
! query the Component for its clock, importState and exportState
@@ -1788,7 +1788,7 @@ subroutine ModelAdvance(gcomp, rc)
integer :: seconds, day, year, month, hour, minute
character(ESMF_MAXSTR) :: restartname, cvalue
character(240) :: msgString
- character(len=*),parameter :: subname='(mom_cap:ModelAdvance)'
+ character(len=*),parameter :: subname='(MOM_cap:ModelAdvance)'
rc = ESMF_SUCCESS
if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ")
@@ -1803,16 +1803,6 @@ subroutine ModelAdvance(gcomp, rc)
file=__FILE__)) &
return ! bail out
- call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
-
- Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr
- ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr
- ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr
-
! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep
call ESMF_ClockPrint(clock, options="currTime", &
@@ -1835,8 +1825,7 @@ subroutine ModelAdvance(gcomp, rc)
return ! bail out
call ESMF_TimePrint(currTime + timeStep, &
- preString="--------------------------------> to: ", &
- unit=msgString, rc=rc)
+ preString="--------------------------------> to: ", unit=msgString, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -1869,83 +1858,89 @@ subroutine ModelAdvance(gcomp, rc)
do_advance = .true.
endif
- ! If the second cpl tstep of a startup run, step back a cpl tstep and advance for two cpl tsteps
- if (currTime == startTime + timeStep) then
- call ESMF_LogWrite("MOM6 - Stepping back one coupling timestep", ESMF_LOGMSG_INFO, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
- Time = esmf2fms_time(currTime-timeStep) ! i.e., startTime
+ if (do_advance) then
+ ! If the second cpl tstep of a startup run, step back a cpl tstep and advance for two cpl tsteps
+ if (currTime == startTime + timeStep) then
+ call ESMF_LogWrite("MOM6 - Stepping back one coupling timestep", ESMF_LOGMSG_INFO, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
+ Time = esmf2fms_time(currTime-timeStep) ! i.e., startTime
+
+ call ESMF_LogWrite("MOM6 - doubling the coupling timestep", ESMF_LOGMSG_INFO, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
+ Time_step_coupled = 2 * esmf2fms_time(timeStep)
+ endif
+ end if
- call ESMF_LogWrite("MOM6 - doubling the coupling timestep", ESMF_LOGMSG_INFO, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
- Time_step_coupled = 2 * esmf2fms_time(timeStep)
- endif
endif
endif
+ if (do_advance) then
- !---------------
- ! Write diagnostics for import
- !---------------
+ call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- if(write_diagnostics) then
- call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', &
- timeslice=import_slice, relaxedFlag=.true., rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
- import_slice = import_slice + 1
- endif
+ Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr
+ ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr
+ ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr
- !---------------
- ! Get ocean grid
- !---------------
+ !---------------
+ ! Write diagnostics for import
+ !---------------
- call get_ocean_grid(ocean_state, ocean_grid)
+ if (write_diagnostics) then
+ call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', &
+ timeslice=import_slice, relaxedFlag=.true., rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
+ import_slice = import_slice + 1
+ endif
- !---------------
- ! Import data
- !---------------
+ !---------------
+ ! Get ocean grid
+ !---------------
- call shr_file_setLogUnit (logunit)
+ call get_ocean_grid(ocean_state, ocean_grid)
+
+ !---------------
+ ! Import data
+ !---------------
- if (cesm_coupled) then
- call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc)
- else
call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc)
- endif
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- !---------------
- ! Update MOM6
- !---------------
+ !---------------
+ ! Update MOM6
+ !---------------
- if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ")
- if (do_advance) then
- call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled)
- endif
- if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ")
+ if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ")
+ call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled)
+ if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ")
- !---------------
- ! Export Data
- !---------------
+ !---------------
+ ! Export Data
+ !---------------
- call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- call shr_file_setLogUnit (logunit)
+ endif
!---------------
! If restart alarm is ringing - write restart file
@@ -1983,7 +1978,7 @@ subroutine ModelAdvance(gcomp, rc)
file=__FILE__)) &
return ! bail out
if (existflag) then
- call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite("MOM_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -1996,7 +1991,7 @@ subroutine ModelAdvance(gcomp, rc)
return ! bail out
if (isPresent .and. isSet) then
restartname = trim(cvalue)
- call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite("MOM_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -2019,7 +2014,7 @@ subroutine ModelAdvance(gcomp, rc)
return ! bail out
write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') &
"ocn", year, month, day, hour, minute, seconds
- call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc)
+ call ESMF_LogWrite("MOM_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
@@ -2089,7 +2084,7 @@ subroutine ModelSetRunClock(gcomp, rc)
type(ESMF_ALARM) :: restart_alarm
logical :: isPresent, isSet
logical :: first_time = .true.
- character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) '
+ character(len=*),parameter :: subname='MOM_cap:(ModelSetRunClock) '
!--------------------------------
rc = ESMF_SUCCESS
@@ -2252,7 +2247,7 @@ subroutine ocean_model_finalize(gcomp, rc)
type(ESMF_Clock) :: clock
type(ESMF_Time) :: currTime
character(len=64) :: timestamp
- character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)'
+ character(len=*),parameter :: subname='(MOM_cap:ocean_model_finalize)'
write(*,*) 'MOM: --- finalize called ---'
rc = ESMF_SUCCESS
@@ -2307,7 +2302,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_
! local variables
type(ESMF_Field) :: field
real(ESMF_KIND_R8), pointer :: farrayptr(:,:)
- character(len=*), parameter :: subname='(mom_cap:State_SetScalar)'
+ character(len=*), parameter :: subname='(MOM_cap:State_SetScalar)'
!--------------------------------------------------------
rc = ESMF_SUCCESS
@@ -2348,7 +2343,7 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc)
type(ESMF_Field) :: field
real(ESMF_KIND_R8), pointer :: fldptr1d(:) ! for mesh
real(ESMF_KIND_R8), pointer :: fldptr2d(:,:) ! for grid
- character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)'
+ character(len=*),parameter :: subname='(MOM_cap:MOM_RealizeFields)'
!--------------------------------------------------------
rc = ESMF_SUCCESS
@@ -2453,7 +2448,7 @@ subroutine SetScalarField(field, rc)
! local variables
type(ESMF_Distgrid) :: distgrid
type(ESMF_Grid) :: grid
- character(len=*), parameter :: subname='(mom_cap:SetScalarField)'
+ character(len=*), parameter :: subname='(MOM_cap:SetScalarField)'
rc = ESMF_SUCCESS
@@ -2494,7 +2489,7 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname)
! local variables
integer :: rc
- character(len=*), parameter :: subname='(mom_cap:fld_list_add)'
+ character(len=*), parameter :: subname='(MOM_cap:fld_list_add)'
! fill in the new entry
num = num + 1
@@ -2530,4 +2525,4 @@ subroutine shr_file_getLogUnit(nunit)
end subroutine shr_file_getLogUnit
#endif
-end module mom_cap_mod
+end module MOM_cap_mod
diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90
index e6bdbea307..8cb1a2ca4c 100644
--- a/config_src/nuopc_driver/mom_cap_methods.F90
+++ b/config_src/nuopc_driver/mom_cap_methods.F90
@@ -1,25 +1,25 @@
!> Contains import/export methods for both NEMS and CMEPS.
-module mom_cap_methods
-
-use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet
-use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet
-use ESMF, only: ESMF_State, ESMF_StateGet
-use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate
-use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate
-use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate
-use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError
-use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE
-use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE
-use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND
-use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH
-use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT
-use ESMF, only: ESMF_TYPEKIND_R8
-use ESMF, only: operator(/=), operator(==)
-use MOM_ocean_model, only: ocean_public_type, ocean_state_type
-use MOM_surface_forcing, only: ice_ocean_boundary_type
-use MOM_grid, only: ocean_grid_type
-use MOM_domains, only: pass_var
-use mpp_domains_mod, only: mpp_get_compute_domain
+module MOM_cap_methods
+
+use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet
+use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet
+use ESMF, only: ESMF_State, ESMF_StateGet
+use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate
+use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate
+use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate
+use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError
+use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE
+use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE
+use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND
+use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH
+use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT
+use ESMF, only: ESMF_TYPEKIND_R8
+use ESMF, only: operator(/=), operator(==)
+use MOM_ocean_model_nuopc, only: ocean_public_type, ocean_state_type
+use MOM_surface_forcing_nuopc, only: ice_ocean_boundary_type
+use MOM_grid, only: ocean_grid_type
+use MOM_domains, only: pass_var
+use mpp_domains_mod, only: mpp_get_compute_domain
! By default make data private
implicit none; private
@@ -57,18 +57,16 @@ end subroutine mom_set_geomtype
!> This function has a few purposes:
!! (1) it imports surface fluxes using data from the mediator; and
!! (2) it can apply restoring in SST and SSS.
-subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc)
+subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc)
type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state
type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid
type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator
type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing
- character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run
integer , intent(inout) :: rc !< Return code
! Local Variables
integer :: i, j, ig, jg, n
integer :: isc, iec, jsc, jec
- logical :: do_import
character(len=128) :: fldname
real(ESMF_KIND_R8), allocatable :: taux(:,:)
real(ESMF_KIND_R8), allocatable :: tauy(:,:)
@@ -80,265 +78,251 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary,
! import_cnt is used to skip using the import state at the first count for cesm
! -------
- if (present(runtype)) then
- import_cnt = import_cnt + 1
- if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then
- do_import = .false. ! This will skip the first time import information is given
- else
- do_import = .true.
- endif
- else
- do_import = .true.
- endif
+ ! The following are global indices without halos
+ call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec)
- if (do_import) then
- ! The following are global indices without halos
- call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec)
+ !----
+ ! surface height pressure
+ !----
+ call state_getimport(importState, 'inst_pres_height_surface', &
+ isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- !----
- ! surface height pressure
- !----
- call state_getimport(importState, 'inst_pres_height_surface', &
- isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
-
- !----
- ! near-IR, direct shortwave (W/m2)
- !----
- call state_getimport(importState, 'mean_net_sw_ir_dir_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
-
- !----
- ! near-IR, diffuse shortwave (W/m2)
- !----
- call state_getimport(importState, 'mean_net_sw_ir_dif_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
-
- !----
- ! visible, direct shortwave (W/m2)
- !----
- call state_getimport(importState, 'mean_net_sw_vis_dir_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ !----
+ ! near-IR, direct shortwave (W/m2)
+ !----
+ call state_getimport(importState, 'mean_net_sw_ir_dir_flx', &
+ isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- !----
- ! visible, diffuse shortwave (W/m2)
- !----
- call state_getimport(importState, 'mean_net_sw_vis_dif_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
-
- ! -------
- ! Net longwave radiation (W/m2)
- ! -------
- call state_getimport(importState, 'mean_net_lw_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ !----
+ ! near-IR, diffuse shortwave (W/m2)
+ !----
+ call state_getimport(importState, 'mean_net_sw_ir_dif_flx', &
+ isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- !----
- ! zonal and meridional surface stress
- !----
- allocate (taux(isc:iec,jsc:jec))
- allocate (tauy(isc:iec,jsc:jec))
+ !----
+ ! visible, direct shortwave (W/m2)
+ !----
+ call state_getimport(importState, 'mean_net_sw_vis_dir_flx', &
+ isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
- call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
-
-
- ! rotate taux and tauy from true zonal/meridional to local coordinates
- do j = jsc, jec
- jg = j + ocean_grid%jsc - jsc
- do i = isc, iec
- ig = i + ocean_grid%isc - isc
- ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) &
- - ocean_grid%sin_rot(ig,jg)*tauy(i,j)
- ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) &
- + ocean_grid%sin_rot(ig,jg)*taux(i,j)
- enddo
- enddo
+ !----
+ ! visible, diffuse shortwave (W/m2)
+ !----
+ call state_getimport(importState, 'mean_net_sw_vis_dif_flx', &
+ isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- deallocate(taux, tauy)
+ ! -------
+ ! Net longwave radiation (W/m2)
+ ! -------
+ call state_getimport(importState, 'mean_net_lw_flx', &
+ isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- !----
- ! sensible heat flux (W/m2)
- !----
- call state_getimport(importState, 'mean_sensi_heat_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ !----
+ ! zonal and meridional surface stress
+ !----
+ allocate (taux(isc:iec,jsc:jec))
+ allocate (tauy(isc:iec,jsc:jec))
- !----
- ! evaporation flux (W/m2)
- !----
- call state_getimport(importState, 'mean_evap_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
+ call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- !----
- ! liquid precipitation (rain)
- !----
- call state_getimport(importState, 'mean_prec_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
- !----
- ! frozen precipitation (snow)
- !----
- call state_getimport(importState, 'mean_fprec_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ ! rotate taux and tauy from true zonal/meridional to local coordinates
+ do j = jsc, jec
+ jg = j + ocean_grid%jsc - jsc
+ do i = isc, iec
+ ig = i + ocean_grid%isc - isc
+ ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) &
+ - ocean_grid%sin_rot(ig,jg)*tauy(i,j)
+ ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) &
+ + ocean_grid%sin_rot(ig,jg)*taux(i,j)
+ enddo
+ enddo
- !----
- ! runoff and heat content of runoff
- !----
- ! Note - preset values to 0, if field does not exist in importState, then will simply return
- ! and preset value will be used
+ deallocate(taux, tauy)
- ! liquid runoff
- ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'Foxx_rofl', &
- isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ !----
+ ! sensible heat flux (W/m2)
+ !----
+ call state_getimport(importState, 'mean_sensi_heat_flx', &
+ isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- ! ice runoff
- ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'Foxx_rofi', &
- isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ !----
+ ! evaporation flux (W/m2)
+ !----
+ call state_getimport(importState, 'mean_evap_rate', &
+ isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- ! total runoff
- ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mean_runoff_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ !----
+ ! liquid precipitation (rain)
+ !----
+ call state_getimport(importState, 'mean_prec_rate', &
+ isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- ! heat content of runoff
- ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mean_runoff_heat_flux', &
- isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ !----
+ ! frozen precipitation (snow)
+ !----
+ call state_getimport(importState, 'mean_fprec_rate', &
+ isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- !----
- ! calving rate and heat flux
- !----
- ! Note - preset values to 0, if field does not exist in importState, then will simply return
- ! and preset value will be used
+ !----
+ ! runoff and heat content of runoff
+ !----
+ ! Note - preset values to 0, if field does not exist in importState, then will simply return
+ ! and preset value will be used
- ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mean_calving_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ ! liquid runoff
+ ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8
+ call state_getimport(importState, 'Foxx_rofl', &
+ isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mean_calving_heat_flux', &
- isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ ! ice runoff
+ ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8
+ call state_getimport(importState, 'Foxx_rofi', &
+ isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- !----
- ! salt flux from ice
- !----
- ice_ocean_boundary%salt_flux(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mean_salt_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ ! total runoff
+ ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8
+ call state_getimport(importState, 'mean_runoff_rate', &
+ isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- ! !----
- ! ! snow&ice melt heat flux (W/m^2)
- ! !----
- ice_ocean_boundary%seaice_melt_heat(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'net_heat_flx_to_ocn', &
- isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ ! heat content of runoff
+ ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8
+ call state_getimport(importState, 'mean_runoff_heat_flux', &
+ isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- ! !----
- ! ! snow&ice melt water flux (W/m^2)
- ! !----
- ice_ocean_boundary%seaice_melt(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mean_fresh_water_to_ocean_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt,rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ !----
+ ! calving rate and heat flux
+ !----
+ ! Note - preset values to 0, if field does not exist in importState, then will simply return
+ ! and preset value will be used
- !----
- ! mass of overlying ice
- !----
- ! Note - preset values to 0, if field does not exist in importState, then will simply return
- ! and preset value will be used
+ ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8
+ call state_getimport(importState, 'mean_calving_rate', &
+ isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mass_of_overlying_ice', &
- isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
- line=__LINE__, &
- file=__FILE__)) &
- return ! bail out
+ ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8
+ call state_getimport(importState, 'mean_calving_heat_flux', &
+ isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
- endif
+ !----
+ ! salt flux from ice
+ !----
+ ice_ocean_boundary%salt_flux(:,:) = 0._ESMF_KIND_R8
+ call state_getimport(importState, 'mean_salt_rate', &
+ isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
+
+ ! !----
+ ! ! snow&ice melt heat flux (W/m^2)
+ ! !----
+ ice_ocean_boundary%seaice_melt_heat(:,:) = 0._ESMF_KIND_R8
+ call state_getimport(importState, 'net_heat_flx_to_ocn', &
+ isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
+
+ ! !----
+ ! ! snow&ice melt water flux (W/m^2)
+ ! !----
+ ice_ocean_boundary%seaice_melt(:,:) = 0._ESMF_KIND_R8
+ call state_getimport(importState, 'mean_fresh_water_to_ocean_rate', &
+ isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt,rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
+
+ !----
+ ! mass of overlying ice
+ !----
+ ! Note - preset values to 0, if field does not exist in importState, then will simply return
+ ! and preset value will be used
+
+ ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8
+ call state_getimport(importState, 'mass_of_overlying_ice', &
+ isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, &
+ file=__FILE__)) &
+ return ! bail out
end subroutine mom_import
@@ -662,7 +646,7 @@ subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc)
! local variables
type(ESMF_Field) :: lfield
integer :: lrc
- character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)'
+ character(len=*),parameter :: subname='(MOM_cap:State_GetFldPtr)'
call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
@@ -689,7 +673,7 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc)
! local variables
type(ESMF_Field) :: lfield
integer :: lrc
- character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)'
+ character(len=*),parameter :: subname='(MOM_cap:State_GetFldPtr)'
call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
@@ -728,7 +712,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r
integer :: lbnd1,lbnd2
real(ESMF_KIND_R8), pointer :: dataPtr1d(:)
real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:)
- character(len=*) , parameter :: subname='(mom_cap_methods:state_getimport)'
+ character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport)'
! ----------------------------------------------
rc = ESMF_SUCCESS
@@ -809,7 +793,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid
integer :: lbnd1,lbnd2
real(ESMF_KIND_R8), pointer :: dataPtr1d(:)
real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:)
- character(len=*) , parameter :: subname='(mom_cap_methods:state_setexport)'
+ character(len=*) , parameter :: subname='(MOM_cap_methods:state_setexport)'
! ----------------------------------------------
rc = ESMF_SUCCESS
@@ -866,4 +850,4 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid
end subroutine State_SetExport
-end module mom_cap_methods
+end module MOM_cap_methods
diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90
index 3f36a131f9..daf9889c43 100644
--- a/config_src/nuopc_driver/mom_cap_time.F90
+++ b/config_src/nuopc_driver/mom_cap_time.F90
@@ -4,7 +4,7 @@
!! determine if/how these could be offered more generally in a
!! shared library. For now we really want the MOM cap to only
!! depend on MOM and ESMF/NUOPC.
-module mom_cap_time
+module MOM_cap_time
! !USES:
use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm
@@ -405,4 +405,4 @@ subroutine date2ymd (date, year, month, day)
end subroutine date2ymd
-end module
+end module MOM_cap_time
diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90
similarity index 94%
rename from config_src/nuopc_driver/MOM_ocean_model.F90
rename to config_src/nuopc_driver/mom_ocean_model_nuopc.F90
index abe583ffcc..95b1bcc6e3 100644
--- a/config_src/nuopc_driver/MOM_ocean_model.F90
+++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90
@@ -1,5 +1,5 @@
!> Top-level module for the MOM6 ocean model in coupled mode.
-module MOM_ocean_model
+module MOM_ocean_model_nuopc
! This file is part of MOM6. See LICENSE.md for the license.
@@ -11,57 +11,57 @@ module MOM_ocean_model
! 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
-use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized
-use MOM, only : get_ocean_stocks, step_offline
-use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf
-use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging
-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 : 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_diagnostics, mech_forcing_diags
-use MOM_get_input, only : Get_MOM_Input, directories
-use MOM_grid, only : ocean_grid_type
-use MOM_io, only : close_file, file_exists, read_data, write_version_number
-use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS
-use MOM_restart, only : MOM_restart_CS, save_restart
-use MOM_string_functions, only : uppercase
-use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes
-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, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end
+use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization
+use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized
+use MOM, only : get_ocean_stocks, step_offline
+use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf
+use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging
+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 : 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_diagnostics, mech_forcing_diags
+use MOM_get_input, only : Get_MOM_Input, directories
+use MOM_grid, only : ocean_grid_type
+use MOM_io, only : close_file, file_exists, read_data, write_version_number
+use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS
+use MOM_restart, only : MOM_restart_CS, save_restart
+use MOM_string_functions, only : uppercase
+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_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init
use MOM_tracer_flow_control, only : call_tracer_flux_init
use MOM_unit_scaling, only : unit_scale_type
-use MOM_variables, only : surface
-use MOM_verticalGrid, only : verticalGrid_type
-use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS
-use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart
-use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type
-use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums
-use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data
-use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data
-use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain
-use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain
-use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux
-use fms_mod, only : stdout
-use mpp_mod, only : mpp_chksum
-use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct
-use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init
-use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves
+use MOM_variables, only : surface
+use MOM_verticalGrid, only : verticalGrid_type
+use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS
+use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart
+use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type
+use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums
+use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data
+use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data
+use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain
+use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain
+use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux
+use fms_mod, only : stdout
+use mpp_mod, only : mpp_chksum
+use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct
+use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init
+use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves
+use MOM_surface_forcing_nuopc, only : surface_forcing_init, convert_IOB_to_fluxes
+use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum
+use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS
+use MOM_surface_forcing_nuopc, only : forcing_save_restart
#include
@@ -260,7 +260,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
integer :: secs, days
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
call callTree_enter("ocean_model_init(), ocean_model_MOM.F90")
if (associated(OS)) then
@@ -476,7 +475,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
integer :: secs, days
integer :: is, ie, js, je
- call callTree_enter("update_ocean_model(), ocean_model_MOM.F90")
+ call callTree_enter("update_ocean_model(), MOM_ocean_model_nuopc.F90")
call get_time(Ocean_coupling_time_step, secs, days)
dt_coupling = 86400.0*real(days) + real(secs)
@@ -1175,4 +1174,4 @@ subroutine get_ocean_grid(OS, Gridp)
return
end subroutine get_ocean_grid
-end module MOM_ocean_model
+end module MOM_ocean_model_nuopc
diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90
similarity index 98%
rename from config_src/nuopc_driver/MOM_surface_forcing.F90
rename to config_src/nuopc_driver/mom_surface_forcing_nuopc.F90
index 01cd79acb9..061e6bac02 100644
--- a/config_src/nuopc_driver/MOM_surface_forcing.F90
+++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90
@@ -1,5 +1,5 @@
!> Converts the input ESMF data (import data) to a MOM-specific data type (surface_forcing_CS).
-module MOM_surface_forcing
+module MOM_surface_forcing_nuopc
! This file is part of MOM6. See LICENSE.md for the license.
@@ -219,7 +219,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, &
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.
- ! local varibles
+ ! local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
data_restore, & !< The surface value toward which to restore [g/kg or degC]
SST_anom, & !< Instantaneous sea surface temperature anomalies from a target value [deg C]
@@ -531,17 +531,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, &
(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + &
(fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j)
- ! The following contribution appears to be calculating the volume flux of sea-ice
- ! melt. This calculation is clearly WRONG if either sea-ice has variable
- ! salinity or the sea-ice is completely fresh.
- ! 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
- ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and
- ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively.
- 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
@@ -684,9 +673,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
endif
forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure.
+ ! TODO: this does not seem correct for NEMS
+#ifdef CESMCOUPLED
+ wind_stagger = AGRID
+#else
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
+#endif
+
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
@@ -761,8 +754,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
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)
+ 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
@@ -1006,7 +998,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names.
! This include declares and sets the variable "version".
#include "version_variable.h"
- character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name.
+ character(len=40) :: mdl = "MOM_surface_forcing_nuopc" ! This module's name.
character(len=48) :: stagger
character(len=48) :: flnam
character(len=240) :: basin_file
@@ -1375,4 +1367,4 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt)
end subroutine ice_ocn_bnd_type_chksum
-end module MOM_surface_forcing
+end module MOM_surface_forcing_nuopc
diff --git a/config_src/nuopc_driver/ocn_comp_NUOPC.F90 b/config_src/nuopc_driver/ocn_comp_NUOPC.F90
new file mode 100644
index 0000000000..6d25b9a1ae
--- /dev/null
+++ b/config_src/nuopc_driver/ocn_comp_NUOPC.F90
@@ -0,0 +1,3 @@
+module ocn_comp_NUOPC
+ use MOM_cap_mod
+end module ocn_comp_NUOPC
diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90 b/config_src/nuopc_driver/ocn_comp_nuopc.F90
deleted file mode 100644
index 51b8a85c26..0000000000
--- a/config_src/nuopc_driver/ocn_comp_nuopc.F90
+++ /dev/null
@@ -1,3 +0,0 @@
-module ocn_comp_nuopc
- use mom_cap_mod
-end module ocn_comp_nuopc
diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90
index 21bb2d4738..6377dd2d1f 100644
--- a/src/core/MOM_barotropic.F90
+++ b/src/core/MOM_barotropic.F90
@@ -65,18 +65,18 @@ module MOM_barotropic
!> 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 [m s-1].
- real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points [m s-1].
+ real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1].
+ real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1].
real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points [H ~> m or kg m-2].
real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points [H ~> m or kg m-2].
real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified
- !! for open boundary conditions (if any) [H m2 s-1 ~> m3 s-1 or kg s-1].
+ !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1].
real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified
- !! for open boundary conditions (if any) [H m2 s-1 ~> m3 s-1 or kg s-1].
+ !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1].
real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain,
- !! as set by the open boundary conditions [m s-1].
+ !! as set by the open boundary conditions [L T-1 ~> m s-1].
real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain,
- !! as set by the open boundary conditions [m s-1].
+ !! as set by the open boundary conditions [L T-1 ~> 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 [H ~> m or kg m-2].
real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain
@@ -99,59 +99,59 @@ module MOM_barotropic
!> 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.
+ !< The fraction of the total column thickness interpolated to u grid points in each layer [nondim].
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv
- !< The fraction of the total column thickness interpolated to v grid points in each layer, nondim.
+ !< 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 [Z-1 ~> m-1].
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u
!< A spatially varying linear drag coefficient acting on the zonal barotropic flow
- !! [H s-1 ~> m s-1 or kg m-2 s-1].
+ !! [H T-1 ~> m s-1 or kg m-2 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 [H m2 s-1 ~> m3 s-1 or kg s-1].
+ !! the next call to btstep [H L2 T-1 ~> m3 s-1 or kg 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 [m s-1].
+ !! condition for the next call to btstep [L T-1 ~> m s-1].
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav
- !< The barotropic zonal velocity averaged over the baroclinic time step [m s-1].
+ !< The barotropic zonal velocity averaged over the baroclinic time step [L T-1 ~> m s-1].
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv
!< Inverse of the basin depth at v grid points [Z-1 ~> m-1].
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v
!< A spatially varying linear drag coefficient acting on the zonal barotropic flow
- !! [H s-1 ~> m s-1 or kg m-2 s-1].
+ !! [H T-1 ~> m s-1 or kg m-2 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 [H m2 s-1 ~> m3 s-1 or kg s-1].
+ !! the next call to btstep [H L2 T-1 ~> m3 s-1 or kg 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 [m s-1].
+ !! condition for the next call to btstep [L T-1 ~> m s-1].
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbtav
- !< The barotropic meridional velocity averaged over the baroclinic time step [m s-1].
+ !< The barotropic meridional velocity averaged over the baroclinic time step [L T-1 ~> 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 [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
- !! [H s-1 ~> m s-1 or kg m-2 s-1]. This is only used if CS%bound_BT_corr is true.
+ !! [H T-1 ~> m s-1 or kg m-2 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 [Z ~> m]
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.
+ !! still utilize the macro IareaT when referenced, [L-2 ~> m-2].
real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: &
D_u_Cor, & !< A simply averaged depth at u points [Z ~> m].
- dy_Cu, & !< A copy of G%dy_Cu with wide halos [m].
- IdxCu !< A copy of G%IdxCu with wide halos [m-1].
+ dy_Cu, & !< A copy of G%dy_Cu with wide halos [L ~> m].
+ IdxCu !< A copy of G%IdxCu with wide halos [L-1 ~> m-1].
real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: &
D_v_Cor, & !< A simply averaged depth at v points [Z ~> m].
- dx_Cv, & !< A copy of G%dx_Cv with wide halos [m].
- IdyCv !< A copy of G%IdyCv with wide halos [m-1].
+ dx_Cv, & !< A copy of G%dx_Cv with wide halos [L ~> m].
+ IdyCv !< A copy of G%IdyCv with wide halos [L-1 ~> m-1].
real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: &
- q_D !< f / D at PV points [Z-1 s-1 ~> m-1 s-1].
+ q_D !< f / D at PV points [Z-1 T-1 ~> m-1 s-1].
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.
@@ -164,10 +164,10 @@ module MOM_barotropic
real :: dtbt_fraction !< The fraction of the maximum time-step that
!! should used. The default is 0.98.
real :: dtbt_max !< The maximum stable barotropic time step [s].
- real :: dt_bt_filter !< The time-scale over which the barotropic mode
- !! solutions are filtered [s]. This can never
- !! be taken to be longer than 2*dt. The default, 0,
- !! applies no filtering.
+ real :: dt_bt_filter !< The time-scale over which the barotropic mode solutions are
+ !! filtered [T ~> s] if positive, or as a fraction of DT if
+ !! negative [nondim]. This can never be taken to be longer than 2*dt.
+ !! Set this to 0 to apply no filtering.
integer :: nstep_last = 0 !< The number of barotropic timesteps per baroclinic
!! time step the last time btstep was called.
real :: bebt !< A nondimensional number, from 0 to 1, that
@@ -209,12 +209,12 @@ module MOM_barotropic
logical :: dynamic_psurf !< If true, add a dynamic pressure due to a viscous
!! ice shelf, for instance.
real :: Dmin_dyn_psurf !< The minimum depth to use in limiting the size
- !! of the dynamic surface pressure for stability [m].
+ !! of the dynamic surface pressure for stability [Z ~> m].
real :: ice_strength_length !< The length scale at which the damping rate
!! due to the ice strength should be the same as if
- !! a Laplacian were applied [m].
+ !! a Laplacian were applied [L ~> m].
real :: const_dyn_psurf !< The constant that scales the dynamic surface
- !! pressure, nondim. Stable values are < ~1.0.
+ !! pressure [nondim]. Stable values are < ~1.0.
!! The default is 0.9.
logical :: tides !< If true, apply tidal momentum forcing.
real :: G_extra !< A nondimensional factor by which gtot is enhanced.
@@ -239,7 +239,7 @@ module MOM_barotropic
logical :: debug !< If true, write verbose checksums for debugging purposes.
logical :: debug_bt !< If true, write verbose checksums for debugging purposes.
real :: vel_underflow !< Velocity components smaller than vel_underflow
- !! are set to 0 [m s-1].
+ !! are set to 0 [L T-1 ~> m s-1].
real :: maxvel !< Velocity components greater than maxvel are
!! truncated to maxvel [m s-1].
real :: CFL_trunc !< If clip_velocity is true, velocity components will
@@ -312,21 +312,21 @@ module MOM_barotropic
!> A desciption of the functional dependence of transport at a u-point
type, private :: local_BT_cont_u_type
real :: FA_u_EE !< The effective open face area for zonal barotropic transport
- !! drawing from locations far to the east [H m ~> m2 or kg m-1].
+ !! drawing from locations far to the east [H L ~> m2 or kg m-1].
real :: FA_u_E0 !< The effective open face area for zonal barotropic transport
- !! drawing from nearby to the east [H m ~> m2 or kg m-1].
+ !! drawing from nearby to the east [H L ~> m2 or kg m-1].
real :: FA_u_W0 !< The effective open face area for zonal barotropic transport
- !! drawing from nearby to the west [H m ~> m2 or kg m-1].
+ !! drawing from nearby to the west [H L ~> m2 or kg m-1].
real :: FA_u_WW !< The effective open face area for zonal barotropic transport
- !! drawing from locations far to the west [H m ~> m2 or kg m-1].
- real :: uBT_WW !< uBT_WW is the barotropic velocity [m s-1], beyond which the marginal
+ !! drawing from locations far to the west [H L ~> m2 or kg m-1].
+ real :: uBT_WW !< uBT_WW is the barotropic velocity [L T-1 ~> 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 [m s-1], beyond which the marginal
+ real :: uBT_EE !< uBT_EE is a barotropic velocity [L T-1 ~> 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 [H s2 m-1 ~> s2 or kg s2 m-3].
- real :: uh_crvE !< The curvature of face area with velocity for flow from the east [H s2 m-1 ~> s2 or kg s2 m-3].
- real :: uh_WW !< The zonal transport when ubt=ubt_WW [H m2 s-1 ~> m3 s-1 or kg s-1].
- real :: uh_EE !< The zonal transport when ubt=ubt_EE [H m2 s-1 ~> m3 s-1 or kg s-1].
+ real :: uh_crvW !< The curvature of face area with velocity for flow from the west [H T2 L-1 ~> s2 or kg s2 m-3].
+ real :: uh_crvE !< The curvature of face area with velocity for flow from the east [H T2 L-1 ~> s2 or kg s2 m-3].
+ real :: uh_WW !< The zonal transport when ubt=ubt_WW [H L2 T-1 ~> m3 s-1 or kg s-1].
+ real :: uh_EE !< The zonal transport when ubt=ubt_EE [H L2 T-1 ~> m3 s-1 or kg 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
@@ -338,14 +338,14 @@ module MOM_barotropic
!! drawing from nearby to the south [H m ~> m2 or kg m-1].
real :: FA_v_SS !< The effective open face area for meridional barotropic transport
!! drawing from locations far to the south [H m ~> m2 or kg m-1].
- real :: vBT_SS !< vBT_SS is the barotropic velocity [m s-1], beyond which the marginal
+ real :: vBT_SS !< vBT_SS is the barotropic velocity [L T-1 ~> 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 [m s-1], beyond which the marginal
+ real :: vBT_NN !< vBT_NN is the barotropic velocity [L T-1 ~> 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 [H s2 m-1 ~> s2 or kg s2 m-3].
- real :: vh_crvn !< The curvature of face area with velocity for flow from the north [H s2 m-1 ~> s2 or kg s2 m-3].
- real :: vh_SS !< The meridional transport when vbt=vbt_SS [H m2 s-1 ~> m3 s-1 or kg s-1].
- real :: vh_NN !< The meridional transport when vbt=vbt_NN [H m2 s-1 ~> m3 s-1 or kg s-1].
+ real :: vh_crvS !< The curvature of face area with velocity for flow from the south [H T2 L-1 ~> s2 or kg s2 m-3].
+ real :: vh_crvN !< The curvature of face area with velocity for flow from the north [H T2 L-1 ~> s2 or kg s2 m-3].
+ real :: vh_SS !< The meridional transport when vbt=vbt_SS [H L2 T-1 ~> m3 s-1 or kg s-1].
+ real :: vh_NN !< The meridional transport when vbt=vbt_NN [H L2 T-1 ~> m3 s-1 or kg s-1].
end type local_BT_cont_v_type
!> A container for passing around active tracer point memory limits
@@ -455,7 +455,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! Local variables
real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been
real :: vbt_Cor(SZI_(G),SZJB_(G)) ! used to calculate the input Coriolis
- ! terms [m s-1].
+ ! terms [L T-1 ~> m s-1].
real :: wt_u(SZIB_(G),SZJ_(G),SZK_(G)) ! wt_u and wt_v are the
real :: wt_v(SZI_(G),SZJB_(G),SZK_(G)) ! normalized weights to
! be used in calculating barotropic velocities, possibly with
@@ -472,71 +472,71 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! relative to eta_PF, with SAL effects included [H ~> m or kg m-2].
! These are always allocated with symmetric memory and wide halos.
- real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [s-1 Z-1 ~> s-1 m-1].
+ real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1].
real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
- ubt, & ! The zonal barotropic velocity [m s-1].
+ ubt, & ! The zonal barotropic velocity [L T-1 ~> m s-1].
bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains
! after a time step, the remainder being lost to bottom drag.
! bt_rem_u is a nondimensional number between 0 and 1.
BT_force_u, & ! The vertical average of all of the u-accelerations that are
- ! not explicitly included in the barotropic equation [m s-2].
+ ! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
u_accel_bt, & ! The difference between the zonal acceleration from the
- ! barotropic calculation and BT_force_u [m s-2].
+ ! barotropic calculation and BT_force_u [L T-2 ~> m s-2].
uhbt, & ! The zonal barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1].
uhbt0, & ! The difference between the sum of the layer zonal thickness
! fluxes and the barotropic thickness flux using the same
- ! velocity [H m2 s-1 ~> m3 s-1 or kg s-1].
- ubt_old, & ! The starting value of ubt in a barotropic step [m s-1].
- ubt_first, & ! The starting value of ubt in a series of barotropic steps [m s-1].
- ubt_sum, & ! The sum of ubt over the time steps [m s-1].
- uhbt_sum, & ! The sum of uhbt over the time steps [H m2 s-1 ~> m3 s-1 or kg s-1].
- ubt_wtd, & ! A weighted sum used to find the filtered final ubt [m s-1].
- ubt_trans, & ! The latest value of ubt used for a transport [m s-1].
+ ! velocity [H L2 T-1 ~> m3 s-1 or kg s-1].
+ ubt_old, & ! The starting value of ubt in a barotropic step [L T-1 ~> m s-1].
+ ubt_first, & ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1].
+ ubt_sum, & ! The sum of ubt over the time steps [L T-1 ~> m s-1].
+ uhbt_sum, & ! The sum of uhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1].
+ ubt_wtd, & ! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1].
+ ubt_trans, & ! The latest value of ubt used for a transport [L T-1 ~> m s-1].
azon, bzon, & ! _zon & _mer are the values of the Coriolis force which
czon, dzon, & ! are applied to the neighboring values of vbtav & ubtav,
amer, bmer, & ! respectively to get the barotropic inertial rotation
- cmer, dmer, & ! [s-1].
- Cor_u, & ! The zonal Coriolis acceleration [m s-2].
+ cmer, dmer, & ! [T-1 ~> s-1].
+ Cor_u, & ! The zonal Coriolis acceleration [L T-2 ~> m s-2].
Cor_ref_u, & ! The zonal barotropic Coriolis acceleration due
- ! to the reference velocities [m s-2].
- PFu, & ! The zonal pressure force acceleration [m s-2].
- Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [s-1].
- PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force [m s-2].
- Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [m s-2].
+ ! to the reference velocities [L T-2 ~> m s-2].
+ PFu, & ! The zonal pressure force acceleration [L T-2 ~> m s-2].
+ Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [T-1 ~> s-1].
+ PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force [L T-2 ~> m s-2].
+ Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [L T-2 ~> m s-2].
DCor_u, & ! A simply averaged depth at u points [Z ~> m].
Datu ! Basin depth at u-velocity grid points times the y-grid
- ! spacing [H m ~> m2 or kg m-1].
+ ! spacing [H L ~> m2 or kg m-1].
real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
- vbt, & ! The meridional barotropic velocity [m s-1].
+ vbt, & ! The meridional barotropic velocity [L T-1 ~> m s-1].
bt_rem_v, & ! The fraction of the barotropic meridional velocity that
! remains after a time step, the rest being lost to bottom
! drag. bt_rem_v is a nondimensional number between 0 and 1.
BT_force_v, & ! The vertical average of all of the v-accelerations that are
- ! not explicitly included in the barotropic equation [m s-2].
+ ! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
v_accel_bt, & ! The difference between the meridional acceleration from the
- ! barotropic calculation and BT_force_v [m s-2].
+ ! barotropic calculation and BT_force_v [L T-2 ~> m s-2].
vhbt, & ! The meridional barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1].
vhbt0, & ! The difference between the sum of the layer meridional
! thickness fluxes and the barotropic thickness flux using
- ! the same velocities [H m2 s-1 ~> m3 s-1 or kg s-1].
- vbt_old, & ! The starting value of vbt in a barotropic step [m s-1].
- vbt_first, & ! The starting value of ubt in a series of barotropic steps [m s-1].
- vbt_sum, & ! The sum of vbt over the time steps [m s-1].
- vhbt_sum, & ! The sum of vhbt over the time steps [H m2 s-1 ~> m3 s-1 or kg s-1].
- vbt_wtd, & ! A weighted sum used to find the filtered final vbt [m s-1].
- vbt_trans, & ! The latest value of vbt used for a transport [m s-1].
- Cor_v, & ! The meridional Coriolis acceleration [m s-2].
+ ! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
+ vbt_old, & ! The starting value of vbt in a barotropic step [L T-1 ~> m s-1].
+ vbt_first, & ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1].
+ vbt_sum, & ! The sum of vbt over the time steps [L T-1 ~> m s-1].
+ vhbt_sum, & ! The sum of vhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1].
+ vbt_wtd, & ! A weighted sum used to find the filtered final vbt [L T-1 ~> m s-1].
+ vbt_trans, & ! The latest value of vbt used for a transport [L T-1 ~> m s-1].
+ Cor_v, & ! The meridional Coriolis acceleration [L T-2 ~> m s-2].
Cor_ref_v, & ! The meridional barotropic Coriolis acceleration due
- ! to the reference velocities [m s-2].
- PFv, & ! The meridional pressure force acceleration [m s-2].
- Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points [s-1].
+ ! to the reference velocities [L T-2 ~> m s-2].
+ PFv, & ! The meridional pressure force acceleration [L T-2 ~> m s-2].
+ Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points [T-1 ~> s-1].
PFv_bt_sum, & ! The summed meridional barotropic pressure gradient force,
- ! [m s-2].
+ ! [L T-2 ~> m s-2].
Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration,
- ! [m s-2].
+ ! [L T-2 ~> m s-2].
DCor_v, & ! A simply averaged depth at v points [Z ~> m].
Datv ! Basin depth at v-velocity grid points times the x-grid
- ! spacing [H m ~> m2 or kg m-1].
+ ! spacing [H L ~> m2 or kg m-1].
real, target, dimension(SZIW_(CS),SZJW_(CS)) :: &
eta, & ! The barotropic free surface height anomaly or column mass
! anomaly [H ~> m or kg m-2]
@@ -558,13 +558,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
gtot_W, & ! free surface height deviations to pressure forces (including
gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum
gtot_S, & ! equations half a grid-point in the X-direction (X is N, S, E, or W)
- ! from the thickness point [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2].
+ ! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
! (See Hallberg, J Comp Phys 1997 for a discussion.)
eta_src, & ! The source of eta per barotropic timestep [H ~> m or kg m-2].
dyn_coef_eta, & ! The coefficient relating the changes in eta to the
! dynamic surface pressure under rigid ice
- ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1].
- p_surf_dyn ! A dynamic surface pressure under rigid ice [m2 s-2].
+ ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
+ p_surf_dyn ! A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2].
type(local_BT_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)) :: &
BTCL_u ! A repackaged version of the u-point information in BT_cont.
type(local_BT_cont_v_type), dimension(SZIW_(CS),SZJBW_(CS)) :: &
@@ -576,15 +576,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC
- real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [m3 kg-1].
+ real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [Z m2 kg-1 ~> m3 kg-1].
real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim.
- real :: vel_prev ! The previous velocity [m s-1].
- real :: dtbt ! The barotropic time step [s].
- real :: bebt ! A copy of CS%bebt.
+ real :: vel_prev ! The previous velocity [L T-1 ~> m s-1].
+ real :: dtbt ! The barotropic time step [T ~> s].
+ real :: dt_in_T ! The baroclinic time step [T ~> s].
+ real :: bebt ! A copy of CS%bebt [nondim].
real :: be_proj ! The fractional amount by which velocities are projected
! when project_velocity is true. For now be_proj is set
! to equal bebt, as they have similar roles and meanings.
- real :: Idt ! The inverse of dt [s-1].
+ real :: Idt ! The inverse of dt [T-1 ~> s-1].
real :: det_de ! The partial derivative due to self-attraction and loading
! of the reference geopotential with the sea surface height.
! This is typically ~0.09 or less.
@@ -607,16 +608,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
logical :: project_velocity, add_uh0
real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta
- ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1].
- real :: ice_strength = 0.0 ! The effective strength of the ice [m s-2].
+ ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
+ real :: ice_strength = 0.0 ! The effective strength of the ice [L2 Z-1 T-2 ~> m s-2].
real :: Idt_max2 ! The squared inverse of the local maximum stable
- ! barotropic time step [s-2].
+ ! barotropic time step [T-2 ~> s-2].
real :: H_min_dyn ! The minimum depth to use in limiting the size of the
! dynamic surface pressure for stability [H ~> m or kg m-2].
real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing
- ! squared [H m-2 ~> m-1 or kg m-4].
+ ! squared [H L-2 ~> m-1 or kg m-4].
real :: vel_tmp ! A temporary velocity [m s-1].
- real :: u_max_cor, v_max_cor ! The maximum corrective velocities [m s-1].
+ real :: u_max_cor, v_max_cor ! The maximum corrective velocities [L T-1 ~> m s-1].
real :: Htot ! The total thickness [H ~> m or kg m-2].
real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2].
real :: accel_underflow ! An acceleration that is so small it should be zeroed out.
@@ -624,7 +625,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2
real :: sum_wt_vel, sum_wt_eta, sum_wt_accel, sum_wt_trans
real :: I_sum_wt_vel, I_sum_wt_eta, I_sum_wt_accel, I_sum_wt_trans
- real :: dt_filt ! The half-width of the barotropic filter [s].
+ real :: dt_filt ! The half-width of the barotropic filter [T ~> s].
real :: trans_wt1, trans_wt2 ! weight used to compute ubt_trans and vbt_trans
integer :: nfilter
@@ -647,8 +648,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
MS%isdw = CS%isdw ; MS%iedw = CS%iedw ; MS%jsdw = CS%jsdw ; MS%jedw = CS%jedw
- Idt = 1.0 / dt
- accel_underflow = CS%vel_underflow * Idt
+ dt_in_T = US%s_to_T*dt
+ Idt = 1.0 / dt_in_T
+ accel_underflow = US%L_T_to_m_s*CS%vel_underflow * US%s_to_T*Idt
use_BT_cont = .false.
if (present(BT_cont)) use_BT_cont = (associated(BT_cont))
@@ -714,10 +716,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! Set the actual barotropic time step.
Instep = 1.0 / real(nstep)
- dtbt = dt * Instep
+ dtbt = dt_in_T * Instep
bebt = CS%bebt
be_proj = CS%bebt
- mass_to_Z = US%m_to_Z / GV%Rho0
+ mass_to_Z = US%m_to_L*US%T_to_s**2 * US%m_to_Z / GV%Rho0
!--- setup the weight when computing vbt_trans and ubt_trans
if (project_velocity) then
@@ -821,7 +823,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
enddo ; enddo
!$OMP parallel do default(shared)
do J=js-1,je ; do I=is-1,ie
- q(I,J) = 0.25 * US%s_to_T*G%CoriolisBu(I,J) * &
+ 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)) )
@@ -913,11 +915,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
do J=js-1,je ; do i=is-1,ie+1 ; vbt_Cor(i,J) = 0.0 ; enddo ; enddo
!$OMP parallel do default(shared)
do j=js,je ; do k=1,nz ; do I=is-1,ie
- ubt_Cor(I,j) = ubt_Cor(I,j) + wt_u(I,j,k) * U_Cor(I,j,k)
+ ubt_Cor(I,j) = ubt_Cor(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*U_Cor(I,j,k)
enddo ; enddo ; enddo
!$OMP parallel do default(shared)
do J=js-1,je ; do k=1,nz ; do i=is,ie
- vbt_Cor(i,J) = vbt_Cor(i,J) + wt_v(i,J,k) * V_Cor(i,J,k)
+ vbt_Cor(i,J) = vbt_Cor(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*V_Cor(i,J,k)
enddo ; enddo ; enddo
! The gtot arrays are the effective layer-weighted reduced gravities for
@@ -927,15 +929,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
!$OMP parallel do default(shared)
do j=js,je
do k=1,nz ; do I=is-1,ie
- gtot_E(i,j) = gtot_E(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * wt_u(I,j,k)
- gtot_W(i+1,j) = gtot_W(i+1,j) + US%L_T_to_m_s**2*pbce(i+1,j,k) * wt_u(I,j,k)
+ gtot_E(i,j) = gtot_E(i,j) + pbce(i,j,k) * wt_u(I,j,k)
+ gtot_W(i+1,j) = gtot_W(i+1,j) + pbce(i+1,j,k) * wt_u(I,j,k)
enddo ; enddo
enddo
!$OMP parallel do default(shared)
do J=js-1,je
do k=1,nz ; do i=is,ie
- gtot_N(i,j) = gtot_N(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * wt_v(i,J,k)
- gtot_S(i,j+1) = gtot_S(i,j+1) + US%L_T_to_m_s**2*pbce(i,j+1,k) * wt_v(i,J,k)
+ gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * wt_v(i,J,k)
+ gtot_S(i,j+1) = gtot_S(i,j+1) + pbce(i,j+1,k) * wt_v(i,J,k)
enddo ; enddo
enddo
@@ -955,12 +957,12 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! Calculate the open areas at the velocity points.
! The halo updates are needed before Datu is first used, either in set_up_BT_OBC or ubt_Cor.
if (use_BT_cont) then
- call set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, CS%BT_Domain, 1+ievf-ie)
+ call set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, CS%BT_Domain, 1+ievf-ie)
else
if (CS%Nonlinear_continuity) then
- call find_face_areas(Datu, Datv, G, GV, CS, MS, eta, 1)
+ call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1)
else
- call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=1)
+ call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1)
endif
endif
@@ -981,14 +983,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! ### 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) * mass_to_Z *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) * mass_to_Z *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
@@ -1007,11 +1009,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! non-symmetric computational domain.
!$OMP parallel do default(shared)
do j=js,je ; do k=1,nz ; do I=Isq,Ieq
- BT_force_u(I,j) = BT_force_u(I,j) + wt_u(I,j,k) * bc_accel_u(I,j,k)
+ BT_force_u(I,j) = BT_force_u(I,j) + wt_u(I,j,k) * US%m_to_L*US%T_to_s**2*bc_accel_u(I,j,k)
enddo ; enddo ; enddo
!$OMP parallel do default(shared)
do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie
- BT_force_v(i,J) = BT_force_v(i,J) + wt_v(i,J,k) * bc_accel_v(i,J,k)
+ BT_force_v(i,J) = BT_force_v(i,J) + wt_v(i,J,k) * US%m_to_L*US%T_to_s**2*bc_accel_v(i,J,k)
enddo ; enddo ; enddo
! Determine the difference between the sum of the layer fluxes and the
@@ -1024,24 +1026,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (CS%visc_rem_u_uh0) then
!$OMP parallel do default(shared)
do j=js,je ; do k=1,nz ; do I=is-1,ie
- uhbt(I,j) = uhbt(I,j) + uh0(I,j,k)
- ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * u_uh0(I,j,k)
+ uhbt(I,j) = uhbt(I,j) + US%T_to_s*US%m_to_L**2*uh0(I,j,k)
+ ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*u_uh0(I,j,k)
enddo ; enddo ; enddo
!$OMP parallel do default(shared)
do J=js-1,je ; do k=1,nz ; do i=is,ie
- vhbt(i,J) = vhbt(i,J) + vh0(i,J,k)
- vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * v_vh0(i,J,k)
+ vhbt(i,J) = vhbt(i,J) + US%T_to_s*US%m_to_L**2*vh0(i,J,k)
+ vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*v_vh0(i,J,k)
enddo ; enddo ; enddo
else
!$OMP parallel do default(shared)
do j=js,je ; do k=1,nz ; do I=is-1,ie
- uhbt(I,j) = uhbt(I,j) + uh0(I,j,k)
- ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * u_uh0(I,j,k)
+ uhbt(I,j) = uhbt(I,j) + US%T_to_s*US%m_to_L**2*uh0(I,j,k)
+ ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * US%m_s_to_L_T*u_uh0(I,j,k)
enddo ; enddo ; enddo
!$OMP parallel do default(shared)
do J=js-1,je ; do k=1,nz ; do i=is,ie
- vhbt(i,J) = vhbt(i,J) + vh0(i,J,k)
- vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * v_vh0(i,J,k)
+ vhbt(i,J) = vhbt(i,J) + US%T_to_s*US%m_to_L**2*vh0(i,J,k)
+ vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * US%m_s_to_L_T*v_vh0(i,J,k)
enddo ; enddo ; enddo
endif
if (use_BT_cont) then
@@ -1058,15 +1060,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
call adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, &
- G, MS, 1+ievf-ie)
+ G, US, MS, 1+ievf-ie)
endif
!$OMP parallel do default(shared)
do j=js,je ; do I=is-1,ie
- uhbt0(I,j) = uhbt(I,j) - find_uhbt(ubt(I,j),BTCL_u(I,j))
+ uhbt0(I,j) = uhbt(I,j) - find_uhbt(ubt(I,j), BTCL_u(I,j), US)
enddo ; enddo
!$OMP parallel do default(shared)
do J=js-1,je ; do i=is,ie
- vhbt0(i,J) = vhbt(i,J) - find_vhbt(vbt(i,J),BTCL_v(i,J))
+ vhbt0(i,J) = vhbt(i,J) - find_vhbt(vbt(i,J), BTCL_v(i,J), US)
enddo ; enddo
else
!$OMP parallel do default(shared)
@@ -1103,11 +1105,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
enddo ; enddo
!$OMP parallel do default(shared)
do j=js,je ; do k=1,nz ; do I=is-1,ie
- ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * U_in(I,j,k)
+ ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*U_in(I,j,k)
enddo ; enddo ; enddo
!$OMP parallel do default(shared)
do J=js-1,je ; do k=1,nz ; do i=is,ie
- vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * V_in(i,J,k)
+ vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*V_in(i,J,k)
enddo ; enddo ; enddo
!$OMP parallel do default(shared)
do j=js,je ; do I=is-1,ie
@@ -1350,13 +1352,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! Limit the source (outward) correction to be a fraction the mass that
! can be transported out of the cell by velocities with a CFL number of
! CFL_cor.
- u_max_cor = G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt)
- v_max_cor = G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt)
- eta_cor_max = dt * (CS%IareaT(i,j) * &
- (((find_uhbt(u_max_cor,BTCL_u(I,j)) + uhbt0(I,j)) - &
- (find_uhbt(-u_max_cor,BTCL_u(I-1,j)) + uhbt0(I-1,j))) + &
- ((find_vhbt(v_max_cor,BTCL_v(i,J)) + vhbt0(i,J)) - &
- (find_vhbt(-v_max_cor,BTCL_v(i,J-1)) + vhbt0(i,J-1))) ))
+ u_max_cor = US%m_to_L*G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt)
+ v_max_cor = US%m_to_L*G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt)
+ eta_cor_max = dt_in_T * (CS%IareaT(i,j) * &
+ (((find_uhbt(u_max_cor, BTCL_u(I,j), US) + uhbt0(I,j)) - &
+ (find_uhbt(-u_max_cor, BTCL_u(I-1,j), US) + uhbt0(I-1,j))) + &
+ ((find_vhbt(v_max_cor, BTCL_v(i,J), US) + vhbt0(i,J)) - &
+ (find_vhbt(-v_max_cor, BTCL_v(i,J-1), US) + vhbt0(i,J-1))) ))
CS%eta_cor(i,j) = min(CS%eta_cor(i,j), max(0.0, eta_cor_max))
else
! Limit the sink (inward) correction to the amount of mass that is already
@@ -1368,8 +1370,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
endif
endif ; enddo ; enddo
else ; do j=js,je ; do i=is,ie
- if (abs(CS%eta_cor(i,j)) > dt*CS%eta_cor_bound(i,j)) &
- CS%eta_cor(i,j) = sign(dt*CS%eta_cor_bound(i,j),CS%eta_cor(i,j))
+ if (abs(CS%eta_cor(i,j)) > dt_in_T*CS%eta_cor_bound(i,j)) &
+ CS%eta_cor(i,j) = sign(dt_in_T*CS%eta_cor_bound(i,j), CS%eta_cor(i,j))
enddo ; enddo ; endif ; endif
!$OMP do
do j=js,je ; do i=is,ie
@@ -1380,9 +1382,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (CS%dynamic_psurf) then
ice_is_rigid = (associated(forces%rigidity_ice_u) .and. &
associated(forces%rigidity_ice_v))
- H_min_dyn = GV%m_to_H * CS%Dmin_dyn_psurf
+ H_min_dyn = GV%Z_to_H * CS%Dmin_dyn_psurf
if (ice_is_rigid .and. use_BT_cont) &
- call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, 0, .true.)
+ call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.)
if (ice_is_rigid) then
!$OMP parallel do default(shared) private(Idt_max2,H_eff_dx2,dyn_coef_max,ice_strength)
do j=js,je ; do i=is,ie
@@ -1391,27 +1393,28 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! This estimate of the maximum stable time step is pretty accurate for
! gravity waves, but it is a conservative estimate since it ignores the
! stabilizing effect of the bottom drag.
- Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (G%IareaT(i,j) * &
- ((gtot_E(i,j) * (Datu(I,j)*G%IdxCu(I,j)) + &
- gtot_W(i,j) * (Datu(I-1,j)*G%IdxCu(I-1,j))) + &
- (gtot_N(i,j) * (Datv(i,J)*G%IdyCv(i,J)) + &
- gtot_S(i,j) * (Datv(i,J-1)*G%IdyCv(i,J-1)))) + &
- US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)))
- H_eff_dx2 = max(H_min_dyn * (G%IdxT(i,j)**2 + G%IdyT(i,j)**2), &
- G%IareaT(i,j) * &
- ((Datu(I,j)*G%IdxCu(I,j) + Datu(I-1,j)*G%IdxCu(I-1,j)) + &
- (Datv(i,J)*G%IdyCv(i,J) + Datv(i,J-1)*G%IdyCv(i,J-1)) ) )
+ Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (US%L_to_m**2*G%IareaT(i,j) * &
+ ((gtot_E(i,j) * (Datu(I,j)*US%L_to_m*G%IdxCu(I,j)) + &
+ gtot_W(i,j) * (Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j))) + &
+ (gtot_N(i,j) * (Datv(i,J)*US%L_to_m*G%IdyCv(i,J)) + &
+ gtot_S(i,j) * (Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)))) + &
+ ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
+ (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)))
+ H_eff_dx2 = max(H_min_dyn * ((US%L_to_m*G%IdxT(i,j))**2 + (US%L_to_m*G%IdyT(i,j))**2), &
+ US%L_to_m**2*G%IareaT(i,j) * &
+ ((Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + &
+ (Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)) ) )
dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * Idt_max2) / &
(dtbt**2 * H_eff_dx2)
- ! ice_strength has units of [m s-2]. rigidity_ice_[uv] has units of [m3 s-1].
- ice_strength = ((forces%rigidity_ice_u(I,j) + forces%rigidity_ice_u(I-1,j)) + &
+ ! ice_strength has units of [L2 Z-1 T-2 ~> m s-2]. rigidity_ice_[uv] has units of [m3 s-1].
+ ice_strength = US%m_to_L**4*US%Z_to_m*US%T_to_s* &
+ ((forces%rigidity_ice_u(I,j) + forces%rigidity_ice_u(I-1,j)) + &
(forces%rigidity_ice_v(i,J) + forces%rigidity_ice_v(i,J-1))) / &
(CS%ice_strength_length**2 * dtbt)
- ! Units of dyn_coef: [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]
- dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * GV%H_to_m)
+ ! Units of dyn_coef: [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]
+ dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * GV%H_to_Z)
enddo ; enddo ; endif
endif
@@ -1445,11 +1448,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (CS%debug) then
call uvchksum("BT [uv]hbt", uhbt, vhbt, CS%debug_BT_HI, haloshift=0, &
- scale=GV%H_to_m)
- call uvchksum("BT Initial [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=0)
+ scale=US%s_to_T*US%L_to_m**2*GV%H_to_m)
+ call uvchksum("BT Initial [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=0, scale=US%L_T_to_m_s)
call hchksum(eta, "BT Initial eta", CS%debug_BT_HI, haloshift=0, scale=GV%H_to_m)
call uvchksum("BT BT_force_[uv]", BT_force_u, BT_force_v, &
- CS%debug_BT_HI, haloshift=0)
+ CS%debug_BT_HI, haloshift=0, scale=US%L_T2_to_m_s2)
if (interp_eta_PF) then
call hchksum(eta_PF_1, "BT eta_PF_1",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m)
call hchksum(d_eta_PF, "BT d_eta_PF",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m)
@@ -1457,20 +1460,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
call hchksum(eta_PF, "BT eta_PF",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m)
call hchksum(eta_PF_in, "BT eta_PF_in",G%HI,haloshift=0, scale=GV%H_to_m)
endif
- call uvchksum("BT Cor_ref_[uv]", Cor_ref_u, Cor_ref_v, CS%debug_BT_HI, haloshift=0)
- call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, CS%debug_BT_HI, &
- haloshift=0, scale=GV%H_to_m)
+ call uvchksum("BT Cor_ref_[uv]", Cor_ref_u, Cor_ref_v, CS%debug_BT_HI, haloshift=0, scale=US%L_T2_to_m_s2)
+ call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, CS%debug_BT_HI, haloshift=0, &
+ scale=US%L_to_m**2*US%s_to_T*GV%H_to_m)
if (.not. use_BT_cont) then
- call uvchksum("BT Dat[uv]", Datu, Datv, CS%debug_BT_HI, haloshift=1, &
- scale=GV%H_to_m)
+ call uvchksum("BT Dat[uv]", Datu, Datv, CS%debug_BT_HI, haloshift=1, scale=US%L_to_m*GV%H_to_m)
endif
call uvchksum("BT wt_[uv]", wt_u, wt_v, G%HI, 0, .true., .true.)
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 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, scale=US%m_to_Z)
- call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, &
- G%HI, haloshift=1)
+ call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, haloshift=1)
endif
if (query_averaging_enabled(CS%diag)) then
@@ -1485,9 +1485,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (project_velocity) then ; eta_PF_BT => eta ; else ; eta_PF_BT => eta_pred ; endif
if (CS%dt_bt_filter >= 0.0) then
- dt_filt = 0.5 * max(0.0, min(CS%dt_bt_filter, 2.0*dt))
+ dt_filt = 0.5 * max(0.0, min(CS%dt_bt_filter, 2.0*dt_in_T))
else
- dt_filt = 0.5 * max(0.0, dt * min(-CS%dt_bt_filter, 2.0))
+ dt_filt = 0.5 * max(0.0, dt_in_T * min(-CS%dt_bt_filter, 2.0))
endif
nfilter = ceiling(dt_filt / dtbt)
@@ -1545,21 +1545,21 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (CS%clip_velocity) then
do j=jsv,jev ; do I=isv-1,iev
- if ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then
+ if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then
! Add some error reporting later.
- ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j)))
- elseif ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then
+ ubt(I,j) = (-0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i+1,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j)))
+ elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*G%IareaT(i,j) > CS%CFL_trunc) then
! Add some error reporting later.
- ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j)))
+ ubt(I,j) = (0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j)))
endif
enddo ; enddo
do J=jsv-1,jev ; do i=isv,iev
- if ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then
+ if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then
! Add some error reporting later.
- vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J)))
- elseif ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then
+ vbt(i,J) = (-0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j+1) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J)))
+ elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*G%IareaT(i,j) > CS%CFL_trunc) then
! Add some error reporting later.
- vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J)))
+ vbt(i,J) = (0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J)))
endif
enddo ; enddo
endif
@@ -1577,33 +1577,27 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if ((.not.use_BT_cont) .and. CS%Nonlinear_continuity .and. &
(CS%Nonlin_cont_update_period > 0)) then
if ((n>1) .and. (mod(n-1,CS%Nonlin_cont_update_period) == 0)) &
- call find_face_areas(Datu, Datv, G, GV, CS, MS, eta, 1+iev-ie)
+ call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1+iev-ie)
endif
-!GOMP parallel default(none) shared(CS,isv,iev,jsv,jev,project_velocity,use_BT_cont, &
-!GOMP uhbt,vhbt,ubt,BTCL_u,uhbt0,vbt,BTCL_v,vhbt0, &
-!GOMP eta_pred,eta,eta_src,dtbt,Datu,Datv,p_surf_dyn, &
-!GOMP dyn_coef_eta,find_etaav,is,ie,js,je,eta_sum, &
-!GOMP wt_accel2,n,eta_PF_BT,interp_eta_PF,wt_end, &
-!GOMP Instep,eta_PF,eta_PF_1,d_eta_PF, &
-!GOMP apply_OBC_flather,ubt_old,vbt_old )
+ !GOMP parallel default(shared)
if (CS%dynamic_psurf .or. .not.project_velocity) then
if (use_BT_cont) then
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do I=isv-2,iev+1
- uhbt(I,j) = find_uhbt(ubt(I,j),BTCL_u(I,j)) + uhbt0(I,j)
+ uhbt(I,j) = find_uhbt(ubt(I,j), BTCL_u(I,j), US) + uhbt0(I,j)
enddo ; enddo
-!GOMP do
+ !GOMP do
do J=jsv-2,jev+1 ; do i=isv-1,iev+1
- vhbt(i,J) = find_vhbt(vbt(i,J),BTCL_v(i,J)) + vhbt0(i,J)
+ vhbt(i,J) = find_vhbt(vbt(i,J), BTCL_v(i,J), US) + vhbt0(i,J)
enddo ; enddo
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do i=isv-1,iev+1
eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * &
((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J)))
enddo ; enddo
else
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do i=isv-1,iev+1
eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * &
(((Datu(I-1,j)*ubt(I-1,j) + uhbt0(I-1,j)) - &
@@ -1614,7 +1608,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
endif
if (CS%dynamic_psurf) then
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do i=isv-1,iev+1
p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j))
enddo ; enddo
@@ -1625,7 +1619,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! eta_PF_BT => eta_pred ; if (project_velocity) eta_PF_BT => eta
if (find_etaav) then
-!GOMP do
+ !GOMP do
do j=js,je ; do i=is,ie
eta_sum(i,j) = eta_sum(i,j) + wt_accel2(n) * eta_PF_BT(i,j)
enddo ; enddo
@@ -1633,23 +1627,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (interp_eta_PF) then
wt_end = n*Instep ! This could be (n-0.5)*Instep.
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do i=isv-1,iev+1
eta_PF(i,j) = eta_PF_1(i,j) + wt_end*d_eta_PF(i,j)
enddo ; enddo
endif
if (apply_OBC_flather .or. apply_OBC_open) then
-!GOMP do
+ !GOMP do
do j=jsv,jev ; do I=isv-2,iev+1
ubt_old(I,j) = ubt(I,j)
enddo ; enddo
-!GOMP do
+ !GOMP do
do J=jsv-2,jev+1 ; do i=isv,iev
vbt_old(i,J) = vbt(i,J)
enddo ; enddo
endif
-!GOMP end parallel
+ !GOMP end parallel
if (apply_OBCs) then
if (MOD(n+G%first_direction,2)==1) then
@@ -1659,30 +1653,26 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
endif
if (CS%BT_OBC%apply_u_OBCs) then ! save the old value of ubt and uhbt
-!GOMP parallel do default(none) shared(isv,iev,jsv,jev,ioff,joff,ubt_prev,ubt,uhbt_prev, &
-!GOMP uhbt,ubt_sum_prev,ubt_sum,uhbt_sum_prev, &
-!GOMP uhbt_sum,ubt_wtd_prev,ubt_wtd)
+ !GOMP parallel do default(shared)
do J=jsv-joff,jev+joff ; do i=isv-1,iev
- ubt_prev(i,J) = ubt(i,J); uhbt_prev(i,J) = uhbt(i,J)
- ubt_sum_prev(i,J)=ubt_sum(i,J); uhbt_sum_prev(i,J)=uhbt_sum(i,J) ; ubt_wtd_prev(i,J)=ubt_wtd(i,J)
+ ubt_prev(i,J) = ubt(i,J) ; uhbt_prev(i,J) = uhbt(i,J)
+ ubt_sum_prev(i,J) = ubt_sum(i,J) ; uhbt_sum_prev(i,J) = uhbt_sum(i,J) ; ubt_wtd_prev(i,J) = ubt_wtd(i,J)
enddo ; enddo
endif
if (CS%BT_OBC%apply_v_OBCs) then ! save the old value of vbt and vhbt
-!GOMP parallel do default(none) shared(isv,iev,jsv,jev,ioff,joff,vbt_prev,vbt,vhbt_prev, &
-!GOMP vhbt,vbt_sum_prev,vbt_sum,vhbt_sum_prev, &
-!GOMP vhbt_sum,vbt_wtd_prev,vbt_wtd)
+ !GOMP parallel do default(shared)
do J=jsv-1,jev ; do i=isv-ioff,iev+ioff
- vbt_prev(i,J) = vbt(i,J); vhbt_prev(i,J) = vhbt(i,J)
- vbt_sum_prev(i,J)=vbt_sum(i,J); vhbt_sum_prev(i,J)=vhbt_sum(i,J) ; vbt_wtd_prev(i,J) = vbt_wtd(i,J)
+ vbt_prev(i,J) = vbt(i,J) ; vhbt_prev(i,J) = vhbt(i,J)
+ vbt_sum_prev(i,J) = vbt_sum(i,J) ; vhbt_sum_prev(i,J) = vhbt_sum(i,J) ; vbt_wtd_prev(i,J) = vbt_wtd(i,J)
enddo ; enddo
endif
endif
-!GOMP parallel default(shared) private(vel_prev)
+ !GOMP parallel default(shared) private(vel_prev)
if (MOD(n+G%first_direction,2)==1) then
! On odd-steps, update v first.
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv-1,iev+1
Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + &
(bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J)
@@ -1691,19 +1681,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
dgeo_de * CS%IdyCv(i,J)
enddo ; enddo
if (CS%dynamic_psurf) then
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv-1,iev+1
PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J)
enddo ; enddo
endif
if (CS%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then
PFv(i,J) = 0.0
endif ; enddo ; enddo
endif
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv-1,iev+1
vel_prev = vbt(i,J)
vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + &
@@ -1719,24 +1709,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
enddo ; enddo
if (use_BT_cont) then
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv-1,iev+1
- vhbt(i,J) = find_vhbt(vbt_trans(i,J),BTCL_v(i,J)) + vhbt0(i,J)
+ vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J), US) + vhbt0(i,J)
enddo ; enddo
else
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv-1,iev+1
vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J)
enddo ; enddo
endif
if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary.
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then
- vbt(i,J) = vbt_prev(i,J); vhbt(i,J) = vhbt_prev(i,J)
+ vbt(i,J) = vbt_prev(i,J) ; vhbt(i,J) = vhbt_prev(i,J)
endif ; enddo ; enddo
endif
! Now update the zonal velocity.
-!GOMP do
+ !GOMP do
do j=jsv,jev ; do I=isv-1,iev
Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + &
(bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - &
@@ -1747,19 +1737,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
enddo ; enddo
if (CS%dynamic_psurf) then
-!GOMP do
+ !GOMP do
do j=jsv,jev ; do I=isv-1,iev
PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j)
enddo ; enddo
endif
if (CS%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary
-!GOMP do
+ !GOMP do
do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then
PFu(I,j) = 0.0
endif ; enddo ; enddo
endif
-!GOMP do
+ !GOMP do
do j=jsv,jev ; do I=isv-1,iev
vel_prev = ubt(I,j)
ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + &
@@ -1776,25 +1766,25 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
enddo ; enddo
if (use_BT_cont) then
-!GOMP do
+ !GOMP do
do j=jsv,jev ; do I=isv-1,iev
- uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j)) + uhbt0(I,j)
+ uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j), US) + uhbt0(I,j)
enddo ; enddo
else
-!GOMP do
+ !GOMP do
do j=jsv,jev ; do I=isv-1,iev
uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j)
enddo ; enddo
endif
if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary.
-!GOMP do
+ !GOMP do
do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then
ubt(I,j) = ubt_prev(I,j); uhbt(I,j) = uhbt_prev(I,j)
endif ; enddo ; enddo
endif
else
! On even steps, update u first.
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do I=isv-1,iev
Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + &
(bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - &
@@ -1805,26 +1795,27 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
enddo ; enddo
if (CS%dynamic_psurf) then
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do I=isv-1,iev
PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j)
enddo ; enddo
endif
if (CS%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary
-!GOMP do
+ !GOMP do
do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then
PFu(I,j) = 0.0
endif ; enddo ; enddo
endif
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do I=isv-1,iev
vel_prev = ubt(I,j)
ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + &
dtbt * ((BT_force_u(I,j) + Cor_u(I,j)) + PFu(I,j)))
if (abs(ubt(I,j)) < CS%vel_underflow) ubt(I,j) = 0.0
ubt_trans(I,j) = trans_wt1*ubt(I,j) + trans_wt2*vel_prev
+
if (CS%linear_wave_drag) then
u_accel_bt(I,j) = u_accel_bt(I,j) + wt_accel(n) * &
((Cor_u(I,j) + PFu(I,j)) - ubt(I,j)*Rayleigh_u(I,j))
@@ -1834,18 +1825,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
enddo ; enddo
if (use_BT_cont) then
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do I=isv-1,iev
- uhbt(I,j) = find_uhbt(ubt_trans(I,j),BTCL_u(I,j)) + uhbt0(I,j)
+ uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j), US) + uhbt0(I,j)
enddo ; enddo
else
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do I=isv-1,iev
uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j)
enddo ; enddo
endif
if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary.
-!GOMP do
+ !GOMP do
do j=jsv-1,jev+1 ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then
ubt(I,j) = ubt_prev(I,j); uhbt(I,j) = uhbt_prev(I,j)
endif ; enddo ; enddo
@@ -1853,7 +1844,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! Now update the meridional velocity.
if (CS%use_old_coriolis_bracket_bug) then
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv,iev
Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + bmer(I,j) * ubt(I,j)) + &
(cmer(I,j+1) * ubt(I,j+1) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J)
@@ -1862,7 +1853,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
dgeo_de * CS%IdyCv(i,J)
enddo ; enddo
else
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv,iev
Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + &
(bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J)
@@ -1873,20 +1864,20 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
endif
if (CS%dynamic_psurf) then
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv,iev
PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J)
enddo ; enddo
endif
if (CS%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then
PFv(i,J) = 0.0
endif ; enddo ; enddo
endif
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv,iev
vel_prev = vbt(i,J)
vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + &
@@ -1902,90 +1893,85 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
endif
enddo ; enddo
if (use_BT_cont) then
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv,iev
- vhbt(i,J) = find_vhbt(vbt_trans(i,J),BTCL_v(i,J)) + vhbt0(i,J)
+ vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J), US) + vhbt0(i,J)
enddo ; enddo
else
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv,iev
vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J)
enddo ; enddo
endif
if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary.
-!GOMP do
+ !GOMP do
do J=jsv-1,jev ; do i=isv,iev ; if (OBC%segnum_v(i,J) /= OBC_NONE) then
vbt(i,J) = vbt_prev(i,J); vhbt(i,J) = vhbt_prev(i,J)
endif ; enddo ; enddo
endif
endif
-!GOMP end parallel
-
-!GOMP parallel default(none) shared(is,ie,js,je,find_PF,PFu_bt_sum,wt_accel2, &
-!GOMP PFu,PFv_bt_sum,PFv,find_Cor,Coru_bt_sum, &
-!GOMP Cor_u,Corv_bt_sum,Cor_v,ubt_sum,wt_trans, &
-!GOMP ubt_trans,uhbt_sum,uhbt,ubt_wtd,wt_vel, &
-!GOMP ubt,vbt_sum,vbt_trans,vhbt_sum,vhbt, &
-!GOMP vbt_wtd,vbt,n )
+ !GOMP end parallel
+
+ !GOMP parallel default(shared)
if (find_PF) then
-!GOMP do
+ !GOMP do
do j=js,je ; do I=is-1,ie
PFu_bt_sum(I,j) = PFu_bt_sum(I,j) + wt_accel2(n) * PFu(I,j)
enddo ; enddo
-!GOMP do
+ !GOMP do
do J=js-1,je ; do i=is,ie
PFv_bt_sum(i,J) = PFv_bt_sum(i,J) + wt_accel2(n) * PFv(i,J)
enddo ; enddo
endif
if (find_Cor) then
-!GOMP do
+ !GOMP do
do j=js,je ; do I=is-1,ie
Coru_bt_sum(I,j) = Coru_bt_sum(I,j) + wt_accel2(n) * Cor_u(I,j)
enddo ; enddo
-!GOMP do
+ !GOMP do
do J=js-1,je ; do i=is,ie
Corv_bt_sum(i,J) = Corv_bt_sum(i,J) + wt_accel2(n) * Cor_v(i,J)
enddo ; enddo
endif
-!GOMP do
+ !GOMP do
do j=js,je ; do I=is-1,ie
ubt_sum(I,j) = ubt_sum(I,j) + wt_trans(n) * ubt_trans(I,j)
uhbt_sum(I,j) = uhbt_sum(I,j) + wt_trans(n) * uhbt(I,j)
ubt_wtd(I,j) = ubt_wtd(I,j) + wt_vel(n) * ubt(I,j)
enddo ; enddo
-!GOMP do
+ !GOMP do
do J=js-1,je ; do i=is,ie
vbt_sum(i,J) = vbt_sum(i,J) + wt_trans(n) * vbt_trans(i,J)
vhbt_sum(i,J) = vhbt_sum(i,J) + wt_trans(n) * vhbt(i,J)
vbt_wtd(i,J) = vbt_wtd(i,J) + wt_vel(n) * vbt(i,J)
enddo ; enddo
-!GOMP end parallel
+ !GOMP end parallel
if (apply_OBCs) then
if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary.
-!GOMP parallel do default(none) shared(is,ie,js,je,ubt_sum_prev,ubt_sum,uhbt_sum_prev,&
-!GOMP uhbt_sum,ubt_wtd_prev,ubt_wtd)
+ !GOMP parallel do default(shared)
do j=js,je ; do I=is-1,ie
if (OBC%segnum_u(I,j) /= OBC_NONE) then
- ubt_sum(I,j)=ubt_sum_prev(I,j); uhbt_sum(I,j)=uhbt_sum_prev(I,j) ; ubt_wtd(I,j)=ubt_wtd_prev(I,j)
+ ubt_sum(I,j) = ubt_sum_prev(I,j) ; uhbt_sum(I,j) = uhbt_sum_prev(I,j)
+ ubt_wtd(I,j) = ubt_wtd_prev(I,j)
endif
enddo ; enddo
endif
if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary.
-!GOMP parallel do default(none) shared(is,ie,js,je,vbt_sum_prev,vbt_sum,vhbt_sum_prev, &
-!GOMP vhbt_sum,vbt_wtd_prev,vbt_wtd)
+ !GOMP parallel do default(shared)
do J=js-1,je ; do I=is,ie
if (OBC%segnum_v(i,J) /= OBC_NONE) then
- vbt_sum(i,J)=vbt_sum_prev(i,J); vhbt_sum(i,J)=vhbt_sum_prev(i,J) ; vbt_wtd(i,J)=vbt_wtd_prev(i,J)
+ vbt_sum(i,J) = vbt_sum_prev(i,J) ; vhbt_sum(i,J) = vhbt_sum_prev(i,J)
+ vbt_wtd(i,J) = vbt_wtd_prev(i,J)
endif
enddo ; enddo
endif
call apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, &
ubt_trans, vbt_trans, eta, ubt_old, vbt_old, CS%BT_OBC, &
- G, MS, iev-ie, dtbt, bebt, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v, &
+ G, MS, US, iev-ie, dtbt, bebt, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v, &
uhbt0, vhbt0)
if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie
if (OBC%segnum_u(I,j) /= OBC_NONE) then
@@ -2004,11 +1990,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
endif
if (CS%debug_bt) then
- call uvchksum("BT [uv]hbt just after OBC", uhbt, vhbt, &
- CS%debug_BT_HI, haloshift=iev-ie, scale=GV%H_to_m)
+ call uvchksum("BT [uv]hbt just after OBC", uhbt, vhbt, CS%debug_BT_HI, haloshift=iev-ie, &
+ scale=US%s_to_T*US%L_to_m**2*GV%H_to_m)
endif
-!$OMP parallel do default(none) shared(isv,iev,jsv,jev,n,eta,eta_src,dtbt,CS,uhbt,vhbt,eta_wtd,wt_eta)
+ !$OMP parallel do default(shared)
do j=jsv,jev ; do i=isv,iev
eta(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * &
((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J)))
@@ -2017,8 +2003,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
enddo ; enddo
if (do_hifreq_output) then
- time_step_end = time_bt_start + real_to_time(n*dtbt)
- call enable_averaging(dtbt, time_step_end, CS%diag)
+ time_step_end = time_bt_start + real_to_time(n*US%T_to_s*dtbt)
+ call enable_averaging(US%T_to_s*dtbt, time_step_end, CS%diag)
if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag)
if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag)
if (CS%id_eta_hifreq > 0) call post_data(CS%id_eta_hifreq, eta(isd:ied,jsd:jed), CS%diag)
@@ -2029,9 +2015,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (CS%debug_bt) then
write(mesg,'("BT step ",I4)') n
- call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, &
- CS%debug_BT_HI, haloshift=iev-ie)
- call hchksum(eta, trim(mesg)//" eta",CS%debug_BT_HI,haloshift=iev-ie, scale=GV%H_to_m)
+ call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=iev-ie, &
+ scale=US%L_T_to_m_s)
+ call hchksum(eta, trim(mesg)//" eta", CS%debug_BT_HI, haloshift=iev-ie, scale=GV%H_to_m)
endif
enddo ! end of do n=1,ntimestep
@@ -2101,7 +2087,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
do j=js,je ; do I=is-1,ie
CS%ubtav(I,j) = ubt_sum(I,j) * I_sum_wt_trans
- uhbtav(I,j) = uhbt_sum(I,j) * I_sum_wt_trans
+ uhbtav(I,j) = US%s_to_T*US%L_to_m**2*uhbt_sum(I,j) * I_sum_wt_trans
! The following line would do approximately nothing, as I_sum_wt_accel ~= 1.
!### u_accel_bt(I,j) = u_accel_bt(I,j) * I_sum_wt_accel
ubt_wtd(I,j) = ubt_wtd(I,j) * I_sum_wt_vel
@@ -2109,7 +2095,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
do J=js-1,je ; do i=is,ie
CS%vbtav(i,J) = vbt_sum(i,J) * I_sum_wt_trans
- vhbtav(i,J) = vhbt_sum(i,J) * I_sum_wt_trans
+ vhbtav(i,J) = US%s_to_T*US%L_to_m**2*vhbt_sum(i,J) * I_sum_wt_trans
! The following line would do approximately nothing, as I_sum_wt_accel ~= 1.
!### v_accel_bt(i,J) = v_accel_bt(i,J) * I_sum_wt_accel
vbt_wtd(i,J) = vbt_wtd(i,J) * I_sum_wt_vel
@@ -2120,7 +2106,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (G%nonblocking_updates) then
call complete_group_pass(CS%pass_e_anom, G%Domain)
if (find_etaav) call start_group_pass(CS%pass_etaav, G%Domain)
- call start_group_pass(CS%pass_ubta_uhbta, G%Domain)
+ call start_group_pass(CS%pass_ubta_uhbta, G%DoMain)
else
call do_group_pass(CS%pass_ubta_uhbta, G%Domain)
endif
@@ -2131,15 +2117,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
!$OMP parallel do default(shared)
do k=1,nz
do j=js,je ; do I=is-1,ie
- accel_layer_u(I,j,k) = u_accel_bt(I,j) - &
- ((US%L_T_to_m_s**2*pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j) - &
- (US%L_T_to_m_s**2*pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j)
+ accel_layer_u(I,j,k) = US%L_T2_to_m_s2 * (u_accel_bt(I,j) - &
+ ((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j) - &
+ (pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j) )
if (abs(accel_layer_u(I,j,k)) < accel_underflow) accel_layer_u(I,j,k) = 0.0
enddo ; enddo
do J=js-1,je ; do i=is,ie
- accel_layer_v(i,J,k) = v_accel_bt(i,J) - &
- ((US%L_T_to_m_s**2*pbce(i,j+1,k) - gtot_S(i,j+1))*e_anom(i,j+1) - &
- (US%L_T_to_m_s**2*pbce(i,j,k) - gtot_N(i,j))*e_anom(i,j)) * CS%IdyCv(i,J)
+ accel_layer_v(i,J,k) = US%L_T2_to_m_s2 * (v_accel_bt(i,J) - &
+ ((pbce(i,j+1,k) - gtot_S(i,j+1)) * e_anom(i,j+1) - &
+ (pbce(i,j,k) - gtot_N(i,j)) * e_anom(i,j)) * CS%IdyCv(i,J) )
if (abs(accel_layer_v(i,J,k)) < accel_underflow) accel_layer_v(i,J,k) = 0.0
enddo ; enddo
enddo
@@ -2149,14 +2135,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! symmetric-memory computational domain, not in the wide halo regions.
if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie
if (OBC%segnum_u(I,j) /= OBC_NONE) then
- u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt
- do k=1,nz ; accel_layer_u(I,j,k) = u_accel_bt(I,j) ; enddo
+ u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt_in_T
+ do k=1,nz ; accel_layer_u(I,j,k) = US%L_T2_to_m_s2*u_accel_bt(I,j) ; enddo
endif
enddo ; enddo ; endif
if (CS%BT_OBC%apply_v_OBCs) then ; do J=js-1,je ; do i=is,ie
if (OBC%segnum_v(i,J) /= OBC_NONE) then
- v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt
- do k=1,nz ; accel_layer_v(i,J,k) = v_accel_bt(i,J) ; enddo
+ v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt_in_T
+ do k=1,nz ; accel_layer_v(i,J,k) = US%L_T2_to_m_s2*v_accel_bt(i,J) ; enddo
endif
enddo ; enddo ; endif
endif
@@ -2170,10 +2156,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = vbt_wtd(i,J) ; enddo ; enddo
if (use_BT_cont) then
do j=js,je ; do I=is-1,ie
- CS%uhbt_IC(I,j) = find_uhbt(ubt_wtd(I,j), BTCL_u(I,j)) + uhbt0(I,j)
+ CS%uhbt_IC(I,j) = find_uhbt(ubt_wtd(I,j), BTCL_u(I,j), US) + uhbt0(I,j)
enddo ; enddo
do J=js-1,je ; do i=is,ie
- CS%vhbt_IC(i,J) = find_vhbt(vbt_wtd(i,J), BTCL_v(i,J)) + vhbt0(i,J)
+ CS%vhbt_IC(i,J) = find_vhbt(vbt_wtd(i,J), BTCL_v(i,J), US) + vhbt0(i,J)
enddo ; enddo
else
do j=js,je ; do I=is-1,ie
@@ -2290,24 +2276,28 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
gtot_W, & ! free surface height deviations to pressure forces (including
gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum
gtot_S ! equations half a grid-point in the X-direction (X is N, S, E, or W)
- ! from the thickness point [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2].
+ ! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
! (See Hallberg, J Comp Phys 1997 for a discussion.)
real, dimension(SZIBS_(G),SZJ_(G)) :: &
Datu ! Basin depth at u-velocity grid points times the y-grid
- ! spacing [H m ~> m2 or kg m-1].
+ ! spacing [H L ~> m2 or kg m-1].
real, dimension(SZI_(G),SZJBS_(G)) :: &
Datv ! Basin depth at v-velocity grid points times the x-grid
- ! spacing [H m ~> m2 or kg m-1].
+ ! spacing [H L ~> m2 or kg m-1].
real :: det_de ! The partial derivative due to self-attraction and loading
- ! of the reference geopotential with the sea surface height.
+ ! of the reference geopotential with the sea surface height [nondim].
! This is typically ~0.09 or less.
real :: dgeo_de ! The constant of proportionality between geopotential and
- ! sea surface height. It is a nondimensional number of
+ ! sea surface height [nondim]. It is a nondimensional number of
! order 1. For stability, this may be made larger
! than physical problem would suggest.
real :: add_SSH ! An additional contribution to SSH to provide a margin of error
! when calculating the external wave speed [Z ~> m].
- real :: min_max_dt2, Idt_max2, dtbt_max
+ real :: min_max_dt2 ! The square of the minimum value of the largest stable barotropic
+ ! timesteps [T2 ~> s2]
+ real :: dtbt_max ! The maximum barotropic timestep [T ~> s]
+ real :: Idt_max2 ! The squared inverse of the local maximum stable
+ ! barotropic time step [T-2 ~> s-2].
logical :: use_BT_cont
type(memory_size_type) :: MS
@@ -2329,11 +2319,11 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
if (present(BT_cont)) use_BT_cont = (associated(BT_cont))
if (use_BT_cont) then
- call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, 0, .true.)
+ call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.)
elseif (CS%Nonlinear_continuity .and. present(eta)) then
- call find_face_areas(Datu, Datv, G, GV, CS, MS, eta=eta, halo=0)
+ call find_face_areas(Datu, Datv, G, GV, US, 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, US, CS, MS, halo=0, add_max=add_SSH)
endif
det_de = 0.0
@@ -2345,27 +2335,27 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
gtot_N(i,j) = 0.0 ; gtot_S(i,j) = 0.0
enddo ; enddo
do k=1,nz ; do j=js,je ; do i=is,ie
- gtot_E(i,j) = gtot_E(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatu(I,j,k)
- gtot_W(i,j) = gtot_W(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatu(I-1,j,k)
- gtot_N(i,j) = gtot_N(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatv(i,J,k)
- gtot_S(i,j) = gtot_S(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatv(i,J-1,k)
+ gtot_E(i,j) = gtot_E(i,j) + pbce(i,j,k) * CS%frhatu(I,j,k)
+ gtot_W(i,j) = gtot_W(i,j) + pbce(i,j,k) * CS%frhatu(I-1,j,k)
+ gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * CS%frhatv(i,J,k)
+ gtot_S(i,j) = gtot_S(i,j) + pbce(i,j,k) * CS%frhatv(i,J-1,k)
enddo ; enddo ; enddo
else
do j=js,je ; do i=is,ie
- gtot_E(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z ; gtot_W(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z
- gtot_N(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z ; gtot_S(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z
+ gtot_E(i,j) = gtot_est * GV%H_to_Z ; gtot_W(i,j) = gtot_est * GV%H_to_Z
+ gtot_N(i,j) = gtot_est * GV%H_to_Z ; gtot_S(i,j) = gtot_est * GV%H_to_Z
enddo ; enddo
endif
- min_max_dt2 = 1.0e38 ! A huge number.
+ min_max_dt2 = 1.0e38*US%s_to_T**2 ! A huge value for the permissible timestep squared.
do j=js,je ; do i=is,ie
! This is pretty accurate for gravity waves, but it is a conservative
! estimate since it ignores the stabilizing effect of the bottom drag.
- Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (G%IareaT(i,j) * &
- ((gtot_E(i,j)*Datu(I,j)*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*G%IdxCu(I-1,j)) + &
- (gtot_N(i,j)*Datv(i,J)*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*G%IdyCv(i,J-1))) + &
- US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)))
+ Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (US%L_to_m**2*G%IareaT(i,j) * &
+ ((gtot_E(i,j)*Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + &
+ (gtot_N(i,j)*Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1))) + &
+ ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
+ (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)))
if (Idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / Idt_max2
enddo ; enddo
dtbt_max = sqrt(min_max_dt2 / dgeo_de)
@@ -2373,8 +2363,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
call min_across_PEs(dtbt_max)
if (id_clock_sync > 0) call cpu_clock_end(id_clock_sync)
- CS%dtbt = CS%dtbt_fraction * dtbt_max
- CS%dtbt_max = dtbt_max
+ CS%dtbt = CS%dtbt_fraction * US%T_to_s * dtbt_max
+ CS%dtbt_max = US%T_to_s * dtbt_max
end subroutine set_dtbt
!> The following 4 subroutines apply the open boundary conditions.
@@ -2382,7 +2372,7 @@ end subroutine set_dtbt
!! velocities and mass transports, as developed by Mehmet Ilicak.
subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, &
eta, ubt_old, vbt_old, BT_OBC, &
- G, MS, halo, dtbt, bebt, use_BT_cont, Datu, Datv, &
+ G, MS, US, halo, dtbt, bebt, use_BT_cont, Datu, Datv, &
BTCL_u, BTCL_v, uhbt0, vhbt0)
type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an OBC type.
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
@@ -2392,7 +2382,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport
!! [H m2 s-1 ~> m3 s-1 or kg s-1].
real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in
- !! transport [m s-1].
+ !! transport [L T-1 ~> m s-1].
real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity [m s-1].
real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport
!! [H m2 s-1 ~> m3 s-1 or kg s-1].
@@ -2401,22 +2391,23 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
!! column mass anomaly [H ~> m or kg m-2].
real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic
- !! step [m s-1].
+ !! step [L T-1 ~> m s-1].
real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of vbt in a barotropic
- !! step [m s-1].
+ !! step [L T-1 ~> m s-1].
type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays
!! related to the open boundary conditions,
!! set by set_up_BT_OBC.
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
integer, intent(in) :: halo !< The extra halo size to use here.
- real, intent(in) :: dtbt !< The time step [s].
+ real, intent(in) :: dtbt !< The time step [T ~> s].
real, intent(in) :: bebt !< The fractional weighting of the future velocity
!! in determining the transport.
logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
!! transports.
real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points
- !! [H m ~> m2 or kg m-1].
+ !! [H L ~> m2 or kg m-1].
real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points
- !! [H m ~> m2 or kg m-1].
+ !! [H L ~> m2 or kg m-1].
type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
!! for a dynamic estimate of the face areas at
!! u-points.
@@ -2426,21 +2417,21 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 !< A correction to the zonal transport so that
!! the barotropic functions agree with the sum
!! of the layer transports
- !! [H m2 s-1 ~> m3 s-1 or kg s-1].
+ !! [H L2 T-1 ~> m3 s-1 or kg s-1].
real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 !< A correction to the meridional transport so that
!! the barotropic functions agree with the sum
!! of the layer transports
- !! [H m2 s-1 ~> m3 s-1 or kg s-1].
+ !! [H L2 T-1 ~> m3 s-1 or kg s-1].
! Local variables
- real :: vel_prev ! The previous velocity [m s-1].
+ real :: vel_prev ! The previous velocity [L T-1 ~> m s-1].
real :: vel_trans ! The combination of the previous and current velocity
- ! that does the mass transport [m s-1].
+ ! that does the mass transport [L T-1 ~> m s-1].
real :: H_u ! The total thickness at the u-point [H ~> m or kg m-2].
real :: H_v ! The total thickness at the v-point [H ~> m or kg m-2].
real :: cfl ! The CFL number at the point in question [nondim]
- real :: u_inlet
- real :: v_inlet
+ real :: u_inlet ! The zonal inflow velocity [L T-1 ~> m s-1]
+ real :: v_inlet ! The meridional inflow velocity [L T-1 ~> m s-1]
real :: h_in
real :: cff, Cx, Cy, tau
real :: dhdt, dhdx, dhdy
@@ -2459,7 +2450,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
vel_trans = ubt(I,j)
elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
if (OBC%segment(OBC%segnum_u(I,j))%Flather) then
- cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
+ cfl = dtbt * BT_OBC%Cg_u(I,j) * US%L_to_m*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 = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal
H_u = BT_OBC%H_u(I,j)
@@ -2473,13 +2464,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
endif
elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then
if (OBC%segment(OBC%segnum_u(I,j))%Flather) then
- cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
+ cfl = dtbt * BT_OBC%Cg_u(I,j) * US%L_to_m*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 = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! external
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)) + &
+ ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
(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)
@@ -2491,7 +2482,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
if (.not. OBC%segment(OBC%segnum_u(I,j))%specified) then
if (use_BT_cont) then
- uhbt(I,j) = find_uhbt(vel_trans,BTCL_u(I,j)) + uhbt0(I,j)
+ uhbt(I,j) = find_uhbt(vel_trans, BTCL_u(I,j), US) + uhbt0(I,j)
else
uhbt(I,j) = Datu(I,j)*vel_trans + uhbt0(I,j)
endif
@@ -2509,13 +2500,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
vel_trans = vbt(i,J)
elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
if (OBC%segment(OBC%segnum_v(i,J))%Flather) then
- cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL
+ cfl = dtbt * BT_OBC%Cg_v(i,J) * US%L_to_m*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 = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal
H_v = BT_OBC%H_v(i,J)
vel_prev = vbt(i,J)
- vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + &
+ vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + &
(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)
@@ -2525,13 +2516,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
endif
elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then
if (OBC%segment(OBC%segnum_v(i,J))%Flather) then
- cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL
+ cfl = dtbt * BT_OBC%Cg_v(i,J) * US%L_to_m*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 = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal
H_v = BT_OBC%H_v(i,J)
vel_prev = vbt(i,J)
- vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + &
+ vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + &
(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)
@@ -2543,7 +2534,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
if (.not. OBC%segment(OBC%segnum_v(i,J))%specified) then
if (use_BT_cont) then
- vhbt(i,J) = find_vhbt(vel_trans,BTCL_v(i,J)) + vhbt0(i,J)
+ vhbt(i,J) = find_vhbt(vel_trans, BTCL_v(i,J), US) + vhbt0(i,J)
else
vhbt(i,J) = vel_trans*Datv(i,J) + vhbt0(i,J)
endif
@@ -2574,9 +2565,9 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
!! transports.
real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points
- !! [H m ~> m2 or kg m-1].
+ !! [L m ~> m2 or kg m-1].
real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points
- !! [H m ~> m2 or kg m-1].
+ !! [L m ~> m2 or kg m-1].
type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
!! for a dynamic estimate of the face areas at
!! u-points.
@@ -2632,7 +2623,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
BT_OBC%uhbt(I,j) = 0.
enddo ; enddo
do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB
- BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + segment%normal_trans(I,j,k)
+ BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + US%T_to_s*US%m_to_L**2*segment%normal_trans(I,j,k)
enddo ; enddo ; enddo
endif
enddo
@@ -2641,7 +2632,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
! Can this go in segment loop above? Is loop above wrong for wide halos??
if (OBC%segment(OBC%segnum_u(I,j))%specified) then
if (use_BT_cont) then
- BT_OBC%ubt_outer(I,j) = uhbt_to_ubt(BT_OBC%uhbt(I,j),BTCL_u(I,j))
+ BT_OBC%ubt_outer(I,j) = uhbt_to_ubt(BT_OBC%uhbt(I,j), BTCL_u(I,j), US)
else
if (Datu(I,j) > 0.0) BT_OBC%ubt_outer(I,j) = BT_OBC%uhbt(I,j) / Datu(I,j)
endif
@@ -2659,7 +2650,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
BT_OBC%H_u(I,j) = eta(i+1,j)
endif
endif
- BT_OBC%Cg_u(I,j) = US%L_T_to_m_s*SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_u(i,j))
+ BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_u(i,j))
endif
endif ; enddo ; enddo
if (OBC%Flather_u_BCs_exist_globally) then
@@ -2667,7 +2658,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
segment => OBC%segment(n)
if (segment%is_E_or_W .and. segment%Flather) then
do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB
- BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j)
+ BT_OBC%ubt_outer(I,j) = US%m_s_to_L_T*segment%normal_vel_bt(I,j)
BT_OBC%eta_outer_u(I,j) = segment%eta(I,j)
enddo ; enddo
endif
@@ -2684,7 +2675,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
BT_OBC%vhbt(i,J) = 0.
enddo ; enddo
do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
- BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + segment%normal_trans(i,J,k)
+ BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + US%T_to_s*US%m_to_L**2*segment%normal_trans(i,J,k)
enddo ; enddo ; enddo
endif
enddo
@@ -2693,7 +2684,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
! Can this go in segment loop above? Is loop above wrong for wide halos??
if (OBC%segment(OBC%segnum_v(i,J))%specified) then
if (use_BT_cont) then
- BT_OBC%vbt_outer(i,J) = vhbt_to_vbt(BT_OBC%vhbt(i,J),BTCL_v(i,J))
+ BT_OBC%vbt_outer(i,J) = vhbt_to_vbt(BT_OBC%vhbt(i,J), BTCL_v(i,J), US)
else
if (Datv(i,J) > 0.0) BT_OBC%vbt_outer(i,J) = BT_OBC%vhbt(i,J) / Datv(i,J)
endif
@@ -2711,7 +2702,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
BT_OBC%H_v(i,J) = eta(i,j+1)
endif
endif
- BT_OBC%Cg_v(i,J) = US%L_T_to_m_s*SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_v(i,J))
+ BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_v(i,J))
endif
endif ; enddo ; enddo
if (OBC%Flather_v_BCs_exist_globally) then
@@ -2719,7 +2710,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
segment => OBC%segment(n)
if (segment%is_N_or_S .and. segment%Flather) then
do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
- BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J)
+ BT_OBC%vbt_outer(i,J) = US%m_s_to_L_T*segment%normal_vel_bt(i,J)
BT_OBC%eta_outer_v(i,J) = segment%eta(i,J)
enddo ; enddo
endif
@@ -3031,13 +3022,14 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
end subroutine btcalc
!> The function find_uhbt determines the zonal transport for a given velocity.
-function find_uhbt(u, BTC) result(uhbt)
- real, intent(in) :: u !< The local zonal velocity [m s-1]
+function find_uhbt(u, BTC, US) result(uhbt)
+ real, intent(in) :: u !< The local zonal velocity [L T-1 ~> m s-1]
type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that
!! allow the barotropic transports to be calculated consistently
!! with the layers' continuity equations.
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real :: uhbt !< The result
+ real :: uhbt !< The zonal barotropic transport [L2 H T-1 ~> m3 s-1]
if (u == 0.0) then
uhbt = 0.0
@@ -3050,25 +3042,28 @@ function find_uhbt(u, BTC) result(uhbt)
else ! (u > BTC%uBT_WW)
uhbt = (u - BTC%uBT_WW) * BTC%FA_u_WW + BTC%uh_WW
endif
+
end function find_uhbt
!> This function inverts the transport function to determine the barotopic
!! velocity that is consistent with a given transport.
-function uhbt_to_ubt(uhbt, BTC, guess) result(ubt)
+function uhbt_to_ubt(uhbt, BTC, US, guess) result(ubt)
real, intent(in) :: uhbt !< The barotropic zonal transport that should be inverted for,
- !! [H m2 s-1 ~> m3 s-1 or kg s-1].
+ !! [H L2 T-1 ~> m3 s-1 or kg s-1].
type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that allow the
!! barotropic transports to be calculated consistently with the
!! layers' continuity equations.
- real, optional, intent(in) :: guess !< A guess at what ubt will be. The result is not allowed
- !! to be dramatically larger than guess.
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ real, optional, intent(in) :: guess !< A guess at what ubt will be [L T-1 ~> m s-1]. The result
+ !! is not allowed to be dramatically larger than guess.
real :: ubt !< The result - The velocity that gives uhbt transport [m s-1].
! Local variables
real :: ubt_min, ubt_max, uhbt_err, derr_du
real :: uherr_min, uherr_max
- real, parameter :: tol = 1.0e-10
- real :: dvel, vsr ! Temporary variables used in the limiting the velocity.
+ real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
+ real :: dvel ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1].
+ real :: vsr ! Temporary variable used in the limiting the velocity [nondim].
real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting
real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the
! maximum increase of vs2, both nondim.
@@ -3145,12 +3140,13 @@ function uhbt_to_ubt(uhbt, BTC, guess) result(ubt)
end function uhbt_to_ubt
!> The function find_vhbt determines the meridional transport for a given velocity.
-function find_vhbt(v, BTC) result(vhbt)
- real, intent(in) :: v !< The local meridional velocity [m s-1]
+function find_vhbt(v, BTC, US) result(vhbt)
+ real, intent(in) :: v !< The local meridional velocity [L T-1 ~> m s-1]
type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that
!! allow the barotropic transports to be calculated consistently
!! with the layers' continuity equations.
- real :: vhbt !< The result
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ real :: vhbt !< The meridional barotropic transport [L2 H T-1 ~> m3 s-1]
if (v == 0.0) then
vhbt = 0.0
@@ -3163,25 +3159,28 @@ function find_vhbt(v, BTC) result(vhbt)
else ! (v > BTC%vBT_SS)
vhbt = (v - BTC%vBT_SS) * BTC%FA_v_SS + BTC%vh_SS
endif
+
end function find_vhbt
!> This function inverts the transport function to determine the barotopic
!! velocity that is consistent with a given transport.
-function vhbt_to_vbt(vhbt, BTC, guess) result(vbt)
+function vhbt_to_vbt(vhbt, BTC, US, guess) result(vbt)
real, intent(in) :: vhbt !< The barotropic meridional transport that should be
- !! inverted for [H m2 s-1 ~> m3 s-1 or kg s-1].
+ !! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1].
type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that allow the
!! barotropic transports to be calculated consistently
!! with the layers' continuity equations.
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, optional, intent(in) :: guess !< A guess at what vbt will be. The result is not allowed
- !! to be dramatically larger than guess.
- real :: vbt !< The result - The velocity that gives vhbt transport [m s-1].
+ !! to be dramatically larger than guess [L T-1 ~> m s-1].
+ real :: vbt !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1].
! Local variables
real :: vbt_min, vbt_max, vhbt_err, derr_dv
real :: vherr_min, vherr_max
- real, parameter :: tol = 1.0e-10
- real :: dvel, vsr ! Temporary variables used in the limiting the velocity.
+ real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
+ real :: dvel ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1].
+ real :: vsr ! Temporary variable used in the limiting the velocity [nondim].
real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting
real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the
! maximum increase of vs2, both nondim.
@@ -3259,7 +3258,7 @@ end function vhbt_to_vbt
!> This subroutine sets up reordered versions of the BT_cont type in the
!! local_BT_cont types, which have wide halos properly filled in.
-subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, BT_Domain, halo)
+subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain, halo)
type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the
!! barotropic solver.
type(memory_size_type), intent(in) :: MS !< A type that describes the
@@ -3270,6 +3269,7 @@ subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, BT_Domain, ha
type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(out) :: BTCL_v !< A structure with the v
!! information from BT_cont.
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for updating
!! the halos of wide arrays.
integer, optional, intent(in) :: halo !< The extra halo size to use here.
@@ -3389,7 +3389,7 @@ end subroutine set_local_BT_cont_types
!> Adjust_local_BT_cont_types sets up reordered versions of the BT_cont type
!! in the local_BT_cont types, which have wide halos properly filled in.
subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, &
- G, MS, halo)
+ G, US, MS, halo)
type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays.
real, dimension(SZIBW_(MS),SZJW_(MS)), &
intent(in) :: ubt !< The linearization zonal barotropic velocity [m s-1].
@@ -3406,6 +3406,7 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, &
type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), &
intent(out) :: BTCL_v !< A structure with the v information from BT_cont.
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
integer, optional, intent(in) :: halo !< The extra halo size to use here.
! Local variables
@@ -3451,26 +3452,26 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, &
!$OMP parallel do default(shared)
do J=js-hs-1,je+hs ; do i=is-hs,ie+hs
if ((vbt(i,J) > BTCL_v(i,J)%vBT_SS) .and. (vhbt(i,J) > BTCL_v(i,J)%vh_SS)) then
- ! Nxpand the cubic fit to use this new point. vbt is negative.
+ ! Expand the cubic fit to use this new point. vbt is negative.
BTCL_v(i,J)%vbt_SS = vbt(i,J)
if (3.0*vhbt(i,J) < 2.0*vbt(i,J) * BTCL_v(i,J)%FA_v_S0) then
- ! No fvrther bovnding is needed.
+ ! No further bounding is needed.
BTCL_v(i,J)%vh_crvS = (vhbt(i,J) - vbt(i,J) * BTCL_v(i,J)%FA_v_S0) / vbt(i,J)**3
- else ! This shovld not happen often!
- BTCL_v(i,J)%FA_v_S0 = 1.5*vhbt(i,J) / vbt(i,J)
+ else ! This should not happen often!
+ BTCL_v(i,J)%FA_v_S0 = 1.5*vhbt(i,J) / (vbt(i,J))
BTCL_v(i,J)%vh_crvS = -0.5*vhbt(i,J) / vbt(i,J)**3
endif
BTCL_v(i,J)%vh_SS = vhbt(i,J)
! I don't know whether this is helpful.
! BTCL_v(i,J)%FA_v_SS = min(BTCL_v(i,J)%FA_v_SS, vhbt(i,J) / vbt(i,J))
elseif ((vbt(i,J) < BTCL_v(i,J)%vBT_NN) .and. (vhbt(i,J) < BTCL_v(i,J)%vh_NN)) then
- ! Nxpand the cubic fit to use this new point. vbt is negative.
+ ! Expand the cubic fit to use this new point. vbt is negative.
BTCL_v(i,J)%vbt_NN = vbt(i,J)
if (3.0*vhbt(i,J) < 2.0*vbt(i,J) * BTCL_v(i,J)%FA_v_N0) then
- ! No fvrther bovnding is needed.
+ ! No further bounding is needed.
BTCL_v(i,J)%vh_crvN = (vhbt(i,J) - vbt(i,J) * BTCL_v(i,J)%FA_v_N0) / vbt(i,J)**3
- else ! This shovld not happen often!
- BTCL_v(i,J)%FA_v_N0 = 1.5*vhbt(i,J) / vbt(i,J)
+ else ! This should not happen often!
+ BTCL_v(i,J)%FA_v_N0 = 1.5*vhbt(i,J) / (vbt(i,J))
BTCL_v(i,J)%vh_crvN = -0.5*vhbt(i,J) / vbt(i,J)**3
endif
BTCL_v(i,J)%vh_NN = vhbt(i,J)
@@ -3483,16 +3484,17 @@ end subroutine adjust_local_BT_cont_types
!> This subroutine uses the BTCL types to find typical or maximum face
!! areas, which can then be used for finding wave speeds, etc.
-subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, halo, maximize)
+subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo, maximize)
type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the
!! barotropic solver.
type(memory_size_type), intent(in) :: MS !< A type that describes the memory
!! sizes of the argument arrays.
real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
- intent(out) :: Datu !< The effective zonal face area [H m ~> m2 or kg m-1].
+ intent(out) :: Datu !< The effective zonal face area [H L ~> m2 or kg m-1].
real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
- intent(out) :: Datv !< The effective meridional face area [H m ~> m2 or kg m-1].
+ intent(out) :: Datv !< The effective meridional face area [H L ~> m2 or kg m-1].
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
integer, optional, intent(in) :: halo !< The extra halo size to use here.
logical, optional, intent(in) :: maximize !< If present and true, find the
!! maximum face area for any velocity.
@@ -3534,14 +3536,15 @@ end subroutine swap
!> This subroutine determines the open face areas of cells for calculating
!! the barotropic transport.
-subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max)
+subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max)
type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays.
real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
- intent(out) :: Datu !< The open zonal face area [H m ~> m2 or kg m-1].
+ intent(out) :: Datu !< The open zonal face area [H L ~> m2 or kg m-1].
real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
- intent(out) :: Datv !< The open meridional face area [H m ~> m2 or kg m-1].
+ intent(out) :: Datv !< The open meridional face area [H L ~> m2 or kg m-1].
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(barotropic_CS), pointer :: CS !< The control structure returned by a previous
!! call to barotropic_init.
real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), &
@@ -3728,8 +3731,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
#include "version_variable.h"
! Local variables
character(len=40) :: mdl = "MOM_barotropic" ! This module's name.
- real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H m ~> m2 or kg m-1].
- real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H m ~> m2 or kg m-1].
+ real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H L ~> m2 or kg m-1].
+ real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H L ~> m2 or kg m-1].
real :: gtot_estimate ! Summed GV%g_prime [L2 Z-1 T-2 ~> m s-2], to give an upper-bound estimate for pbce.
real :: SSH_extra ! An estimate of how much higher SSH might get, for use
! in calculating the safe external wave speed [Z ~> m].
@@ -3741,8 +3744,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, 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 :: vel_rescale ! A rescaling factor for horizontal velocity 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, allocatable, dimension(:,:) :: lin_drag_h
type(memory_size_type) :: MS
type(group_pass_type) :: pass_static_data, pass_q_D_Cor
@@ -3862,12 +3867,12 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
"The length scale at which the Rayleigh damping rate due "//&
"to the ice strength should be the same as if a Laplacian "//&
"were applied, if DYNAMIC_SURFACE_PRESSURE is true.", &
- units="m", default=1.0e4)
+ units="m", default=1.0e4, scale=US%m_to_L)
call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, &
"The minimum depth to use in limiting the size of the "//&
"dynamic surface pressure for stability, if "//&
- "DYNAMIC_SURFACE_PRESSURE is true..", units="m", &
- default=1.0e-6)
+ "DYNAMIC_SURFACE_PRESSURE is true..", &
+ units="m", default=1.0e-6, scale=US%m_to_Z)
call get_param(param_file, mdl, "CONST_DYN_PSURF", CS%const_dyn_psurf, &
"The constant that scales the dynamic surface pressure, "//&
"if DYNAMIC_SURFACE_PRESSURE is true. Stable values "//&
@@ -3943,7 +3948,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
units="nondim", default=0.5, do_not_log=.not.CS%clip_velocity)
call get_param(param_file, mdl, "MAXVEL", CS%maxvel, &
"The maximum velocity allowed before the velocity "//&
- "components are truncated.", units="m s-1", default=3.0e8, &
+ "components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T, &
do_not_log=.not.CS%clip_velocity)
call get_param(param_file, mdl, "MAXCFL_BT_CONT", CS%maxCFL_BT_cont, &
"The maximum permitted CFL number associated with the "//&
@@ -3954,7 +3959,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
"A negligibly small velocity magnitude below which velocity "//&
"components are set to 0. A reasonable value might be "//&
"1e-30 m/s, which is less than an Angstrom divided by "//&
- "the age of the universe.", units="m s-1", default=0.0)
+ "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T)
call get_param(param_file, mdl, "DT_BT_FILTER", CS%dt_bt_filter, &
"A time-scale over which the barotropic mode solutions "//&
@@ -3962,6 +3967,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
"of DT if negative. When used this can never be taken to "//&
"be longer than 2*dt. Set this to 0 to apply no filtering.", &
units="sec or nondim", default=-0.25)
+ if (CS%dt_bt_filter > 0.0) CS%dt_bt_filter = US%s_to_T*CS%dt_bt_filter
call get_param(param_file, mdl, "G_BT_EXTRA", CS%G_extra, &
"A nondimensional factor by which gtot is enhanced.", &
units="nondim", default=0.0)
@@ -4073,24 +4079,22 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0
ALLOC_(CS%dx_Cv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%dx_Cv(:,:) = 0.0
do j=G%jsd,G%jed ; do i=G%isd,G%ied
- CS%IareaT(i,j) = G%IareaT(i,j)
+ CS%IareaT(i,j) = US%L_to_m**2*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
+ ! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without
! wide halos.
do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB
- CS%IdxCu(I,j) = G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j)
+ CS%IdxCu(I,j) = US%L_to_m*G%IdxCu(I,j) ; CS%dy_Cu(I,j) = US%m_to_L*G%dy_Cu(I,j)
enddo ; enddo
do J=G%JsdB,G%JedB ; do i=G%isd,G%ied
- CS%IdyCv(I,j) = G%IdyCv(I,j) ; CS%dx_Cv(i,J) = G%dx_Cv(i,J)
+ CS%IdyCv(I,j) = US%L_to_m*G%IdyCv(I,j) ; CS%dx_Cv(i,J) = US%m_to_L*G%dx_Cv(i,J)
enddo ; enddo
call create_group_pass(pass_static_data, CS%IareaT, CS%BT_domain, To_All)
call create_group_pass(pass_static_data, CS%bathyT, CS%BT_domain, To_All)
- call create_group_pass(pass_static_data, CS%IdxCu, CS%IdyCv, CS%BT_domain, &
- To_All+Scalar_Pair)
- call create_group_pass(pass_static_data, CS%dy_Cu, CS%dx_Cv, CS%BT_domain, &
- To_All+Scalar_Pair)
+ call create_group_pass(pass_static_data, CS%IdxCu, CS%IdyCv, CS%BT_domain, To_All+Scalar_Pair)
+ call create_group_pass(pass_static_data, CS%dy_Cu, CS%dx_Cv, CS%BT_domain, To_All+Scalar_Pair)
call do_group_pass(pass_static_data, CS%BT_domain)
if (CS%linearized_BT_PV) then
@@ -4106,7 +4110,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
enddo ; enddo
do J=js-1,je ; do I=is-1,ie
if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then
- CS%q_D(I,J) = 0.25 * US%s_to_T*G%CoriolisBu(I,J) * &
+ 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)) )
@@ -4131,16 +4135,16 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file)
call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file)
- allocate(lin_drag_h(isd:ied,jsd:jed)) ; CS%lin_drag_u(:,:) = 0.0
+ allocate(lin_drag_h(isd:ied,jsd:jed)) ; lin_drag_h(:,:) = 0.0
- call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain)
+ call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain, scale=US%m_to_Z*US%T_to_s)
call pass_var(lin_drag_h, G%Domain)
do j=js,je ; do I=is-1,ie
- CS%lin_drag_u(I,j) = (GV%m_to_H * wave_drag_scale) * &
+ CS%lin_drag_u(I,j) = (GV%Z_to_H * wave_drag_scale) * &
0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j))
enddo ; enddo
do J=js-1,je ; do i=is,ie
- CS%lin_drag_v(i,J) = (GV%m_to_H * wave_drag_scale) * &
+ CS%lin_drag_v(i,J) = (GV%Z_to_H * wave_drag_scale) * &
0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1))
enddo ; enddo
deallocate(lin_drag_h)
@@ -4177,38 +4181,38 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
endif
CS%id_PFu_bt = register_diag_field('ocean_model', 'PFuBT', diag%axesCu1, Time, &
- 'Zonal Anomalous Barotropic Pressure Force Force Acceleration', 'm s-2')
+ 'Zonal Anomalous Barotropic Pressure Force Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
CS%id_PFv_bt = register_diag_field('ocean_model', 'PFvBT', diag%axesCv1, Time, &
- 'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2')
+ 'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
CS%id_Coru_bt = register_diag_field('ocean_model', 'CoruBT', diag%axesCu1, Time, &
- 'Zonal Barotropic Coriolis Acceleration', 'm s-2')
+ 'Zonal Barotropic Coriolis Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
CS%id_Corv_bt = register_diag_field('ocean_model', 'CorvBT', diag%axesCv1, Time, &
- 'Meridional Barotropic Coriolis Acceleration', 'm s-2')
+ 'Meridional Barotropic Coriolis Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
CS%id_uaccel = register_diag_field('ocean_model', 'u_accel_bt', diag%axesCu1, Time, &
- 'Barotropic zonal acceleration', 'm s-2')
+ 'Barotropic zonal acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
CS%id_vaccel = register_diag_field('ocean_model', 'v_accel_bt', diag%axesCv1, Time, &
- 'Barotropic meridional acceleration', 'm s-2')
+ 'Barotropic meridional acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
CS%id_ubtforce = register_diag_field('ocean_model', 'ubtforce', diag%axesCu1, Time, &
- 'Barotropic zonal acceleration from baroclinic terms', 'm s-2')
+ 'Barotropic zonal acceleration from baroclinic terms', 'm s-2', conversion=US%L_T2_to_m_s2)
CS%id_vbtforce = register_diag_field('ocean_model', 'vbtforce', diag%axesCv1, Time, &
- 'Barotropic meridional acceleration from baroclinic terms', 'm s-2')
+ 'Barotropic meridional acceleration from baroclinic terms', 'm s-2', conversion=US%L_T2_to_m_s2)
CS%id_eta_bt = register_diag_field('ocean_model', 'eta_bt', diag%axesT1, Time, &
'Barotropic end SSH', thickness_units)
CS%id_ubt = register_diag_field('ocean_model', 'ubt', diag%axesCu1, Time, &
- 'Barotropic end zonal velocity', 'm s-1')
+ 'Barotropic end zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
CS%id_vbt = register_diag_field('ocean_model', 'vbt', diag%axesCv1, Time, &
- 'Barotropic end meridional velocity', 'm s-1')
+ 'Barotropic end meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
CS%id_eta_st = register_diag_field('ocean_model', 'eta_st', diag%axesT1, Time, &
'Barotropic start SSH', thickness_units)
CS%id_ubt_st = register_diag_field('ocean_model', 'ubt_st', diag%axesCu1, Time, &
- 'Barotropic start zonal velocity', 'm s-1')
+ 'Barotropic start zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
CS%id_vbt_st = register_diag_field('ocean_model', 'vbt_st', diag%axesCv1, Time, &
- 'Barotropic start meridional velocity', 'm s-1')
+ 'Barotropic start meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
CS%id_ubtav = register_diag_field('ocean_model', 'ubtav', diag%axesCu1, Time, &
- 'Barotropic time-average zonal velocity', 'm s-1')
+ 'Barotropic time-average zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
CS%id_vbtav = register_diag_field('ocean_model', 'vbtav', diag%axesCv1, Time, &
- 'Barotropic time-average meridional velocity', 'm s-1')
+ 'Barotropic time-average meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
CS%id_eta_cor = register_diag_field('ocean_model', 'eta_cor', diag%axesT1, Time, &
'Corrective mass flux', 'm s-1')
CS%id_visc_rem_u = register_diag_field('ocean_model', 'visc_rem_u', diag%axesCuL, Time, &
@@ -4216,19 +4220,19 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
CS%id_visc_rem_v = register_diag_field('ocean_model', 'visc_rem_v', diag%axesCvL, Time, &
'Viscous remnant at v', 'nondim')
CS%id_gtotn = register_diag_field('ocean_model', 'gtot_n', diag%axesT1, Time, &
- 'gtot to North', 'm s-2')
+ 'gtot to North', 'm s-2', conversion=US%L_T_to_m_s**2)
CS%id_gtots = register_diag_field('ocean_model', 'gtot_s', diag%axesT1, Time, &
- 'gtot to South', 'm s-2')
+ 'gtot to South', 'm s-2', conversion=US%L_T_to_m_s**2)
CS%id_gtote = register_diag_field('ocean_model', 'gtot_e', diag%axesT1, Time, &
- 'gtot to East', 'm s-2')
+ 'gtot to East', 'm s-2', conversion=US%L_T_to_m_s**2)
CS%id_gtotw = register_diag_field('ocean_model', 'gtot_w', diag%axesT1, Time, &
- 'gtot to West', 'm s-2')
+ 'gtot to West', 'm s-2', conversion=US%L_T_to_m_s**2)
CS%id_eta_hifreq = register_diag_field('ocean_model', 'eta_hifreq', diag%axesT1, Time, &
'High Frequency Barotropic SSH', thickness_units)
CS%id_ubt_hifreq = register_diag_field('ocean_model', 'ubt_hifreq', diag%axesCu1, Time, &
- 'High Frequency Barotropic zonal velocity', 'm s-1')
+ 'High Frequency Barotropic zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
CS%id_vbt_hifreq = register_diag_field('ocean_model', 'vbt_hifreq', diag%axesCv1, Time, &
- 'High Frequency Barotropic meridional velocity', 'm s-1')
+ 'High Frequency Barotropic meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
CS%id_eta_pred_hifreq = register_diag_field('ocean_model', 'eta_pred_hifreq', diag%axesT1, Time, &
'High Frequency Predictor Barotropic SSH', thickness_units)
CS%id_uhbt_hifreq = register_diag_field('ocean_model', 'uhbt_hifreq', diag%axesCu1, Time, &
@@ -4250,34 +4254,34 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
if (use_BT_cont_type) then
CS%id_BTC_FA_u_EE = register_diag_field('ocean_model', 'BTC_FA_u_EE', diag%axesCu1, Time, &
- 'BTCont type far east face area', 'm2')
+ 'BTCont type far east face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
CS%id_BTC_FA_u_E0 = register_diag_field('ocean_model', 'BTC_FA_u_E0', diag%axesCu1, Time, &
- 'BTCont type near east face area', 'm2')
+ 'BTCont type near east face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
CS%id_BTC_FA_u_WW = register_diag_field('ocean_model', 'BTC_FA_u_WW', diag%axesCu1, Time, &
- 'BTCont type far west face area', 'm2')
+ 'BTCont type far west face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
CS%id_BTC_FA_u_W0 = register_diag_field('ocean_model', 'BTC_FA_u_W0', diag%axesCu1, Time, &
- 'BTCont type near west face area', 'm2')
+ 'BTCont type near west face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
CS%id_BTC_ubt_EE = register_diag_field('ocean_model', 'BTC_ubt_EE', diag%axesCu1, Time, &
'BTCont type far east velocity', 'm s-1')
CS%id_BTC_ubt_WW = register_diag_field('ocean_model', 'BTC_ubt_WW', diag%axesCu1, Time, &
'BTCont type far west velocity', 'm s-1')
CS%id_BTC_FA_v_NN = register_diag_field('ocean_model', 'BTC_FA_v_NN', diag%axesCv1, Time, &
- 'BTCont type far north face area', 'm2')
+ 'BTCont type far north face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
CS%id_BTC_FA_v_N0 = register_diag_field('ocean_model', 'BTC_FA_v_N0', diag%axesCv1, Time, &
- 'BTCont type near north face area', 'm2')
+ 'BTCont type near north face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
CS%id_BTC_FA_v_SS = register_diag_field('ocean_model', 'BTC_FA_v_SS', diag%axesCv1, Time, &
- 'BTCont type far south face area', 'm2')
+ 'BTCont type far south face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
CS%id_BTC_FA_v_S0 = register_diag_field('ocean_model', 'BTC_FA_v_S0', diag%axesCv1, Time, &
- 'BTCont type near south face area', 'm2')
+ 'BTCont type near south face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
CS%id_BTC_vbt_NN = register_diag_field('ocean_model', 'BTC_vbt_NN', diag%axesCv1, Time, &
- 'BTCont type far north velocity', 'm s-1')
+ 'BTCont type far north velocity', 'm s-1', conversion=US%L_T_to_m_s)
CS%id_BTC_vbt_SS = register_diag_field('ocean_model', 'BTC_vbt_SS', diag%axesCv1, Time, &
- 'BTCont type far south velocity', 'm s-1')
+ 'BTCont type far south velocity', 'm s-1', conversion=US%L_T_to_m_s)
endif
CS%id_uhbt0 = register_diag_field('ocean_model', 'uhbt0', diag%axesCu1, Time, &
- 'Barotropic zonal transport difference', 'm3 s-1')
+ 'Barotropic zonal transport difference', 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T)
CS%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, Time, &
- 'Barotropic meridional transport difference', 'm3 s-1')
+ 'Barotropic meridional transport difference', 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T)
if (CS%id_frhatu1 > 0) call safe_alloc_ptr(CS%frhatu1, IsdB,IedB,jsd,jed,nz)
if (CS%id_frhatv1 > 0) call safe_alloc_ptr(CS%frhatv1, isd,ied,JsdB,JedB,nz)
@@ -4287,17 +4291,26 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
call btcalc(h, G, GV, CS, may_use_default=.true.)
CS%ubtav(:,:) = 0.0 ; CS%vbtav(:,:) = 0.0
do k=1,nz ; do j=js,je ; do I=is-1,ie
- CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * u(I,j,k)
+ CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * US%m_s_to_L_T*u(I,j,k)
enddo ; enddo ; enddo
do k=1,nz ; do J=js-1,je ; do i=is,ie
- CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * v(i,J,k)
+ CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * US%m_s_to_L_T*v(i,J,k)
enddo ; enddo ; enddo
+ elseif ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. &
+ (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then
+ do j=js,je ; do I=is-1,ie ; CS%ubtav(I,j) = vel_rescale * CS%ubtav(I,j) ; enddo ; enddo
+ do J=js-1,je ; do i=is,ie ; CS%vbtav(i,J) = vel_rescale * CS%vbtav(I,j) ; enddo ; enddo
endif
if (.NOT.query_initialized(CS%ubt_IC,"ubt_IC",restart_CS) .or. &
.NOT.query_initialized(CS%vbt_IC,"vbt_IC",restart_CS)) then
do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = CS%ubtav(I,j) ; enddo ; enddo
do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = CS%vbtav(i,J) ; enddo ; enddo
+ elseif ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. &
+ (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then
+ vel_rescale = (US%m_to_L*US%s_to_T_restart) / (US%m_to_L_restart*US%s_to_T)
+ do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = vel_rescale * CS%ubt_IC(I,j) ; enddo ; enddo
+ do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = vel_rescale * CS%vbt_IC(I,j) ; enddo ; enddo
endif
! Calculate other constants which are used for btstep.
@@ -4327,12 +4340,12 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
! enddo ; enddo
! endif
- call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=1)
+ call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1)
if (CS%bound_BT_corr) then
! ### Consider replacing maxvel with G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt)
! ### and G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt)
do j=js,je ; do i=is,ie
- CS%eta_cor_bound(i,j) = GV%m_to_H * G%IareaT(i,j) * 0.1 * CS%maxvel * &
+ CS%eta_cor_bound(i,j) = GV%m_to_H * US%L_to_m**2*G%IareaT(i,j) * 0.1 * CS%maxvel * &
((Datu(I-1,j) + Datu(I,j)) + (Datv(i,J) + Datv(i,J-1)))
enddo ; enddo
endif
@@ -4341,8 +4354,11 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, 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
+ elseif ((US%s_to_T_restart * US%m_to_L_restart * GV%m_to_H_restart /= 0.0) .and. &
+ ((US%s_to_T_restart * US%m_to_L**2 * GV%m_to_H) /= &
+ (US%s_to_T * US%m_to_L_restart**2 * GV%m_to_H_restart))) then
+ uH_rescale = (US%s_to_T_restart * US%m_to_L**2 * GV%m_to_H) / &
+ (US%s_to_T * US%m_to_L_restart**2 * 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
@@ -4365,23 +4381,23 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
end subroutine barotropic_init
!> Copies ubtav and vbtav from private type into arrays
-subroutine barotropic_get_tav(CS, ubtav, vbtav, G)
- type(barotropic_CS), pointer :: CS !< Control structure for
- !! this module
- type(ocean_grid_type), intent(in) :: G !< Grid structure
- real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav!< zonal barotropic vel.
- !! ave. over baroclinic time-step (m s-1)
- real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav!< meridional barotropic vel.
- !! ave. over baroclinic time-step (m s-1)
+subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US)
+ type(barotropic_CS), pointer :: CS !< Control structure for this module
+ type(ocean_grid_type), intent(in) :: G !< Grid structure
+ real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged
+ !! over a baroclinic timestep [m s-1]
+ real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged
+ !! over a baroclinic timestep [m s-1]
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
! Local variables
integer :: i,j
- do j = G%jsc, G%jec ; do I = G%isc-1, G%iec
- ubtav(I,j) = CS%ubtav(I,j)
+ do j=G%jsc,G%jec ; do I=G%isc-1,G%iec
+ ubtav(I,j) = US%L_T_to_m_s*CS%ubtav(I,j)
enddo ; enddo
- do J = G%jsc-1, G%jec ; do i = G%isc, G%iec
- vbtav(i,J) = CS%vbtav(i,J)
+ do J=G%jsc-1,G%jec ; do i=G%isc,G%iec
+ vbtav(i,J) = US%L_T_to_m_s*CS%vbtav(i,J)
enddo ; enddo
end subroutine barotropic_get_tav
diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90
index ce69c9816c..5bca916ab5 100644
--- a/src/core/MOM_continuity.F90
+++ b/src/core/MOM_continuity.F90
@@ -12,6 +12,7 @@ module MOM_continuity
use MOM_string_functions, only : uppercase
use MOM_grid, only : ocean_grid_type
use MOM_open_boundary, only : ocean_OBC_type
+use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : BT_cont_type
use MOM_verticalGrid, only : verticalGrid_type
@@ -38,7 +39,7 @@ module MOM_continuity
!> Time steps the layer thicknesses, using a monotonically limited, directionally split PPM scheme,
!! based on Lin (1994).
-subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, &
+subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, &
visc_rem_u, visc_rem_v, u_cor, v_cor, &
uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont)
type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure.
@@ -58,6 +59,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, &
intent(out) :: vh !< Volume flux through meridional faces =
!! v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1].
real, intent(in) :: dt !< Time increment [s].
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(continuity_CS), pointer :: CS !< Control structure for mom_continuity.
real, dimension(SZIB_(G),SZJ_(G)), &
optional, intent(in) :: uhbt !< The vertically summed volume
@@ -117,7 +119,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, &
" or neither.")
if (CS%continuity_scheme == PPM_SCHEME) then
- call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS%PPM_CSp, uhbt, vhbt, OBC, &
+ call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, uhbt, vhbt, OBC, &
visc_rem_u, visc_rem_v, u_cor, v_cor, &
uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont)
else
diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90
index 4cf410160b..a55166e7ff 100644
--- a/src/core/MOM_continuity_PPM.F90
+++ b/src/core/MOM_continuity_PPM.F90
@@ -10,6 +10,7 @@ module MOM_continuity_PPM
use MOM_grid, only : ocean_grid_type
use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type, OBC_NONE
use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S
+use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : BT_cont_type
use MOM_verticalGrid, only : verticalGrid_type
@@ -72,7 +73,7 @@ module MOM_continuity_PPM
!> Time steps the layer thicknesses, using a monotonically limit, directionally split PPM scheme,
!! based on Lin (1994).
-subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, &
+subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, &
visc_rem_u, visc_rem_v, u_cor, v_cor, &
uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
@@ -91,6 +92,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
intent(out) :: vh !< Meridional volume flux, v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1].
real, intent(in) :: dt !< Time increment [s].
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure.
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZIB_(G),SZJ_(G)), &
optional, intent(in) :: uhbt !< The summed volume flux through zonal faces
!! [H m2 s-1 ~> m3 s-1 or kg s-1].
@@ -163,7 +165,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
! First, advect zonally.
LB%ish = G%isc ; LB%ieh = G%iec
LB%jsh = G%jsc-stencil ; LB%jeh = G%jec+stencil
- call zonal_mass_flux(u, hin, uh, dt, G, GV, CS, LB, uhbt, OBC, visc_rem_u, &
+ call zonal_mass_flux(u, hin, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, &
u_cor, uhbt_aux, u_cor_aux, BT_cont)
call cpu_clock_begin(id_clock_update)
@@ -179,7 +181,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
! Now advect meridionally, using the updated thicknesses to determine
! the fluxes.
- call meridional_mass_flux(v, h, vh, dt, G, GV, CS, LB, vhbt, OBC, visc_rem_v, &
+ call meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, &
v_cor, vhbt_aux, v_cor_aux, BT_cont)
call cpu_clock_begin(id_clock_update)
@@ -196,7 +198,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
LB%ish = G%isc-stencil ; LB%ieh = G%iec+stencil
LB%jsh = G%jsc ; LB%jeh = G%jec
- call meridional_mass_flux(v, hin, vh, dt, G, GV, CS, LB, vhbt, OBC, visc_rem_v, &
+ call meridional_mass_flux(v, hin, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, &
v_cor, vhbt_aux, v_cor_aux, BT_cont)
call cpu_clock_begin(id_clock_update)
@@ -209,7 +211,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
! Now advect zonally, using the updated thicknesses to determine
! the fluxes.
LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec
- call zonal_mass_flux(u, h, uh, dt, G, GV, CS, LB, uhbt, OBC, visc_rem_u, &
+ call zonal_mass_flux(u, h, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, &
u_cor, uhbt_aux, u_cor_aux, BT_cont)
call cpu_clock_begin(id_clock_update)
@@ -226,7 +228,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
end subroutine continuity_PPM
!> Calculates the mass or volume fluxes through the zonal faces, and other related quantities.
-subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, &
+subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, &
visc_rem_u, u_cor, uhbt_aux, u_cor_aux, BT_cont)
type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure.
@@ -238,6 +240,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, &
intent(out) :: uh !< Volume flux through zonal faces = u*h*dy
!! [H m2 s-1 ~> m3 s-1 or kg s-1].
real, intent(in) :: dt !< Time increment [s].
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
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), &
@@ -475,7 +478,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, &
if (set_BT_cont) then
call set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,&
- du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, &
+ du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, &
visc_rem_max, j, ish, ieh, do_I)
if (any_simple_OBC) then
do I=ish-1,ieh
@@ -489,8 +492,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, &
OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)
endif ; enddo ; enddo
do I=ish-1,ieh ; if (do_I(I)) then
- BT_cont%Fa_u_W0(I,j) = FAuI(I) ; BT_cont%Fa_u_E0(I,j) = FAuI(I)
- BT_cont%Fa_u_WW(I,j) = FAuI(I) ; BT_cont%Fa_u_EE(I,j) = FAuI(I)
+ BT_cont%FA_u_W0(I,j) = US%m_to_L*FAuI(I) ; BT_cont%FA_u_E0(I,j) = US%m_to_L*FAuI(I)
+ BT_cont%FA_u_WW(I,j) = US%m_to_L*FAuI(I) ; BT_cont%FA_u_EE(I,j) = US%m_to_L*FAuI(I)
BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0
endif ; enddo
endif
@@ -505,17 +508,17 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, &
if (OBC%segment(n)%direction == OBC_DIRECTION_E) then
do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed
FA_u = 0.0
- do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*G%dy_Cu(I,j) ; enddo
- BT_cont%Fa_u_W0(I,j) = FA_u ; BT_cont%Fa_u_E0(I,j) = FA_u
- BT_cont%Fa_u_WW(I,j) = FA_u ; BT_cont%Fa_u_EE(I,j) = FA_u
+ do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*US%m_to_L*G%dy_Cu(I,j) ; enddo
+ BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u
+ BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u
BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0
enddo
else
do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed
FA_u = 0.0
- do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*G%dy_Cu(I,j) ; enddo
- BT_cont%Fa_u_W0(I,j) = FA_u ; BT_cont%Fa_u_E0(I,j) = FA_u
- BT_cont%Fa_u_WW(I,j) = FA_u ; BT_cont%Fa_u_EE(I,j) = FA_u
+ do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*US%m_to_L*G%dy_Cu(I,j) ; enddo
+ BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u
+ BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u
BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0
enddo
endif
@@ -883,7 +886,7 @@ end subroutine zonal_flux_adjust
!> Sets a structure that describes the zonal barotropic volume or mass fluxes as a
!! function of barotropic flow to agree closely with the sum of the layer's transports.
subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, &
- du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, &
+ du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, &
visc_rem_max, j, ish, ieh, do_I)
type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure.
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1].
@@ -904,6 +907,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,
real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable
!! value of du [m s-1].
real, intent(in) :: dt !< Time increment [s].
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
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
@@ -1021,9 +1025,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,
if (FA_avg > max(FA_0, FAmt_L(I))) then ; FA_avg = max(FA_0, FAmt_L(I))
elseif (FA_avg < min(FA_0, FAmt_L(I))) then ; FA_0 = FA_avg ; endif
- BT_cont%FA_u_W0(I,j) = FA_0 ; BT_cont%FA_u_WW(I,j) = FAmt_L(I)
+ BT_cont%FA_u_W0(I,j) = US%m_to_L*FA_0 ; BT_cont%FA_u_WW(I,j) = US%m_to_L*FAmt_L(I)
if (abs(FA_0-FAmt_L(I)) <= 1e-12*FA_0) then ; BT_cont%uBT_WW(I,j) = 0.0 ; else
- BT_cont%uBT_WW(I,j) = (1.5 * (duL(I) - du0(I))) * &
+ BT_cont%uBT_WW(I,j) = US%m_s_to_L_T*(1.5 * (duL(I) - du0(I))) * &
((FAmt_L(I) - FA_avg) / (FAmt_L(I) - FA_0))
endif
@@ -1033,9 +1037,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,
if (FA_avg > max(FA_0, FAmt_R(I))) then ; FA_avg = max(FA_0, FAmt_R(I))
elseif (FA_avg < min(FA_0, FAmt_R(I))) then ; FA_0 = FA_avg ; endif
- BT_cont%FA_u_E0(I,j) = FA_0 ; BT_cont%FA_u_EE(I,j) = FAmt_R(I)
+ BT_cont%FA_u_E0(I,j) = US%m_to_L*FA_0 ; BT_cont%FA_u_EE(I,j) = US%m_to_L*FAmt_R(I)
if (abs(FAmt_R(I) - FA_0) <= 1e-12*FA_0) then ; BT_cont%uBT_EE(I,j) = 0.0 ; else
- BT_cont%uBT_EE(I,j) = (1.5 * (duR(I) - du0(I))) * &
+ BT_cont%uBT_EE(I,j) = US%m_s_to_L_T*(1.5 * (duR(I) - du0(I))) * &
((FAmt_R(I) - FA_avg) / (FAmt_R(I) - FA_0))
endif
else
@@ -1047,7 +1051,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,
end subroutine set_zonal_BT_cont
!> Calculates the mass or volume fluxes through the meridional faces, and other related quantities.
-subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, &
+subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, &
visc_rem_v, v_cor, vhbt_aux, v_cor_aux, BT_cont)
type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure.
@@ -1057,6 +1061,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, &
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional
!! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1].
real, intent(in) :: dt !< Time increment [s].
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
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 !< Open boundary condition type
@@ -1290,7 +1295,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, &
if (set_BT_cont) then
call set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,&
- dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, &
+ dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, &
visc_rem_max, J, ish, ieh, do_I)
if (any_simple_OBC) then
do i=ish,ieh
@@ -1305,8 +1310,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, &
OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)
endif ; enddo ; enddo
do i=ish,ieh ; if (do_I(i)) then
- BT_cont%FA_v_S0(i,J) = FAvi(i) ; BT_cont%FA_v_N0(i,J) = FAvi(i)
- BT_cont%FA_v_SS(i,J) = FAvi(i) ; BT_cont%FA_v_NN(i,J) = FAvi(i)
+ BT_cont%FA_v_S0(i,J) = US%m_to_L*FAvi(i) ; BT_cont%FA_v_N0(i,J) = US%m_to_L*FAvi(i)
+ BT_cont%FA_v_SS(i,J) = US%m_to_L*FAvi(i) ; BT_cont%FA_v_NN(i,J) = US%m_to_L*FAvi(i)
BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0
endif ; enddo
endif
@@ -1322,17 +1327,17 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, &
if (OBC%segment(n)%direction == OBC_DIRECTION_N) then
do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied
FA_v = 0.0
- do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*G%dx_Cv(i,J) ; enddo
- BT_cont%Fa_v_S0(i,J) = FA_v ; BT_cont%Fa_v_N0(i,J) = FA_v
- BT_cont%Fa_v_SS(i,J) = FA_v ; BT_cont%Fa_v_NN(i,J) = FA_v
+ do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*US%m_to_L*G%dx_Cv(i,J) ; enddo
+ BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v
+ BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v
BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0
enddo
else
do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied
FA_v = 0.0
- do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*G%dx_Cv(i,J) ; enddo
- BT_cont%Fa_v_S0(i,J) = FA_v ; BT_cont%Fa_v_N0(i,J) = FA_v
- BT_cont%Fa_v_SS(i,J) = FA_v ; BT_cont%Fa_v_NN(i,J) = FA_v
+ do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*US%m_to_L*G%dx_Cv(i,J) ; enddo
+ BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v
+ BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v
BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0
enddo
endif
@@ -1704,7 +1709,7 @@ end subroutine meridional_flux_adjust
!> Sets of a structure that describes the meridional barotropic volume or mass fluxes as a
!! function of barotropic flow to agree closely with the sum of the layer's transports.
subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, &
- dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, &
+ dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, &
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 [m s-1].
@@ -1723,6 +1728,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,
real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1].
real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1].
real, intent(in) :: dt !< Time increment [s].
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
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
@@ -1839,9 +1845,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,
FA_avg = vhtot_L(i) / (dvL(i) - dv0(i))
if (FA_avg > max(FA_0, FAmt_L(i))) then ; FA_avg = max(FA_0, FAmt_L(i))
elseif (FA_avg < min(FA_0, FAmt_L(i))) then ; FA_0 = FA_avg ; endif
- BT_cont%FA_v_S0(i,J) = FA_0 ; BT_cont%FA_v_SS(i,J) = FAmt_L(i)
+ BT_cont%FA_v_S0(i,J) = US%m_to_L*FA_0 ; BT_cont%FA_v_SS(i,J) = US%m_to_L*FAmt_L(i)
if (abs(FA_0-FAmt_L(i)) <= 1e-12*FA_0) then ; BT_cont%vBT_SS(i,J) = 0.0 ; else
- BT_cont%vBT_SS(i,J) = (1.5 * (dvL(i) - dv0(i))) * &
+ BT_cont%vBT_SS(i,J) = US%m_s_to_L_T*(1.5 * (dvL(i) - dv0(i))) * &
((FAmt_L(i) - FA_avg) / (FAmt_L(i) - FA_0))
endif
@@ -1850,9 +1856,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,
FA_avg = vhtot_R(i) / (dvR(i) - dv0(i))
if (FA_avg > max(FA_0, FAmt_R(i))) then ; FA_avg = max(FA_0, FAmt_R(i))
elseif (FA_avg < min(FA_0, FAmt_R(i))) then ; FA_0 = FA_avg ; endif
- BT_cont%FA_v_N0(i,J) = FA_0 ; BT_cont%FA_v_NN(i,J) = FAmt_R(i)
+ BT_cont%FA_v_N0(i,J) = US%m_to_L*FA_0 ; BT_cont%FA_v_NN(i,J) = US%m_to_L*FAmt_R(i)
if (abs(FAmt_R(i) - FA_0) <= 1e-12*FA_0) then ; BT_cont%vBT_NN(i,J) = 0.0 ; else
- BT_cont%vBT_NN(i,J) = (1.5 * (dvR(i) - dv0(i))) * &
+ BT_cont%vBT_NN(i,J) = US%m_s_to_L_T*(1.5 * (dvR(i) - dv0(i))) * &
((FAmt_R(i) - FA_avg) / (FAmt_R(i) - FA_0))
endif
else
diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90
index 45c6a26cdb..f256df6508 100644
--- a/src/core/MOM_dynamics_split_RK2.F90
+++ b/src/core/MOM_dynamics_split_RK2.F90
@@ -518,7 +518,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, &
! u_accel_bt = layer accelerations due to barotropic solver
if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then
call cpu_clock_begin(id_clock_continuity)
- call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, &
+ call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, &
CS%continuity_CSp, OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, &
visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont)
call cpu_clock_end(id_clock_continuity)
@@ -607,7 +607,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, &
! uh = u_av * h
! hp = h + dt * div . uh
call cpu_clock_begin(id_clock_continuity)
- call continuity(up, vp, h, hp, uh, vh, dt, G, GV, CS%continuity_CSp, &
+ call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, &
CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, &
u_av, v_av, BT_cont=CS%BT_cont)
call cpu_clock_end(id_clock_continuity)
@@ -811,7 +811,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, &
! h = h + dt * div . uh
! u_av and v_av adjusted so their mass transports match uhbt and vhbt.
call cpu_clock_begin(id_clock_continuity)
- call continuity(u, v, h, h, uh, vh, dt, G, GV, &
+ call continuity(u, v, h, h, uh, vh, dt, G, GV, US, &
CS%continuity_CSp, CS%uhbt, CS%vhbt, CS%OBC, &
CS%visc_rem_u, CS%visc_rem_v, u_av, v_av)
call cpu_clock_end(id_clock_continuity)
@@ -1162,7 +1162,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param
if (.not. query_initialized(uh,"uh",restart_CS) .or. &
.not. query_initialized(vh,"vh",restart_CS)) then
h_tmp(:,:,:) = h(:,:,:)
- call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, CS%continuity_CSp, OBC=CS%OBC)
+ call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC)
call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init)
CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:))
else
diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90
index cd09e7a11e..07c4648b87 100644
--- a/src/core/MOM_dynamics_unsplit.F90
+++ b/src/core/MOM_dynamics_unsplit.F90
@@ -263,7 +263,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
! uh = u*h
! hp = h + dt/2 div . uh
call cpu_clock_begin(id_clock_continuity)
- call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, CS%continuity_CSp, &
+ call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, &
OBC=CS%OBC)
call cpu_clock_end(id_clock_continuity)
call pass_var(hp, G%Domain, clock=id_clock_pass)
@@ -356,7 +356,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
! h_av = hp + dt/2 div . uh
call cpu_clock_begin(id_clock_continuity)
call continuity(up, vp, hp, h_av, uh, vh, &
- (0.5*dt), G, GV, CS%continuity_CSp, OBC=CS%OBC)
+ (0.5*dt), G, GV, US, CS%continuity_CSp, OBC=CS%OBC)
call cpu_clock_end(id_clock_continuity)
call pass_var(h_av, G%Domain, clock=id_clock_pass)
call pass_vector(uh, vh, G%Domain, clock=id_clock_pass)
@@ -420,7 +420,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
! h = hp + dt/2 div . uh
call cpu_clock_begin(id_clock_continuity)
call continuity(upp, vpp, hp, h, uh, vh, &
- (dt*0.5), G, GV, CS%continuity_CSp, OBC=CS%OBC)
+ (dt*0.5), G, GV, US, CS%continuity_CSp, OBC=CS%OBC)
call cpu_clock_end(id_clock_continuity)
call pass_var(h, G%Domain, clock=id_clock_pass)
call pass_vector(uh, vh, G%Domain, clock=id_clock_pass)
diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90
index 210cd5ec08..2ad0c50624 100644
--- a/src/core/MOM_dynamics_unsplit_RK2.F90
+++ b/src/core/MOM_dynamics_unsplit_RK2.F90
@@ -279,7 +279,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt,
call cpu_clock_begin(id_clock_continuity)
! This is a duplicate calculation of the last continuity from the previous step
! and could/should be optimized out. -AJA
- call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, CS%continuity_CSp, &
+ call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, CS%continuity_CSp, &
OBC=CS%OBC)
call cpu_clock_end(id_clock_continuity)
call pass_var(hp, G%Domain, clock=id_clock_pass)
@@ -352,7 +352,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt,
! h_av = h + dt div . uh
call cpu_clock_begin(id_clock_continuity)
call continuity(up, vp, h_in, hp, uh, vh, &
- dt, G, GV, CS%continuity_CSp, OBC=CS%OBC)
+ dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC)
call cpu_clock_end(id_clock_continuity)
call pass_var(hp, G%Domain, clock=id_clock_pass)
call pass_vector(uh, vh, G%Domain, clock=id_clock_pass)
@@ -410,7 +410,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt,
! h[n+1] = h[n] + dt div . uh
call cpu_clock_begin(id_clock_continuity)
call continuity(up, vp, h_in, h_in, uh, vh, &
- dt, G, GV, CS%continuity_CSp, OBC=CS%OBC)
+ dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC)
call cpu_clock_end(id_clock_continuity)
call pass_var(h_in, G%Domain, clock=id_clock_pass)
call pass_vector(uh, vh, G%Domain, clock=id_clock_pass)
diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90
index 24bf68a1c9..7117850880 100644
--- a/src/core/MOM_open_boundary.F90
+++ b/src/core/MOM_open_boundary.F90
@@ -124,7 +124,13 @@ module MOM_open_boundary
logical :: specified_tan !< Boundary tangential velocity fixed to external value.
logical :: open !< Boundary is open for continuity solver.
logical :: gradient !< Zero gradient at boundary.
- logical :: values_needed !< Whether or not external OBC fields are needed.
+ logical :: values_needed !< Whether or not any external OBC fields are needed.
+ logical :: u_values_needed!< Whether or not external u OBC fields are needed.
+ logical :: v_values_needed!< Whether or not external v OBC fields are needed.
+ logical :: t_values_needed!< Whether or not external T OBC fields are needed.
+ logical :: s_values_needed!< Whether or not external S OBC fields are needed.
+ logical :: z_values_needed!< Whether or not external zeta OBC fields are needed.
+ logical :: g_values_needed!< Whether or not external gradient OBC fields are needed.
integer :: direction !< Boundary faces one of the four directions.
logical :: is_N_or_S !< True is the OB is facing North or South and exists on this PE.
logical :: is_E_or_W !< True is the OB is facing East or West and exists on this PE.
@@ -320,7 +326,7 @@ subroutine open_boundary_config(G, US, param_file, OBC)
call get_param(param_file, mdl, "NK", OBC%ke, &
"The number of model layers", default=0, do_not_log=.true.)
- if (config1 /= "none") OBC%user_BCs_set_globally = .true.
+ if (config1 /= "none" .and. config1 /= "dyed_obcs") OBC%user_BCs_set_globally = .true.
if (OBC%number_of_segments > 0) then
call get_param(param_file, mdl, "OBC_ZERO_VORTICITY", OBC%zero_vorticity, &
@@ -418,12 +424,18 @@ subroutine open_boundary_config(G, US, param_file, OBC)
OBC%segment(l)%open = .false.
OBC%segment(l)%gradient = .false.
OBC%segment(l)%values_needed = .false.
+ OBC%segment(l)%u_values_needed = .false.
+ OBC%segment(l)%v_values_needed = .false.
+ OBC%segment(l)%t_values_needed = .false.
+ OBC%segment(l)%s_values_needed = .false.
+ OBC%segment(l)%z_values_needed = .false.
+ OBC%segment(l)%g_values_needed = .false.
OBC%segment(l)%direction = OBC_NONE
OBC%segment(l)%is_N_or_S = .false.
OBC%segment(l)%is_E_or_W = .false.
OBC%segment(l)%Velocity_nudging_timescale_in = 0.0
OBC%segment(l)%Velocity_nudging_timescale_out = 0.0
- OBC%segment(l)%num_fields = 0.0
+ OBC%segment(l)%num_fields = 0
enddo
allocate(OBC%segnum_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%segnum_u(:,:) = OBC_NONE
allocate(OBC%segnum_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%segnum_v(:,:) = OBC_NONE
@@ -526,6 +538,7 @@ subroutine initialize_segment_data(G, OBC, PF)
character(len=128) :: inputdir
type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list
character(len=32) :: remappingScheme
+ character(len=256) :: mesg ! Message for error messages.
logical :: check_reconstruction, check_remapping, force_bounds_in_subcell
integer, dimension(4) :: siz,siz2
integer :: is, ie, js, je
@@ -591,6 +604,7 @@ subroutine initialize_segment_data(G, OBC, PF)
do n=1, OBC%number_of_segments
segment => OBC%segment(n)
+ if (.not. segment%values_needed) cycle
write(segnam,"('OBC_SEGMENT_',i3.3,'_DATA')") n
write(suffix,"('_segment_',i3.3)") n
@@ -607,12 +621,13 @@ subroutine initialize_segment_data(G, OBC, PF)
allocate(segment%field(num_fields))
- if (segment%Flather) then
- if (num_fields < 3) call MOM_error(FATAL, &
- "MOM_open_boundary, initialize_segment_data: "//&
- "Need at least three inputs for Flather")
- endif
- segment%num_fields = num_fields ! these are at least three input fields required for the Flather option
+! This should be happening with the x_values_needed.
+! if (segment%Flather) then
+! if (num_fields < 3) call MOM_error(FATAL, &
+! "MOM_open_boundary, initialize_segment_data: "//&
+! "Need at least three inputs for Flather")
+! endif
+ segment%num_fields = num_fields
segment%temp_segment_data_exists=.false.
segment%salt_segment_data_exists=.false.
@@ -630,16 +645,20 @@ subroutine initialize_segment_data(G, OBC, PF)
if (trim(filename) /= 'none') then
OBC%update_OBC = .true. ! Data is assumed to be time-dependent if we are reading from file
OBC%needs_IO_for_data = .true. ! At least one segment is using I/O for OBC data
- segment%values_needed = .true. ! Indicates that i/o will be needed for this segment
+! segment%values_needed = .true. ! Indicates that i/o will be needed for this segment
segment%field(m)%name = trim(fields(m))
- if (segment%field(m)%name == 'TEMP') &
+ if (segment%field(m)%name == 'TEMP') then
segment%temp_segment_data_exists=.true.
- if (segment%field(m)%name == 'SALT') &
+ segment%t_values_needed = .false.
+ endif
+ if (segment%field(m)%name == 'SALT') then
segment%salt_segment_data_exists=.true.
+ segment%s_values_needed = .false.
+ endif
filename = trim(inputdir)//trim(filename)
fieldname = trim(fieldname)//trim(suffix)
call field_size(filename,fieldname,siz,no_domain=.true.)
- if (siz(4) == 1) segment%values_needed = .false.
+! if (siz(4) == 1) segment%values_needed = .false.
if (segment%on_pe) then
if (OBC%brushcutter_mode .and. (modulo(siz(1),2) == 0 .or. modulo(siz(2),2) == 0)) then
call MOM_error(FATAL,'segment data are not on the supergrid')
@@ -664,16 +683,42 @@ subroutine initialize_segment_data(G, OBC, PF)
siz2(3)=siz(3)
if (segment%is_E_or_W) then
- if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then
+ if (segment%field(m)%name == 'V') then
+ allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3)))
+ segment%v_values_needed = .false.
+ else if (segment%field(m)%name == 'DVDX') then
allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3)))
+ segment%g_values_needed = .false.
else
allocate(segment%field(m)%buffer_src(IsdB:IedB,jsd:jed,siz2(3)))
+ if (segment%field(m)%name == 'U') then
+ segment%u_values_needed = .false.
+ else if (segment%field(m)%name == 'SSH') then
+ segment%z_values_needed = .false.
+ else if (segment%field(m)%name == 'TEMP') then
+ segment%t_values_needed = .false.
+ else if (segment%field(m)%name == 'SALT') then
+ segment%s_values_needed = .false.
+ endif
endif
else
- if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then
+ if (segment%field(m)%name == 'U') then
+ allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3)))
+ segment%u_values_needed = .false.
+ else if (segment%field(m)%name == 'DUDY') then
allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3)))
+ segment%g_values_needed = .false.
else
allocate(segment%field(m)%buffer_src(isd:ied,JsdB:JedB,siz2(3)))
+ if (segment%field(m)%name == 'V') then
+ segment%v_values_needed = .false.
+ else if (segment%field(m)%name == 'SSH') then
+ segment%z_values_needed = .false.
+ else if (segment%field(m)%name == 'TEMP') then
+ segment%t_values_needed = .false.
+ else if (segment%field(m)%name == 'SALT') then
+ segment%s_values_needed = .false.
+ endif
endif
endif
segment%field(m)%buffer_src(:,:,:)=0.0
@@ -706,8 +751,29 @@ subroutine initialize_segment_data(G, OBC, PF)
else
segment%field(m)%fid = -1
segment%field(m)%value = value
+ segment%field(m)%name = trim(fields(m))
+ if (segment%field(m)%name == 'U') then
+ segment%u_values_needed = .false.
+ elseif (segment%field(m)%name == 'V') then
+ segment%v_values_needed = .false.
+ elseif (segment%field(m)%name == 'SSH') then
+ segment%z_values_needed = .false.
+ elseif (segment%field(m)%name == 'TEMP') then
+ segment%t_values_needed = .false.
+ elseif (segment%field(m)%name == 'SALT') then
+ segment%s_values_needed = .false.
+ elseif (segment%field(m)%name == 'DVDX' .or. segment%field(m)%name == 'DUDY') then
+ segment%g_values_needed = .false.
+ endif
endif
enddo
+ if (segment%u_values_needed .or. segment%v_values_needed .or. &
+ segment%t_values_needed .or. segment%s_values_needed .or. &
+ segment%z_values_needed .or. segment%g_values_needed) then
+ write(mesg,'("Values needed for OBC segment ",I3)') n
+! call MOM_error(FATAL, mesg)
+ call MOM_error(WARNING, mesg)
+ endif
enddo
call mpp_set_current_pelist(saved_pelist)
@@ -814,6 +880,8 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y)
OBC%segment(l_seg)%open = .true.
OBC%Flather_u_BCs_exist_globally = .true.
OBC%open_u_BCs_exist_globally = .true.
+ OBC%segment%z_values_needed = .true.
+ OBC%segment%u_values_needed = .true.
elseif (trim(action_str(a_loop)) == 'ORLANSKI') then
OBC%segment(l_seg)%radiation = .true.
OBC%segment(l_seg)%open = .true.
@@ -841,11 +909,14 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y)
elseif (trim(action_str(a_loop)) == 'NUDGED') then
OBC%segment(l_seg)%nudged = .true.
OBC%nudged_u_BCs_exist_globally = .true.
+ OBC%segment%u_values_needed = .true.
elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then
OBC%segment(l_seg)%nudged_tan = .true.
OBC%nudged_u_BCs_exist_globally = .true.
+ OBC%segment%v_values_needed = .true.
elseif (trim(action_str(a_loop)) == 'NUDGED_GRAD') then
OBC%segment(l_seg)%nudged_grad = .true.
+ OBC%segment%g_values_needed = .true.
elseif (trim(action_str(a_loop)) == 'GRADIENT') then
OBC%segment(l_seg)%gradient = .true.
OBC%segment(l_seg)%open = .true.
@@ -853,6 +924,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y)
elseif (trim(action_str(a_loop)) == 'SIMPLE') then
OBC%segment(l_seg)%specified = .true.
OBC%specified_u_BCs_exist_globally = .true. ! This avoids deallocation
+ OBC%segment%u_values_needed = .true.
elseif (trim(action_str(a_loop)) == 'SIMPLE_TAN') then
OBC%segment(l_seg)%specified_tan = .true.
else
@@ -895,6 +967,10 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y)
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.")
+ if (OBC%segment(l_seg)%u_values_needed .or. OBC%segment(l_seg)%v_values_needed .or. &
+ OBC%segment(l_seg)%t_values_needed .or. OBC%segment(l_seg)%s_values_needed .or. &
+ OBC%segment(l_seg)%z_values_needed .or. OBC%segment(l_seg)%g_values_needed) &
+ OBC%segment(l_seg)%values_needed = .true.
end subroutine setup_u_point_obc
!> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly
@@ -938,6 +1014,8 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x)
OBC%segment(l_seg)%open = .true.
OBC%Flather_v_BCs_exist_globally = .true.
OBC%open_v_BCs_exist_globally = .true.
+ OBC%segment%z_values_needed = .true.
+ OBC%segment%v_values_needed = .true.
elseif (trim(action_str(a_loop)) == 'ORLANSKI') then
OBC%segment(l_seg)%radiation = .true.
OBC%segment(l_seg)%open = .true.
@@ -965,11 +1043,14 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x)
elseif (trim(action_str(a_loop)) == 'NUDGED') then
OBC%segment(l_seg)%nudged = .true.
OBC%nudged_v_BCs_exist_globally = .true.
+ OBC%segment%v_values_needed = .true.
elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then
OBC%segment(l_seg)%nudged_tan = .true.
OBC%nudged_v_BCs_exist_globally = .true.
+ OBC%segment%u_values_needed = .true.
elseif (trim(action_str(a_loop)) == 'NUDGED_GRAD') then
OBC%segment(l_seg)%nudged_grad = .true.
+ OBC%segment%g_values_needed = .true.
elseif (trim(action_str(a_loop)) == 'GRADIENT') then
OBC%segment(l_seg)%gradient = .true.
OBC%segment(l_seg)%open = .true.
@@ -977,6 +1058,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x)
elseif (trim(action_str(a_loop)) == 'SIMPLE') then
OBC%segment(l_seg)%specified = .true.
OBC%specified_v_BCs_exist_globally = .true. ! This avoids deallocation
+ OBC%segment%v_values_needed = .true.
elseif (trim(action_str(a_loop)) == 'SIMPLE_TAN') then
OBC%segment(l_seg)%specified_tan = .true.
else
@@ -1019,6 +1101,10 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x)
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.")
+ if (OBC%segment(l_seg)%u_values_needed .or. OBC%segment(l_seg)%v_values_needed .or. &
+ OBC%segment(l_seg)%t_values_needed .or. OBC%segment(l_seg)%s_values_needed .or. &
+ OBC%segment(l_seg)%z_values_needed .or. OBC%segment(l_seg)%g_values_needed) &
+ OBC%segment(l_seg)%values_needed = .true.
end subroutine setup_v_point_obc
!> Parse an OBC_SEGMENT_%%% string
@@ -1533,7 +1619,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
real, intent(in) :: dt !< Appropriate timestep
! Local variables
real :: dhdt, dhdx, dhdy, gamma_u, gamma_v, gamma_2
- real :: cff, Cx, Cy, tau
+ real :: 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
@@ -1632,7 +1718,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
if (dhdt*dhdx < 0.0) dhdt = 0.0
rx_new = dhdt*dhdx
cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
- ry_new = min(cff,max(dhdt*dhdy,-cff))
+ ry_new = min(cff_new,max(dhdt*dhdy,-cff_new))
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
@@ -1828,7 +1914,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
if (dhdt*dhdx < 0.0) dhdt = 0.0
rx_new = dhdt*dhdx
cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
- ry_new = min(cff,max(dhdt*dhdy,-cff))
+ ry_new = min(cff_new,max(dhdt*dhdy,-cff_new))
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
@@ -2014,7 +2100,6 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
elseif (segment%oblique) then
dhdt = v_old(i,J-1,k)-v_new(i,J-1,k) !old-new
dhdy = v_new(i,J-1,k)-v_new(i,J-2,k) !in new time backward sasha for J-1
- segment%ry_normal(i,J,k) = ry_avg
if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then
dhdx = segment%grad_normal(I-1,1,k)
elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then
@@ -2025,7 +2110,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
if (dhdt*dhdy < 0.0) dhdt = 0.0
ry_new = dhdt*dhdy
cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
- rx_new = min(cff,max(dhdt*dhdx,-cff))
+ rx_new = min(cff_new,max(dhdt*dhdx,-cff_new))
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
@@ -2221,7 +2306,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt)
if (dhdt*dhdy < 0.0) dhdt = 0.0
ry_new = dhdt*dhdy
cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
- rx_new = min(cff,max(dhdt*dhdx,-cff))
+ rx_new = min(cff_new,max(dhdt*dhdx,-cff_new))
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
@@ -2920,7 +3005,7 @@ end subroutine open_boundary_test_extern_h
subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
- type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
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 [m]
@@ -3252,6 +3337,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc+1:je_obc))
elseif (segment%field(m)%name == 'DVDX') then
allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke))
+ elseif (segment%field(m)%name == 'SSH') then
+ allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1))
else
allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke))
endif
@@ -3264,6 +3351,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
allocate(segment%field(m)%bt_vel(is_obc+1:ie_obc,js_obc:je_obc))
elseif (segment%field(m)%name == 'DUDY') then
allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke))
+ elseif (segment%field(m)%name == 'SSH') then
+ allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1))
else
allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke))
endif
@@ -3390,12 +3479,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc
segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k)
enddo ; enddo ; enddo
- if (.not. segment%tr_Reg%Tr(1)%is_initialized) then
+ if (.not. segment%tr_Reg%Tr(2)%is_initialized) then
!if the tracer reservoir has not yet been initialized, then set to external value.
do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc
segment%tr_Reg%Tr(2)%tres(i,j,k) = segment%tr_Reg%Tr(2)%t(i,j,k)
enddo ; enddo ; enddo
- segment%tr_Reg%Tr(1)%is_initialized=.true.
+ segment%tr_Reg%Tr(2)%is_initialized=.true.
endif
else
segment%tr_Reg%Tr(2)%OBC_inflow_conc = segment%field(m)%value
diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90
index 071d63246f..2dd459ba91 100644
--- a/src/core/MOM_variables.F90
+++ b/src/core/MOM_variables.F90
@@ -265,28 +265,28 @@ module MOM_variables
!! and how they will vary as the barotropic velocity is changed.
type, public :: BT_cont_type
real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport
- !! drawing from locations far to the east [H m ~> m2 or kg m-1].
+ !! drawing from locations far to the east [H L ~> m2 or kg m-1].
real, allocatable :: FA_u_E0(:,:) !< The effective open face area for zonal barotropic transport
- !! drawing from nearby to the east [H m ~> m2 or kg m-1].
+ !! drawing from nearby to the east [H L ~> m2 or kg m-1].
real, allocatable :: FA_u_W0(:,:) !< The effective open face area for zonal barotropic transport
- !! drawing from nearby to the west [H m ~> m2 or kg m-1].
+ !! drawing from nearby to the west [H L ~> m2 or kg m-1].
real, allocatable :: FA_u_WW(:,:) !< The effective open face area for zonal barotropic transport
- !! drawing from locations far to the west [H m ~> m2 or kg m-1].
- real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [m s-1], beyond which the marginal
+ !! drawing from locations far to the west [H L ~> m2 or kg m-1].
+ real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [L T-1 ~> 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 [m s-1], beyond which the marginal
+ real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [L T-1 ~> 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 [H m ~> m2 or kg m-1].
+ !! drawing from locations far to the north [H L ~> m2 or kg m-1].
real, allocatable :: FA_v_N0(:,:) !< The effective open face area for meridional barotropic transport
- !! drawing from nearby to the north [H m ~> m2 or kg m-1].
+ !! drawing from nearby to the north [H L ~> m2 or kg m-1].
real, allocatable :: FA_v_S0(:,:) !< The effective open face area for meridional barotropic transport
- !! drawing from nearby to the south [H m ~> m2 or kg m-1].
+ !! drawing from nearby to the south [H L ~> m2 or kg m-1].
real, allocatable :: FA_v_SS(:,:) !< The effective open face area for meridional barotropic transport
- !! drawing from locations far to the south [H m ~> m2 or kg m-1].
- real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [m s-1], beyond which the marginal
+ !! drawing from locations far to the south [H L ~> m2 or kg m-1].
+ real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [L T-1 ~> 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, [m s-1], beyond which the marginal
+ real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [L T-1 ~> 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 [H ~> m or kg m-2].
real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces [H ~> m or kg m-2].
diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90
index 60d8c4b0d0..bb89b8b41b 100644
--- a/src/initialization/MOM_state_initialization.F90
+++ b/src/initialization/MOM_state_initialization.F90
@@ -26,6 +26,7 @@ module MOM_state_initialization
use MOM_open_boundary, only : set_tracer_data
use MOM_open_boundary, only : open_boundary_test_extern_h
use MOM_open_boundary, only : fill_temp_salt_segments
+use MOM_open_boundary, only : update_OBC_segment_data
!use MOM_open_boundary, only : set_3D_OBC_data
use MOM_grid_initialize, only : initialize_masks, set_grid_metrics
use MOM_restart, only : restore_state, determine_is_new_run, MOM_restart_CS
@@ -557,6 +558,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, &
! This controls user code for setting open boundary data
if (associated(OBC)) then
+ ! Call this once to fill boundary arrays from fixed values
+ if (.not. OBC%needs_IO_for_data) &
+ call update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
+
call get_param(PF, mdl, "OBC_USER_CONFIG", config, &
"A string that sets how the user code is invoked to set open boundary data: \n"//&
" DOME - specified inflow on northern boundary\n"//&
diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90
index 54726fe9fb..620b53fbda 100644
--- a/src/parameterizations/lateral/MOM_MEKE.F90
+++ b/src/parameterizations/lateral/MOM_MEKE.F90
@@ -41,7 +41,6 @@ module MOM_MEKE
real :: MEKE_min_gamma!< Minimum value of gamma_b^2 allowed [nondim]
real :: MEKE_Ct !< Coefficient in the \f$\gamma_{bt}\f$ expression [nondim]
logical :: visc_drag !< If true use the vertvisc_type to calculate bottom drag.
- logical :: Jansen15_drag !< If true use the bottom drag formulation from Jansen et al. (2015)
logical :: MEKE_GEOMETRIC !< If true, uses the GM coefficient formulation from the GEOMETRIC
!! framework (Marshall et al., 2012)
logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather
@@ -319,37 +318,22 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
if (use_drag_rate) then
! Calculate a viscous drag rate (includes BBL contributions from mean flow and eddies)
!$OMP do
- if (CS%Jansen15_drag) then
- do j=js,je ; do i=is,ie
- drag_rate(i,j) = (cdrag2/MAX(1.0,G%bathyT(i,j))) * sqrt(CS%MEKE_Uscale**2 + drag_rate_visc(i,j)**2 + &
- 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) * 2.0 * bottomFac2(i,j)*MEKE%MEKE(i,j)
- enddo ; enddo
- else
- do j=js,je ; do i=is,ie
- drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 &
- + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) )
- enddo ; enddo
- endif
+ do j=js,je ; do i=is,ie
+ drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 &
+ + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) )
+ enddo ; enddo
endif
! First stage of Strang splitting
!$OMP do
- if (CS%Jansen15_drag) then
- do j=js,je ; do i=is,ie
- ldamping = CS%MEKE_damping + drag_rate(i,j)
- MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j),sdt_damp*drag_rate(i,j))
- MEKE_decay(i,j) = ldamping*G%mask2dT(i,j)
- enddo ; enddo
- else
- do j=js,je ; do i=is,ie
- ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j)
- if (MEKE%MEKE(i,j)<0.) ldamping = 0.
- ! notice that the above line ensures a damping only if MEKE is positive,
- ! while leaving MEKE unchanged if it is negative
- MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping)
- MEKE_decay(i,j) = ldamping*G%mask2dT(i,j)
- enddo ; enddo
- endif
+ do j=js,je ; do i=is,ie
+ ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j)
+ if (MEKE%MEKE(i,j)<0.) ldamping = 0.
+ ! notice that the above line ensures a damping only if MEKE is positive,
+ ! while leaving MEKE unchanged if it is negative
+ MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping)
+ MEKE_decay(i,j) = ldamping*G%mask2dT(i,j)
+ enddo ; enddo
!$OMP end parallel
if (CS%kh_flux_enabled .or. CS%MEKE_K4 >= 0.0) then
@@ -495,26 +479,18 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
! Recalculate the drag rate, since MEKE has changed.
if (use_drag_rate) then
!$OMP do
- if (CS%Jansen15_drag) then
- do j=js,je ; do i=is,ie
- ldamping = CS%MEKE_damping + drag_rate(i,j)
- MEKE%MEKE(i,j) = MEKE%MEKE(i,j) -sdt_damp*drag_rate(i,j)
- MEKE_decay(i,j) = ldamping*G%mask2dT(i,j)
- enddo ; enddo
- else
- do j=js,je ; do i=is,ie
- drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 &
- + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) )
- enddo ; enddo
- do j=js,je ; do i=is,ie
- ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j)
- if (MEKE%MEKE(i,j)<0.) ldamping = 0.
- ! notice that the above line ensures a damping only if MEKE is positive,
- ! while leaving MEKE unchanged if it is negative
- MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping)
- MEKE_decay(i,j) = ldamping*G%mask2dT(i,j)
- enddo ; enddo
- endif
+ do j=js,je ; do i=is,ie
+ drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 &
+ + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) )
+ enddo ; enddo
+ do j=js,je ; do i=is,ie
+ ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j)
+ if (MEKE%MEKE(i,j)<0.) ldamping = 0.
+ ! notice that the above line ensures a damping only if MEKE is positive,
+ ! while leaving MEKE unchanged if it is negative
+ MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping)
+ MEKE_decay(i,j) = ldamping*G%mask2dT(i,j)
+ enddo ; enddo
endif
!$OMP do
endif
@@ -1008,9 +984,6 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS)
call get_param(param_file, mdl, "MEKE_USCALE", CS%MEKE_Uscale, &
"The background velocity that is combined with MEKE to "//&
"calculate the bottom drag.", units="m s-1", default=0.0)
- call get_param(param_file, mdl, "MEKE_JANSEN15_DRAG", CS%Jansen15_drag, &
- "If true, use the bottom drag formulation from Jansen et al. (2015) "//&
- "to calculate the drag acting on MEKE.", default=.false.)
call get_param(param_file, mdl, "MEKE_GM_SRC_ALT", CS%GM_src_alt, &
"If true, use the GM energy conversion form S^2*N^2*kappa rather "//&
"than the streamfunction for the MEKE GM source term.", default=.false.)
diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90
index 607bac9f00..7450382553 100644
--- a/src/parameterizations/lateral/MOM_hor_visc.F90
+++ b/src/parameterizations/lateral/MOM_hor_visc.F90
@@ -418,7 +418,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! call pass_var(boundary_mask, G%Domain, complete=.true.)
! Get barotropic velocities and their gradients
- call barotropic_get_tav(BT, ubtav, vbtav, G)
+ call barotropic_get_tav(BT, ubtav, vbtav, G, US)
call pass_vector(ubtav, vbtav, G%Domain)
!#GME# The following loop range should be: do j=js-1,je+1 ; do i=is-1,ie+1
@@ -1330,8 +1330,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if (k==1) then
do j=js,je ; do i=is,ie
MEKE%mom_src(i,j) = 0.
- MEKE%GME_snk(i,j) = 0.
enddo ; enddo
+ if (associated(MEKE%GME_snk)) then
+ do j=js,je ; do i=is,ie
+ MEKE%GME_snk(i,j) = 0.
+ enddo ; enddo
+ endif
endif
if (MEKE%backscatter_Ro_c /= 0.) then
do j=js,je ; do i=is,ie
@@ -1373,12 +1377,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
(u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) &
+(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) )
enddo ; enddo
- else
+ endif ! MEKE%backscatter
+
+ if (CS%use_GME) then
do j=js,je ; do i=is,ie
! MEKE%mom_src now is sign definite because it only uses the dissipation
MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(FrictWork_diss(i,j,k), FrictWorkMax(i,j,k))
enddo ; enddo
- endif ! MEKE%backscatter
+ else
+ do j=js,je ; do i=is,ie
+ MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork(i,j,k)
+ enddo ; enddo
+ endif ! CS%use_GME
if (CS%use_GME .and. associated(MEKE)) then
if (associated(MEKE%GME_snk)) then
diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90
index e0df2f3c3f..989bb19ed2 100644
--- a/src/parameterizations/vertical/MOM_diabatic_driver.F90
+++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90
@@ -2928,6 +2928,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV,
real :: Idt ! The inverse of the timestep [s-1]
real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg.
integer :: i, j, k, is, ie, js, je, nz
+ logical :: do_saln_tend ! Calculate salinity-based tendency diagnosics
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
Idt = 0.0 ; if (dt > 0.0) Idt = 1. / dt
@@ -2963,29 +2964,35 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV,
endif
! salinity tendency
- if (CS%id_diabatic_diff_saln_tend > 0) then
- do k=1,nz ; do j=js,je ; do i=is,ie
- work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt
- enddo ; enddo ; enddo
- call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag, alt_h = h)
- endif
+ do_saln_tend = CS%id_diabatic_diff_saln_tend > 0 &
+ .or. CS%id_diabatic_diff_salt_tend > 0 &
+ .or. CS%id_diabatic_diff_salt_tend_2d > 0
- ! salt tendency
- if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then
+ if (do_saln_tend) 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 * ppt2mks * work_3d(i,j,k)
+ work_3d(i,j,k) = (tv%S(i,j,k) - saln_old(i,j,k)) * Idt
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)
- endif
- if (CS%id_diabatic_diff_salt_tend_2d > 0) then
- do j=js,je ; do i=is,ie
- work_2d(i,j) = 0.0
- do k=1,nz
- work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k)
- enddo
- enddo ; enddo
- call post_data(CS%id_diabatic_diff_salt_tend_2d, work_2d, CS%diag)
+
+ if (CS%id_diabatic_diff_saln_tend > 0) &
+ call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag, alt_h=h)
+
+ ! 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 * 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)
+ endif
+ if (CS%id_diabatic_diff_salt_tend_2d > 0) then
+ do j=js,je ; do i=is,ie
+ work_2d(i,j) = 0.0
+ do k=1,nz
+ work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k)
+ enddo
+ enddo ; enddo
+ call post_data(CS%id_diabatic_diff_salt_tend_2d, work_2d, CS%diag)
+ endif
endif
endif
diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90
index 82456b0e58..2c01823302 100644
--- a/src/parameterizations/vertical/MOM_vert_friction.F90
+++ b/src/parameterizations/vertical/MOM_vert_friction.F90
@@ -1190,51 +1190,6 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
endif
endif
- ! add "slow" varying vertical viscosity (e.g., from background, tidal etc)
- if (associated(visc%Kv_slow) .and. (visc%add_Kv_slow)) then
- ! GMM/ A factor of 2 is also needed here, see comment above from BGR.
- if (work_on_u) then
- !### Incrementing Kv_add here will cause visc%Kv_shear to be double counted. - RWH
- do K=2,nz ; do i=is,ie ; if (do_i(i)) then
- Kv_add(I,K) = Kv_add(I,K) + 0.5 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k))
- ! Should be : Kv_add(I,K) = 0.5 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k))
- endif ; enddo ; enddo
- !### I am pretty sure that this code is double counting viscosity at OBC points! - RWH
- if (do_OBCs) 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) then
- do K=2,nz ; Kv_add(I,K) = Kv_add(I,K) + visc%Kv_slow(i,j,k) ; enddo
- ! Should be : do K=2,nz ; Kv_add(I,K) = visc%Kv_slow(i,j,k) ; enddo
- elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then
- do K=2,nz ; Kv_add(I,K) = Kv_add(I,K) + visc%Kv_slow(i+1,j,k) ; enddo
- ! Should be : do K=2,nz ; Kv_add(I,K) = visc%Kv_slow(i+1,j,k) ; enddo
- endif
- endif ; enddo
- endif
- do K=2,nz ; do i=is,ie ; if (do_i(i)) then
- Kv_tot(I,K) = Kv_tot(I,K) + Kv_add(I,K)
- endif ; enddo ; enddo
- else
- !### Incrementing Kv_add here will cause visc%Kv_shear to be double counted. - RWH
- do K=2,nz ; do i=is,ie ; if (do_i(i)) then
- Kv_add(i,K) = Kv_add(i,K) + 0.5*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k))
- endif ; enddo ; enddo
- !### I am pretty sure that this code is double counting viscosity at OBC points! - 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
- do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j,k) ; enddo
- elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then
- do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j+1,k) ; enddo
- endif
- endif ; enddo
- endif
- do K=2,nz ; do i=is,ie ; if (do_i(i)) then
- Kv_tot(i,K) = Kv_tot(i,K) + Kv_add(i,K)
- endif ; enddo ; enddo
- endif
- endif
-
do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then
! botfn determines when a point is within the influence of the bottom
! boundary layer, going from 1 at the bottom to 0 in the interior.
diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90
index 201f8aeb6f..906c6d8be2 100644
--- a/src/tracer/MOM_tracer_advect.F90
+++ b/src/tracer/MOM_tracer_advect.F90
@@ -353,6 +353,8 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
slope_x ! The concentration slope per grid point [conc].
real, dimension(SZIB_(G),ntr) :: &
flux_x ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc].
+ real, dimension(SZI_(G),ntr) :: &
+ T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc].
real :: maxslope ! The maximum concentration slope per grid point
! consistent with monotonicity [conc].
real :: hup, hlos ! hup is the upwind volume, hlos is the
@@ -420,6 +422,72 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
enddo ; enddo
endif ! usePLMslope
+ ! make a copy of the tracers in case values need to be overridden for OBCs
+ do m = 1,ntr
+ do i=is-stencil,ie+stencil
+ T_tmp(i,m) = Tr(m)%t(i,j,k)
+ enddo
+ enddo
+ ! loop through open boundaries and recalculate flux terms
+ if (associated(OBC)) then ; if (OBC%OBC_pe) then
+ do n=1,OBC%number_of_segments
+ segment=>OBC%segment(n)
+ if (.not. associated(segment%tr_Reg)) cycle
+ if (segment%is_E_or_W) then
+ if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then
+ I = segment%HI%IsdB
+
+ 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
+ endif
+ ! update the reservoir tracer concentration implicitly
+ ! using Backward-Euler timestep
+ do m=1,ntr
+ 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.)
+ fac1=1.0+dt*(u_L_in-u_L_out)
+ 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)))
+ endif
+ enddo
+
+ do m = 1,ntr ! replace tracers with OBC values
+ if (associated(segment%tr_Reg%Tr(m)%tres)) then
+ if (segment%direction == OBC_DIRECTION_W) then
+ T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k)
+ else
+ T_tmp(I+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k)
+ endif
+ else
+ if (segment%direction == OBC_DIRECTION_W) then
+ T_tmp(i,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
+ else
+ T_tmp(I+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
+ endif
+ endif
+ enddo
+ do m = 1,ntr ! Apply update tracer values for slope calculation
+ do i=segment%HI%IsdB-1,segment%HI%IsdB+1
+ Tp = T_tmp(i+1,m) ; Tc = T_tmp(i,m) ; Tm = T_tmp(i-1,m)
+ dMx = max( Tp, Tc, Tm ) - Tc
+ dMn= Tc - min( Tp, Tc, Tm )
+ slope_x(i,m) = G%mask2dCu(I,j)*G%mask2dCu(I-1,j) * &
+ sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm )
+ enddo
+ enddo
+
+ endif
+ endif
+ enddo
+ endif; endif
+
+
! Calculate the i-direction fluxes of each tracer, using as much
! the minimum of the remaining mass flux (uhr) and the half the mass
! in the cell plus whatever part of its half of the mass flux that
@@ -466,7 +534,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
endif
! Implementation of PPM-H3
- Tp = Tr(m)%t(i_up+1,j,k) ; Tc = Tr(m)%t(i_up,j,k) ; Tm = Tr(m)%t(i_up-1,j,k)
+ Tp = T_tmp(i_up+1,m) ; Tc = T_tmp(i_up,m) ; Tm = T_tmp(i_up-1,m)
if (useHuynh) then
aL = ( 5.*Tc + ( 2.*Tm - Tp ) )/6. ! H3 estimate
@@ -508,7 +576,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
!aR = Tr(m)%t(i,j,k) + 0.5 * slope_x(i,m)
!flux_x(I,m) = uhh(I)*( aR - 0.5 * slope_x(i,m) * CFL(I) )
! Alternative implementation of PLM
- Tc = Tr(m)%t(i,j,k)
+ Tc = T_tmp(i,m)
flux_x(I,m) = uhh(I)*( Tc + 0.5 * slope_x(i,m) * ( 1. - CFL(I) ) )
! Original implementation of PLM
!flux_x(I,m) = uhh(I)*(Tr(m)%t(i,j,k) + slope_x(i,m)*ts2(I))
@@ -521,7 +589,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
!aL = Tr(m)%t(i+1,j,k) - 0.5 * slope_x(i+1,m)
!flux_x(I,m) = uhh(I)*( aL + 0.5 * slope_x(i+1,m) * CFL(I) )
! Alternative implementation of PLM
- Tc = Tr(m)%t(i+1,j,k)
+ Tc = T_tmp(i+1,m)
flux_x(I,m) = uhh(I)*( Tc - 0.5 * slope_x(i+1,m) * ( 1. - CFL(I) ) )
! Original implementation of PLM
!flux_x(I,m) = uhh(I)*(Tr(m)%t(i+1,j,k) - slope_x(i+1,m)*ts2(I))
@@ -531,10 +599,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
endif ! usePPM
if (associated(OBC)) then ; if (OBC%OBC_pe) then
- if (OBC%specified_u_BCs_exist_globally) then
+ if (OBC%specified_u_BCs_exist_globally .or. OBC%open_u_BCs_exist_globally) then
do n=1,OBC%number_of_segments
segment=>OBC%segment(n)
- if (.not. segment%specified) cycle
if (.not. associated(segment%tr_Reg)) cycle
if (segment%is_E_or_W) then
if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then
@@ -554,48 +621,8 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
endif
endif
enddo
- endif
+ endif
- if (OBC%open_u_BCs_exist_globally) then
- do n=1,OBC%number_of_segments
- segment=>OBC%segment(n)
- I = segment%HI%IsdB
- if (segment%is_E_or_W .and. (j >= segment%HI%jsd .and. j<= segment%HI%jed)) then
- if (segment%specified) cycle
- if (.not. associated(segment%tr_Reg)) cycle
- 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
- endif
- ! update the reservoir tracer concentration implicitly
- ! using Backward-Euler timestep
- do m=1,ntr
- 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.)
- fac1=1.0+dt*(u_L_in-u_L_out)
- 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)))
- 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
- endif
- endif
- enddo
- endif
endif ; endif
! Calculate new tracer concentration in each cell after accounting
@@ -680,7 +707,10 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
real, dimension(SZI_(G),ntr,SZJ_(G)) :: &
slope_y ! The concentration slope per grid point [conc].
real, dimension(SZI_(G),ntr,SZJB_(G)) :: &
- flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc].
+ flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc].
+ real, dimension(SZI_(G),ntr,SZJB_(G)) :: &
+ T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc].
+
real :: maxslope ! The maximum concentration slope per grid point
! consistent with monotonicity [conc].
real :: vhh(SZI_(G),SZJB_(G)) ! The meridional flux that occurs during the
@@ -757,6 +787,72 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
enddo ; enddo ; endif ; enddo ! End of i-, m-, & j- loops.
endif ! usePLMslope
+
+ ! make a copy of the tracers in case values need to be overridden for OBCs
+
+ do j=js-stencil,je+stencil ; if (do_j_tr(j)) then ; do m=1,ntr ; do i=is,ie
+ T_tmp(i,m,j) = Tr(m)%t(i,j,k)
+ enddo ; enddo ; endif ; enddo
+
+ ! loop through open boundaries and recalculate flux terms
+ if (associated(OBC)) then ; if (OBC%OBC_pe) then
+ do n=1,OBC%number_of_segments
+ segment=>OBC%segment(n)
+ if (.not. associated(segment%tr_Reg)) cycle
+ do i=is,ie
+ if (segment%is_N_or_S) then
+ if (i>=segment%HI%isd .and. i<=segment%HI%ied) then
+ J = segment%HI%JsdB
+ jshift=0 ! jshift+J corresponds to the nearest interior tracer cell index
+ jdir=1 ! jdir switches the sign of the flow so that positive is into the reservoir
+ if (segment%direction == OBC_DIRECTION_S) then
+ jshift=1
+ jdir=-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
+ vhh(i,J)=vhr(i,J,k)
+ v_L_in=max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.)
+ v_L_out=min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.)
+ fac1=1.0+dt*(v_L_in-v_L_out)
+ segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + &
+ dt*(v_L_in*Tr(m)%t(i,J+jshift,k) - &
+ v_L_out*segment%tr_Reg%Tr(m)%t(i,J,k)))
+ endif
+ enddo
+
+ do m = 1,ntr ! replace tracers with OBC values
+ if (associated(segment%tr_Reg%Tr(m)%tres)) then
+ if (segment%direction == OBC_DIRECTION_S) then
+ T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k)
+ else
+ T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%tres(i,j,k)
+ endif
+ else
+ if (segment%direction == OBC_DIRECTION_S) then
+ T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
+ else
+ T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
+ endif
+ endif
+ enddo
+ do m = 1,ntr ! Apply update tracer values for slope calculation
+ do j=segment%HI%JsdB-1,segment%HI%JsdB+1
+ Tp = T_tmp(i,m,j+1) ; Tc = T_tmp(i,m,j) ; Tm = T_tmp(i,m,j-1)
+ dMx = max( Tp, Tc, Tm ) - Tc
+ dMn= Tc - min( Tp, Tc, Tm )
+ slope_y(i,m,j) = G%mask2dCv(i,J)*G%mask2dCv(i,J-1) * &
+ sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm )
+ enddo
+ enddo
+ endif
+ endif ! is_N_S
+ enddo ! i-loop
+ enddo ! segment loop
+ endif; endif
+
! Calculate the j-direction fluxes of each tracer, using as much
! the minimum of the remaining mass flux (vhr) and the half the mass
! in the cell plus whatever part of its half of the mass flux that
@@ -869,7 +965,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
endif ! usePPM
if (associated(OBC)) then ; if (OBC%OBC_pe) then
- if (OBC%specified_v_BCs_exist_globally) then
+ if (OBC%specified_v_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) then
do n=1,OBC%number_of_segments
segment=>OBC%segment(n)
if (.not. segment%specified) cycle
@@ -893,49 +989,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
endif
enddo
endif
-
-
- if (OBC%open_v_BCs_exist_globally) then
- do n=1,OBC%number_of_segments
- segment=>OBC%segment(n)
- if (segment%specified) cycle
- if (.not. associated(segment%tr_Reg)) cycle
- if (segment%is_N_or_S .and. &
- (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then
- jshift=0
- jdir=1
- if (segment%direction == OBC_DIRECTION_S) then
- jshift=1
- jdir=-1
- endif
- do i=segment%HI%isd,segment%HI%ied
- ! update the reservoir tracer concentration implicitly
- ! using Backward-Euler timestep
- do m=1,ntr
- if (associated(segment%tr_Reg%Tr(m)%tres)) then
- vhh(i,J)=vhr(i,J,k)
- v_L_in=max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.)
- v_L_out=min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.)
- fac1=1.0+dt*(v_L_in-v_L_out)
- segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + &
- dt*v_L_in*Tr(m)%t(i,j+jshift,k) - &
- dt*v_L_out*segment%tr_Reg%Tr(m)%t(i,j,k))
- endif
- enddo
- ! Tracer fluxes are set to prescribed values only for inflows from masked areas.
- if ((vhr(i,J,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. &
- (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then
- vhh(i,J) = vhr(i,J,k)
- do m=1,ntr
- if (associated(segment%tr_Reg%Tr(m)%t)) then
- flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k)
- else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif
- enddo
- endif
- enddo
- endif
- enddo
- endif
endif; endif
else ! not domore_v.