MOM6
pseudo_salt_tracer.F90
Go to the documentation of this file.
1 !> A tracer package that mimics salinity
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
6 use mom_debugging, only : hchksum
7 use mom_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
9 use mom_error_handler, only : mom_error, fatal, warning
11 use mom_forcing_type, only : forcing
12 use mom_grid, only : ocean_grid_type
13 use mom_hor_index, only : hor_index_type
14 use mom_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc
18 use mom_time_manager, only : time_type
23 use mom_variables, only : surface
26 
27 use coupler_types_mod, only : coupler_type_set_data, ind_csurf
29 
30 implicit none ; private
31 
32 #include <MOM_memory.h>
33 
37 
38 !> The control structure for the pseudo-salt tracer
39 type, public :: pseudo_salt_tracer_cs ; private
40  type(time_type), pointer :: time => null() !< A pointer to the ocean model's clock.
41  type(tracer_registry_type), pointer :: tr_reg => null() !< A pointer to the MOM tracer registry
42  real, pointer :: ps(:,:,:) => null() !< The array of pseudo-salt tracer used in this
43  !! subroutine [ppt}
44  real, pointer :: diff(:,:,:) => null() !< The difference between the pseudo-salt
45  !! tracer and the real salt [ppt].
46  logical :: pseudo_salt_may_reinit = .true. !< Hard coding since this should not matter
47 
48  integer :: id_psd = -1 !< A diagnostic ID
49 
50  type(diag_ctrl), pointer :: diag => null() !< A structure that is used to
51  !! regulate the timing of diagnostic output.
52  type(mom_restart_cs), pointer :: restart_csp => null() !< A pointer to the restart control structure
53 
54  type(vardesc) :: tr_desc !< A description and metadata for the pseudo-salt tracer
55 end type pseudo_salt_tracer_cs
56 
57 contains
58 
59 !> Register the pseudo-salt tracer with MOM6
60 function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
61  type(hor_index_type), intent(in) :: hi !< A horizontal index type structure
62  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
63  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
64  type(pseudo_salt_tracer_cs), pointer :: cs !< The control structure returned by a previous
65  !! call to register_pseudo_salt_tracer.
66  type(tracer_registry_type), pointer :: tr_reg !< A pointer that is set to point to the control
67  !! structure for the tracer advection and
68  !! diffusion module
69  type(mom_restart_cs), pointer :: restart_cs !< A pointer to the restart control structure
70 ! This subroutine is used to register tracer fields and subroutines
71 ! to be used with MOM.
72 
73  ! Local variables
74  character(len=40) :: mdl = "pseudo_salt_tracer" ! This module's name.
75  character(len=200) :: inputdir ! The directory where the input files are.
76  character(len=48) :: var_name ! The variable's name.
77  character(len=3) :: name_tag ! String for creating identifying pseudo_salt
78 ! This include declares and sets the variable "version".
79 #include "version_variable.h"
80  real, pointer :: tr_ptr(:,:,:) => null()
82  integer :: isd, ied, jsd, jed, nz, i, j
83  isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
84 
85  if (associated(cs)) then
86  call mom_error(warning, "register_pseudo_salt_tracer called with an "// &
87  "associated control structure.")
88  return
89  endif
90  allocate(cs)
91 
92  ! Read all relevant parameters and write them to the model log.
93  call log_version(param_file, mdl, version, "")
94 
95  allocate(cs%ps(isd:ied,jsd:jed,nz)) ; cs%ps(:,:,:) = 0.0
96  allocate(cs%diff(isd:ied,jsd:jed,nz)) ; cs%diff(:,:,:) = 0.0
97 
98  cs%tr_desc = var_desc(trim("pseudo_salt"), "psu", &
99  "Pseudo salt passive tracer", caller=mdl)
100 
101  tr_ptr => cs%ps(:,:,:)
102  call query_vardesc(cs%tr_desc, name=var_name, caller="register_pseudo_salt_tracer")
103  ! Register the tracer for horizontal advection, diffusion, and restarts.
104  call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, name="pseudo_salt", &
105  longname="Pseudo salt passive tracer", units="psu", &
106  registry_diags=.true., restart_cs=restart_cs, &
107  mandatory=.not.cs%pseudo_salt_may_reinit)
108 
109  cs%tr_Reg => tr_reg
110  cs%restart_CSp => restart_cs
112 
113 end function register_pseudo_salt_tracer
114 
115 !> Initialize the pseudo-salt tracer
116 subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, &
117  sponge_CSp, tv)
118  logical, intent(in) :: restart !< .true. if the fields have already
119  !! been read from a restart file.
120  type(time_type), target, intent(in) :: day !< Time of the start of the run.
121  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
122  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
123  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
124  intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
125  type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate
126  !! diagnostic output.
127  type(ocean_obc_type), pointer :: obc !< This open boundary condition type specifies
128  !! whether, where, and what open boundary
129  !! conditions are used.
130  type(pseudo_salt_tracer_cs), pointer :: cs !< The control structure returned by a previous
131  !! call to register_pseudo_salt_tracer.
132  type(sponge_cs), pointer :: sponge_csp !< Pointer to the control structure for the sponges.
133  type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
134 ! This subroutine initializes the tracer fields in CS%ps(:,:,:).
135 
136  ! Local variables
137  character(len=16) :: name ! A variable's name in a NetCDF file.
138  character(len=72) :: longname ! The long name of that variable.
139  character(len=48) :: units ! The dimensions of the variable.
140  character(len=48) :: flux_units ! The units for age tracer fluxes, either
141  ! years m3 s-1 or years kg s-1.
142  logical :: ok
143  integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
144  integer :: isdb, iedb, jsdb, jedb
145 
146  if (.not.associated(cs)) return
147  if (.not.associated(cs%diff)) return
148 
149  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
150  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
151  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
152 
153  cs%Time => day
154  cs%diag => diag
155  name = "pseudo_salt"
156 
157  call query_vardesc(cs%tr_desc, name=name, caller="initialize_pseudo_salt_tracer")
158  if ((.not.restart) .or. (.not.query_initialized(cs%ps, name, cs%restart_CSp))) then
159  do k=1,nz ; do j=jsd,jed ; do i=isd,ied
160  cs%ps(i,j,k) = tv%S(i,j,k)
161  enddo ; enddo ; enddo
162  endif
163 
164  if (associated(obc)) then
165  ! Steal from updated DOME in the fullness of time.
166  endif
167 
168  cs%id_psd = register_diag_field("ocean_model", "pseudo_salt_diff", cs%diag%axesTL, &
169  day, "Difference between pseudo salt passive tracer and salt tracer", "psu")
170 
171 end subroutine initialize_pseudo_salt_tracer
172 
173 !> Apply sources, sinks and diapycnal diffusion to the tracers in this package.
174 subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, debug, &
175  evap_CFL_limit, minimum_forcing_depth)
176  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
177  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
178  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
179  intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2].
180  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
181  intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2].
182  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
183  intent(in) :: ea !< an array to which the amount of fluid entrained
184  !! from the layer above during this call will be
185  !! added [H ~> m or kg m-2].
186  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
187  intent(in) :: eb !< an array to which the amount of fluid entrained
188  !! from the layer below during this call will be
189  !! added [H ~> m or kg m-2].
190  type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic
191  !! and tracer forcing fields. Unused fields have NULL ptrs.
192  real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]
193  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
194  type(pseudo_salt_tracer_cs), pointer :: cs !< The control structure returned by a previous
195  !! call to register_pseudo_salt_tracer.
196  type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
197  logical, intent(in) :: debug !< If true calculate checksums
198  real, optional, intent(in) :: evap_cfl_limit !< Limit on the fraction of the water that can
199  !! be fluxed out of the top layer in a timestep [nondim]
200  real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which
201  !! fluxes can be applied [H ~> m or kg m-2]
202 
203 ! This subroutine applies diapycnal diffusion and any other column
204 ! tracer physics or chemistry to the tracers from this file.
205 
206 ! The arguments to this subroutine are redundant in that
207 ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1)
208 
209  ! Local variables
210  real :: year, h_total, scale, htot, ih_limit
211  integer :: secs, days
212  integer :: i, j, k, is, ie, js, je, nz, k_max
213  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
214 
215  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
216 
217  if (.not.associated(cs)) return
218  if (.not.associated(cs%diff)) return
219 
220  if (debug) then
221  call hchksum(tv%S,"salt pre pseudo-salt vertdiff", g%HI)
222  call hchksum(cs%ps,"pseudo_salt pre pseudo-salt vertdiff", g%HI)
223  endif
224 
225  ! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode
226  if (present(evap_cfl_limit) .and. present(minimum_forcing_depth)) then
227  do k=1,nz ; do j=js,je ; do i=is,ie
228  h_work(i,j,k) = h_old(i,j,k)
229  enddo ; enddo ; enddo
230  call applytracerboundaryfluxesinout(g, gv, cs%ps, dt, fluxes, h_work, &
231  evap_cfl_limit, minimum_forcing_depth, out_flux_optional=fluxes%netSalt)
232  call tracer_vertdiff(h_work, ea, eb, dt, cs%ps, g, gv)
233  else
234  call tracer_vertdiff(h_old, ea, eb, dt, cs%ps, g, gv)
235  endif
236 
237  do k=1,nz ; do j=js,je ; do i=is,ie
238  cs%diff(i,j,k) = cs%ps(i,j,k)-tv%S(i,j,k)
239  enddo ; enddo ; enddo
240 
241  if (debug) then
242  call hchksum(tv%S,"salt post pseudo-salt vertdiff", g%HI)
243  call hchksum(cs%ps,"pseudo_salt post pseudo-salt vertdiff", g%HI)
244  endif
245 
246  if (cs%id_psd>0) call post_data(cs%id_psd, cs%diff, cs%diag)
247 
249 
250 
251 !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has
252 !! calculated. If the stock_index is present, only the stock corresponding to that coded index is returned.
253 function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index)
254  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
255  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
256  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
257  real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each
258  !! tracer, in kg times concentration units [kg conc].
259  type(pseudo_salt_tracer_cs), pointer :: cs !< The control structure returned by a previous
260  !! call to register_pseudo_salt_tracer.
261  character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated.
262  character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated.
263  integer, optional, intent(in) :: stock_index !< The coded index of a specific stock
264  !! being sought.
265  integer :: pseudo_salt_stock !< Return value: the number of
266  !! stocks calculated here.
267 
268 ! This function calculates the mass-weighted integral of all tracer stocks,
269 ! returning the number of stocks it has calculated. If the stock_index
270 ! is present, only the stock corresponding to that coded index is returned.
271 
272  integer :: i, j, k, is, ie, js, je, nz
273  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
274 
276  if (.not.associated(cs)) return
277  if (.not.associated(cs%diff)) return
278 
279  if (present(stock_index)) then ; if (stock_index > 0) then
280  ! Check whether this stock is available from this routine.
281 
282  ! No stocks from this routine are being checked yet. Return 0.
283  return
284  endif ; endif
285 
286  call query_vardesc(cs%tr_desc, name=names(1), units=units(1), caller="pseudo_salt_stock")
287  units(1) = trim(units(1))//" kg"
288  stocks(1) = 0.0
289  do k=1,nz ; do j=js,je ; do i=is,ie
290  stocks(1) = stocks(1) + cs%diff(i,j,k) * &
291  (g%mask2dT(i,j) * g%US%L_to_m**2*g%areaT(i,j) * h(i,j,k))
292  enddo ; enddo ; enddo
293  stocks(1) = gv%H_to_kg_m2 * stocks(1)
294 
296 
297 end function pseudo_salt_stock
298 
299 !> This subroutine extracts the surface fields from this tracer package that
300 !! are to be shared with the atmosphere in coupled configurations.
301 !! This particular tracer package does not report anything back to the coupler.
302 subroutine pseudo_salt_tracer_surface_state(state, h, G, CS)
303  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
304  type(surface), intent(inout) :: state !< A structure containing fields that
305  !! describe the surface state of the ocean.
306  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
307  intent(in) :: h !< Layer thickness [H ~> m or kg m-2].
308  type(pseudo_salt_tracer_cs), pointer :: cs !< The control structure returned by a previous
309  !! call to register_pseudo_salt_tracer.
310 
311  ! This particular tracer package does not report anything back to the coupler.
312  ! The code that is here is just a rough guide for packages that would.
313 
314  integer :: m, is, ie, js, je, isd, ied, jsd, jed
315  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
316  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
317 
318  if (.not.associated(cs)) return
319 
320  ! By design, this tracer package does not return any surface states.
321 
323 
324 !> Deallocate memory associated with this tracer package
325 subroutine pseudo_salt_tracer_end(CS)
326  type(pseudo_salt_tracer_cs), pointer :: cs !< The control structure returned by a previous
327  !! call to register_pseudo_salt_tracer.
328  integer :: m
329 
330  if (associated(cs)) then
331  if (associated(cs%ps)) deallocate(cs%ps)
332  if (associated(cs%diff)) deallocate(cs%diff)
333  deallocate(cs)
334  endif
335 end subroutine pseudo_salt_tracer_end
336 
337 !> \namespace pseudo_salt_tracer
338 !!
339 !! By Andrew Shao, 2016
340 !!
341 !! This file contains the routines necessary to model a passive
342 !! tracer that uses the same boundary fluxes as salinity. At the
343 !! beginning of the run, salt is set to the same as tv%S. Any
344 !! deviations between this salt-like tracer and tv%S signifies a
345 !! difference between how active and passive tracers are treated.
346 
347 end module pseudo_salt_tracer
mom_time_manager
Wraps the FMS time manager functions.
Definition: MOM_time_manager.F90:2
mom_tracer_registry::register_tracer
subroutine, public register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, units, cmor_name, cmor_units, cmor_longname, tr_desc, OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, df_x, df_y, ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, flux_nameroot, flux_longname, flux_units, flux_scale, convergence_units, convergence_scale, cmor_tendprefix, diag_form, restart_CS, mandatory)
This subroutine registers a tracer to be advected and laterally diffused.
Definition: MOM_tracer_registry.F90:158
mom_variables::surface
Pointers to various fields which may be used describe the surface state of MOM, and which will be ret...
Definition: MOM_variables.F90:38
mom_io::var_desc
type(vardesc) function, public var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, cmor_units, cmor_longname, conversion, caller)
Returns a vardesc type whose elements have been filled with the provided fields. The argument name is...
Definition: MOM_io.F90:600
mom_io::query_vardesc
subroutine, public query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, cmor_units, cmor_longname, conversion, caller)
This routine queries vardesc.
Definition: MOM_io.F90:699
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
mom_tracer_diabatic::applytracerboundaryfluxesinout
subroutine, public applytracerboundaryfluxesinout(G, GV, Tr, dt, fluxes, h, evap_CFL_limit, minimum_forcing_depth, in_flux_optional, out_flux_optional, update_h_opt)
This routine is modeled after applyBoundaryFluxesInOut in MOM_diabatic_aux.F90 NOTE: Please note that...
Definition: MOM_tracer_diabatic.F90:230
mom_sponge::set_up_sponge_field
subroutine, public set_up_sponge_field(sp_val, f_ptr, G, nlay, CS, sp_val_i_mean)
This subroutine stores the reference profile for the variable whose address is given by f_ptr....
Definition: MOM_sponge.F90:214
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
pseudo_salt_tracer::pseudo_salt_tracer_surface_state
subroutine, public pseudo_salt_tracer_surface_state(state, h, G, CS)
This subroutine extracts the surface fields from this tracer package that are to be shared with the a...
Definition: pseudo_salt_tracer.F90:303
atmos_ocean_fluxes_mod
A dummy version of atmos_ocean_fluxes_mod module for use when the vastly larger FMS package is not ne...
Definition: atmos_ocean_fluxes.F90:3
mom_diag_mediator
The subroutines here provide convenient wrappers to the fms diag_manager interfaces with additional d...
Definition: MOM_diag_mediator.F90:3
mom_variables::thermo_var_ptrs
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Definition: MOM_variables.F90:78
mom_diag_mediator::register_diag_field
integer function, public register_diag_field(module_name, field_name, axes_in, init_time, long_name, units, missing_value, range, mask_variant, standard_name, verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name, cell_methods, x_cell_method, y_cell_method, v_cell_method, conversion, v_extensive)
Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics derived fr...
Definition: MOM_diag_mediator.F90:1878
pseudo_salt_tracer::pseudo_salt_stock
integer function, public pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index)
Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has cal...
Definition: pseudo_salt_tracer.F90:254
mom_tracer_registry
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
Definition: MOM_tracer_registry.F90:5
mom_file_parser::param_file_type
A structure that can be parsed to read and document run-time parameters.
Definition: MOM_file_parser.F90:54
mom_file_parser::get_param
An overloaded interface to read and log the values of various types of parameters.
Definition: MOM_file_parser.F90:102
mom_hor_index
Defines the horizontal index type (hor_index_type) used for providing index ranges.
Definition: MOM_hor_index.F90:2
pseudo_salt_tracer
A tracer package that mimics salinity.
Definition: pseudo_salt_tracer.F90:2
mom_io
This module contains I/O framework code.
Definition: MOM_io.F90:2
mom_restart::mom_restart_cs
A restart registry and the control structure for restarts.
Definition: MOM_restart.F90:72
pseudo_salt_tracer::pseudo_salt_tracer_column_physics
subroutine, public pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, debug, evap_CFL_limit, minimum_forcing_depth)
Apply sources, sinks and diapycnal diffusion to the tracers in this package.
Definition: pseudo_salt_tracer.F90:176
mom_tracer_z_init
Used to initialize tracers from a depth- (or z*-) space file.
Definition: MOM_tracer_Z_init.F90:2
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
mom_tracer_diabatic
This module contains routines that implement physical fluxes of tracers (e.g. due to surface fluxes o...
Definition: MOM_tracer_diabatic.F90:4
mom_diag_mediator::post_data
Make a diagnostic available for averaging or output.
Definition: MOM_diag_mediator.F90:70
pseudo_salt_tracer::initialize_pseudo_salt_tracer
subroutine, public initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, tv)
Initialize the pseudo-salt tracer.
Definition: pseudo_salt_tracer.F90:118
mom_forcing_type
This module implements boundary forcing for MOM6.
Definition: MOM_forcing_type.F90:2
mom_tracer_diabatic::tracer_vertdiff
subroutine, public tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, sfc_flux, btm_flux, btm_reservoir, sink_rate, convert_flux_in)
This subroutine solves a tridiagonal equation for the final tracer concentrations after the dual-entr...
Definition: MOM_tracer_diabatic.F90:27
mom_verticalgrid::verticalgrid_type
Describes the vertical ocean grid, including unit conversion factors.
Definition: MOM_verticalGrid.F90:24
pseudo_salt_tracer::register_pseudo_salt_tracer
logical function, public register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
Register the pseudo-salt tracer with MOM6.
Definition: pseudo_salt_tracer.F90:61
mom_restart
The MOM6 facility for reading and writing restart files, and querying what has been read.
Definition: MOM_restart.F90:2
mom_variables
Provides transparent structures with groups of MOM6 variables and supporting routines.
Definition: MOM_variables.F90:2
mom_open_boundary
Controls where open boundary conditions are applied.
Definition: MOM_open_boundary.F90:2
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
mom_sponge
Implements sponge regions in isopycnal mode.
Definition: MOM_sponge.F90:2
mom_tracer_z_init::tracer_z_init
logical function, public tracer_z_init(tr, h, filename, tr_name, G, US, missing_val, land_val)
This function initializes a tracer by reading a Z-space file, returning .true. if this appears to hav...
Definition: MOM_tracer_Z_init.F90:31
mom_tracer_registry::tracer_registry_type
Type to carry basic tracer information.
Definition: MOM_tracer_registry.F90:138
mom_hor_index::hor_index_type
Container for horizontal index ranges for data, computational and global domains.
Definition: MOM_hor_index.F90:15
mom_grid
Provides the ocean grid type.
Definition: MOM_grid.F90:2
mom_open_boundary::ocean_obc_type
Open-boundary data.
Definition: MOM_open_boundary.F90:195
mom_sponge::sponge_cs
This control structure holds memory and parameters for the MOM_sponge module.
Definition: MOM_sponge.F90:41
mom_unit_scaling
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Definition: MOM_unit_scaling.F90:2
mom_forcing_type::forcing
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
Definition: MOM_forcing_type.F90:50
mom_debugging
Provides checksumming functions for debugging.
Definition: MOM_debugging.F90:7
mom_io::vardesc
Type for describing a variable, typically a tracer.
Definition: MOM_io.F90:53
mom_io::file_exists
Indicate whether a file exists, perhaps with domain decomposition.
Definition: MOM_io.F90:68
pseudo_salt_tracer::pseudo_salt_tracer_end
subroutine, public pseudo_salt_tracer_end(CS)
Deallocate memory associated with this tracer package.
Definition: pseudo_salt_tracer.F90:326
mom_error_handler::mom_error
subroutine, public mom_error(level, message, all_print)
This provides a convenient interface for writing an mpp_error message with run-time filter based on a...
Definition: MOM_error_handler.F90:72
pseudo_salt_tracer::pseudo_salt_tracer_cs
The control structure for the pseudo-salt tracer.
Definition: pseudo_salt_tracer.F90:39
atmos_ocean_fluxes_mod::aof_set_coupler_flux
integer function, public aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, param, flag, mol_wt, ice_restart_file, ocean_restart_file, units, caller, verbosity)
This subroutine duplicates an interface used by the FMS coupler, but only returns a value of -1....
Definition: atmos_ocean_fluxes.F90:18
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
mom_restart::query_initialized
Indicate whether a field has been read from a restart file.
Definition: MOM_restart.F90:116
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:26
mom_diag_mediator::diag_ctrl
The following data type a list of diagnostic fields an their variants, as well as variables that cont...
Definition: MOM_diag_mediator.F90:239