MOM6
MOM_tracer_flow_control.F90
Go to the documentation of this file.
1 !> Orchestrates the registration and calling of tracer packages
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
6 use mom_diag_mediator, only : time_type, diag_ctrl
7 use mom_error_handler, only : mom_error, fatal, warning
9 use mom_forcing_type, only : forcing, optics_type
10 use mom_get_input, only : get_mom_input
11 use mom_grid, only : ocean_grid_type
12 use mom_hor_index, only : hor_index_type
14 use mom_restart, only : mom_restart_cs
15 use mom_sponge, only : sponge_cs
16 use mom_ale_sponge, only : ale_sponge_cs
21 #include <MOM_memory.h>
22 
23 ! Add references to other user-provide tracer modules here.
54 #ifdef _USE_GENERIC_TRACER
55 use mom_generic_tracer, only : register_mom_generic_tracer, initialize_mom_generic_tracer
56 use mom_generic_tracer, only : mom_generic_tracer_column_physics, mom_generic_tracer_surface_state
57 use mom_generic_tracer, only : end_mom_generic_tracer, mom_generic_tracer_get, mom_generic_flux_init
58 use mom_generic_tracer, only : mom_generic_tracer_stock, mom_generic_tracer_min_max, mom_generic_tracer_cs
59 #endif
67 
68 implicit none ; private
69 
73 
74 !> The control structure for orchestrating the calling of tracer packages
75 type, public :: tracer_flow_control_cs ; private
76  logical :: use_user_tracer_example = .false. !< If true, use the USER_tracer_example package
77  logical :: use_dome_tracer = .false. !< If true, use the DOME_tracer package
78  logical :: use_isomip_tracer = .false. !< If true, use the ISOMPE_tracer package
79  logical :: use_rgc_tracer =.false. !< If true, use the RGC_tracer package
80  logical :: use_ideal_age = .false. !< If true, use the ideal age tracer package
81  logical :: use_regional_dyes = .false. !< If true, use the regional dyes tracer package
82  logical :: use_oil = .false. !< If true, use the oil tracer package
83  logical :: use_advection_test_tracer = .false. !< If true, use the advection_test_tracer package
84  logical :: use_ocmip2_cfc = .false. !< If true, use the OCMIP2_CFC tracer package
85  logical :: use_mom_generic_tracer = .false. !< If true, use the MOM_generic_tracer packages
86  logical :: use_pseudo_salt_tracer = .false. !< If true, use the psuedo_salt tracer package
87  logical :: use_boundary_impulse_tracer = .false. !< If true, use the boundary impulse tracer package
88  logical :: use_dyed_obc_tracer = .false. !< If true, use the dyed OBC tracer package
89  !>@{ Pointers to the control strucures for the tracer packages
90  type(user_tracer_example_cs), pointer :: user_tracer_example_csp => null()
91  type(dome_tracer_cs), pointer :: dome_tracer_csp => null()
92  type(isomip_tracer_cs), pointer :: isomip_tracer_csp => null()
93  type(rgc_tracer_cs), pointer :: rgc_tracer_csp => null()
94  type(ideal_age_tracer_cs), pointer :: ideal_age_tracer_csp => null()
95  type(dye_tracer_cs), pointer :: dye_tracer_csp => null()
96  type(oil_tracer_cs), pointer :: oil_tracer_csp => null()
97  type(advection_test_tracer_cs), pointer :: advection_test_tracer_csp => null()
98  type(ocmip2_cfc_cs), pointer :: ocmip2_cfc_csp => null()
99 #ifdef _USE_GENERIC_TRACER
100  type(mom_generic_tracer_cs), pointer :: mom_generic_tracer_csp => null()
101 #endif
102  type(pseudo_salt_tracer_cs), pointer :: pseudo_salt_tracer_csp => null()
103  type(boundary_impulse_tracer_cs), pointer :: boundary_impulse_tracer_csp => null()
104  type(dyed_obc_tracer_cs), pointer :: dyed_obc_tracer_csp => null()
105  !!@}
106 end type tracer_flow_control_cs
107 
108 contains
109 
110 !> This subroutine carries out a series of calls to initialize the air-sea
111 !! tracer fluxes, but it does not record the generated indicies, and it may
112 !! be called _before_ the ocean model has been initialized and may be called
113 !! on non-ocean PEs. It is not necessary to call this routine for ocean-only
114 !! runs, because the same calls are made again inside of the routines called by
115 !! call_tracer_register
116 subroutine call_tracer_flux_init(verbosity)
117  integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity.
118 
119  type(param_file_type) :: param_file ! A structure to parse for run-time parameters
120  character(len=40) :: mdl = "call_tracer_flux_init" ! This module's name.
121  logical :: use_ocmip_cfcs, use_mom_generic_tracer
122 
123  ! Determine which tracer routines with tracer fluxes are to be called. Note
124  ! that not every tracer package is required to have a flux_init call.
125  call get_mom_input(param_file, check_params=.false.)
126 
127  call get_param(param_file, mdl, "USE_OCMIP2_CFC", use_ocmip_cfcs, &
128  default=.false., do_not_log=.true.)
129  call get_param(param_file, mdl, "USE_generic_tracer", use_mom_generic_tracer,&
130  default=.false., do_not_log=.true.)
131  call close_param_file(param_file, quiet_close=.true.)
132 
133  if (use_ocmip_cfcs) call flux_init_ocmip2_cfc(verbosity=verbosity)
134  if (use_mom_generic_tracer) then
135 #ifdef _USE_GENERIC_TRACER
136  call mom_generic_flux_init(verbosity=verbosity)
137 #else
138  call mom_error(fatal, &
139  "call_tracer_flux_init: use_MOM_generic_tracer=.true. but MOM6 was "//&
140  "not compiled with _USE_GENERIC_TRACER")
141 #endif
142  endif
143 
144 end subroutine call_tracer_flux_init
145 
146 ! The following 5 subroutines and associated definitions provide the machinery to register and call
147 ! the subroutines that initialize tracers and apply vertical column processes to tracers.
148 
149 !> This subroutine determines which tracer packages are to be used and does the calls to
150 !! register their tracers to be advected, diffused, and read from restarts.
151 subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS)
152  type(hor_index_type), intent(in) :: hi !< A horizontal index type structure.
153  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
154  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
155  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
156  !! parameters.
157  type(tracer_flow_control_cs), pointer :: cs !< A pointer that is set to point to the
158  !! control structure for this module.
159  type(tracer_registry_type), pointer :: tr_reg !< A pointer that is set to point to the
160  !! control structure for the tracer
161  !! advection and diffusion module.
162  type(mom_restart_cs), pointer :: restart_cs !< A pointer to the restart control
163  !! structure.
164 
165 
166  ! This include declares and sets the variable "version".
167 # include "version_variable.h"
168  character(len=40) :: mdl = "MOM_tracer_flow_control" ! This module's name.
169 
170  if (associated(cs)) then
171  call mom_error(warning, "call_tracer_register called with an associated "// &
172  "control structure.")
173  return
174  else ; allocate(cs) ; endif
175 
176  ! Read all relevant parameters and write them to the model log.
177  call log_version(param_file, mdl, version, "")
178  call get_param(param_file, mdl, "USE_USER_TRACER_EXAMPLE", &
179  cs%use_USER_tracer_example, &
180  "If true, use the USER_tracer_example tracer package.", &
181  default=.false.)
182  call get_param(param_file, mdl, "USE_DOME_TRACER", cs%use_DOME_tracer, &
183  "If true, use the DOME_tracer tracer package.", &
184  default=.false.)
185  call get_param(param_file, mdl, "USE_ISOMIP_TRACER", cs%use_ISOMIP_tracer, &
186  "If true, use the ISOMIP_tracer tracer package.", &
187  default=.false.)
188  call get_param(param_file, mdl, "USE_RGC_TRACER", cs%use_RGC_tracer, &
189  "If true, use the RGC_tracer tracer package.", &
190  default=.false.)
191  call get_param(param_file, mdl, "USE_IDEAL_AGE_TRACER", cs%use_ideal_age, &
192  "If true, use the ideal_age_example tracer package.", &
193  default=.false.)
194  call get_param(param_file, mdl, "USE_REGIONAL_DYES", cs%use_regional_dyes, &
195  "If true, use the regional_dyes tracer package.", &
196  default=.false.)
197  call get_param(param_file, mdl, "USE_OIL_TRACER", cs%use_oil, &
198  "If true, use the oil_tracer tracer package.", &
199  default=.false.)
200  call get_param(param_file, mdl, "USE_ADVECTION_TEST_TRACER", cs%use_advection_test_tracer, &
201  "If true, use the advection_test_tracer tracer package.", &
202  default=.false.)
203  call get_param(param_file, mdl, "USE_OCMIP2_CFC", cs%use_OCMIP2_CFC, &
204  "If true, use the MOM_OCMIP2_CFC tracer package.", &
205  default=.false.)
206  call get_param(param_file, mdl, "USE_generic_tracer", cs%use_MOM_generic_tracer, &
207  "If true and _USE_GENERIC_TRACER is defined as a "//&
208  "preprocessor macro, use the MOM_generic_tracer packages.", &
209  default=.false.)
210  call get_param(param_file, mdl, "USE_PSEUDO_SALT_TRACER", cs%use_pseudo_salt_tracer, &
211  "If true, use the pseudo salt tracer, typically run as a diagnostic.", &
212  default=.false.)
213  call get_param(param_file, mdl, "USE_BOUNDARY_IMPULSE_TRACER", cs%use_boundary_impulse_tracer, &
214  "If true, use the boundary impulse tracer.", &
215  default=.false.)
216  call get_param(param_file, mdl, "USE_DYED_OBC_TRACER", cs%use_dyed_obc_tracer, &
217  "If true, use the dyed_obc_tracer tracer package.", &
218  default=.false.)
219 
220 #ifndef _USE_GENERIC_TRACER
221  if (cs%use_MOM_generic_tracer) call mom_error(fatal, &
222  "call_tracer_register: use_MOM_generic_tracer=.true. but MOM6 was "//&
223  "not compiled with _USE_GENERIC_TRACER")
224 #endif
225 
226 ! Add other user-provided calls to register tracers for restarting here. Each
227 ! tracer package registration call returns a logical false if it cannot be run
228 ! for some reason. This then overrides the run-time selection from above.
229  if (cs%use_USER_tracer_example) cs%use_USER_tracer_example = &
230  user_register_tracer_example(hi, gv, param_file, cs%USER_tracer_example_CSp, &
231  tr_reg, restart_cs)
232  if (cs%use_DOME_tracer) cs%use_DOME_tracer = &
233  register_dome_tracer(hi, gv, param_file, cs%DOME_tracer_CSp, &
234  tr_reg, restart_cs)
235  if (cs%use_ISOMIP_tracer) cs%use_ISOMIP_tracer = &
236  register_isomip_tracer(hi, gv, param_file, cs%ISOMIP_tracer_CSp, &
237  tr_reg, restart_cs)
238  if (cs%use_RGC_tracer) cs%use_RGC_tracer = &
239  register_rgc_tracer(hi, gv, param_file, cs%RGC_tracer_CSp, &
240  tr_reg, restart_cs)
241  if (cs%use_ideal_age) cs%use_ideal_age = &
242  register_ideal_age_tracer(hi, gv, param_file, cs%ideal_age_tracer_CSp, &
243  tr_reg, restart_cs)
244  if (cs%use_regional_dyes) cs%use_regional_dyes = &
245  register_dye_tracer(hi, gv, us, param_file, cs%dye_tracer_CSp, &
246  tr_reg, restart_cs)
247  if (cs%use_oil) cs%use_oil = &
248  register_oil_tracer(hi, gv, us, param_file, cs%oil_tracer_CSp, &
249  tr_reg, restart_cs)
250  if (cs%use_advection_test_tracer) cs%use_advection_test_tracer = &
251  register_advection_test_tracer(hi, gv, param_file, cs%advection_test_tracer_CSp, &
252  tr_reg, restart_cs)
253  if (cs%use_OCMIP2_CFC) cs%use_OCMIP2_CFC = &
254  register_ocmip2_cfc(hi, gv, param_file, cs%OCMIP2_CFC_CSp, &
255  tr_reg, restart_cs)
256 #ifdef _USE_GENERIC_TRACER
257  if (cs%use_MOM_generic_tracer) cs%use_MOM_generic_tracer = &
258  register_mom_generic_tracer(hi, gv, param_file, cs%MOM_generic_tracer_CSp, &
259  tr_reg, restart_cs)
260 #endif
261  if (cs%use_pseudo_salt_tracer) cs%use_pseudo_salt_tracer = &
262  register_pseudo_salt_tracer(hi, gv, param_file, cs%pseudo_salt_tracer_CSp, &
263  tr_reg, restart_cs)
264  if (cs%use_boundary_impulse_tracer) cs%use_boundary_impulse_tracer = &
265  register_boundary_impulse_tracer(hi, gv, param_file, cs%boundary_impulse_tracer_CSp, &
266  tr_reg, restart_cs)
267  if (cs%use_dyed_obc_tracer) cs%use_dyed_obc_tracer = &
268  register_dyed_obc_tracer(hi, gv, param_file, cs%dyed_obc_tracer_CSp, &
269  tr_reg, restart_cs)
270 
271 
272 end subroutine call_tracer_register
273 
274 !> This subroutine calls all registered tracer initialization
275 !! subroutines.
276 subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag, OBC, &
277  CS, sponge_CSp, ALE_sponge_CSp, tv)
278  logical, intent(in) :: restart !< 1 if the fields have already
279  !! been read from a restart file.
280  type(time_type), target, intent(in) :: day !< Time of the start of the run.
281  type(ocean_grid_type), intent(inout) :: g !< The ocean's grid structure.
282  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid
283  !! structure.
284  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
285  real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
286  type(param_file_type), intent(in) :: param_file !< A structure to parse for
287  !! run-time parameters
288  type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to
289  !! regulate diagnostic output.
290  type(ocean_obc_type), pointer :: obc !< This open boundary condition
291  !! type specifies whether, where,
292  !! and what open boundary
293  !! conditions are used.
294  type(tracer_flow_control_cs), pointer :: cs !< The control structure returned
295  !! by a previous call to
296  !! call_tracer_register.
297  type(sponge_cs), pointer :: sponge_csp !< A pointer to the control
298  !! structure for the sponges, if they are in use.
299  !! Otherwise this may be unassociated.
300  type(ale_sponge_cs), pointer :: ale_sponge_csp !< A pointer to the control
301  !! structure for the ALE sponges, if they are in use.
302  !! Otherwise this may be unassociated.
303  type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
304  !! thermodynamic variables
305 
306  if (.not. associated(cs)) call mom_error(fatal, "tracer_flow_control_init: "// &
307  "Module must be initialized via call_tracer_register before it is used.")
308 
309 ! Add other user-provided calls here.
310  if (cs%use_USER_tracer_example) &
311  call user_initialize_tracer(restart, day, g, gv, h, diag, obc, cs%USER_tracer_example_CSp, &
312  sponge_csp)
313  if (cs%use_DOME_tracer) &
314  call initialize_dome_tracer(restart, day, g, gv, us, h, diag, obc, cs%DOME_tracer_CSp, &
315  sponge_csp, param_file)
316  if (cs%use_ISOMIP_tracer) &
317  call initialize_isomip_tracer(restart, day, g, gv, h, diag, obc, cs%ISOMIP_tracer_CSp, &
318  ale_sponge_csp)
319  if (cs%use_RGC_tracer) &
320  call initialize_rgc_tracer(restart, day, g, gv, h, diag, obc, &
321  cs%RGC_tracer_CSp, sponge_csp, ale_sponge_csp)
322  if (cs%use_ideal_age) &
323  call initialize_ideal_age_tracer(restart, day, g, gv, us, h, diag, obc, cs%ideal_age_tracer_CSp, &
324  sponge_csp)
325  if (cs%use_regional_dyes) &
326  call initialize_dye_tracer(restart, day, g, gv, h, diag, obc, cs%dye_tracer_CSp, &
327  sponge_csp)
328  if (cs%use_oil) &
329  call initialize_oil_tracer(restart, day, g, gv, us, h, diag, obc, cs%oil_tracer_CSp, &
330  sponge_csp)
331  if (cs%use_advection_test_tracer) &
332  call initialize_advection_test_tracer(restart, day, g, gv, h, diag, obc, cs%advection_test_tracer_CSp, &
333  sponge_csp)
334  if (cs%use_OCMIP2_CFC) &
335  call initialize_ocmip2_cfc(restart, day, g, gv, us, h, diag, obc, cs%OCMIP2_CFC_CSp, &
336  sponge_csp)
337 #ifdef _USE_GENERIC_TRACER
338  if (cs%use_MOM_generic_tracer) &
339  call initialize_mom_generic_tracer(restart, day, g, gv, us, h, param_file, diag, obc, &
340  cs%MOM_generic_tracer_CSp, sponge_csp, ale_sponge_csp)
341 #endif
342  if (cs%use_pseudo_salt_tracer) &
343  call initialize_pseudo_salt_tracer(restart, day, g, gv, h, diag, obc, cs%pseudo_salt_tracer_CSp, &
344  sponge_csp, tv)
345  if (cs%use_boundary_impulse_tracer) &
346  call initialize_boundary_impulse_tracer(restart, day, g, gv, h, diag, obc, cs%boundary_impulse_tracer_CSp, &
347  sponge_csp, tv)
348  if (cs%use_dyed_obc_tracer) &
349  call initialize_dyed_obc_tracer(restart, day, g, gv, h, diag, obc, cs%dyed_obc_tracer_CSp)
350 
351 end subroutine tracer_flow_control_init
352 
353 !> This subroutine extracts the chlorophyll concentrations from the model state, if possible
354 subroutine get_chl_from_model(Chl_array, G, CS)
355  real, dimension(NIMEM_,NJMEM_,NKMEM_), &
356  intent(out) :: chl_array !< The array in which to store the model's
357  !! Chlorophyll-A concentrations in mg m-3.
358  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
359  type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by a
360  !! previous call to call_tracer_register.
361 
362 #ifdef _USE_GENERIC_TRACER
363  if (cs%use_MOM_generic_tracer) then
364  call mom_generic_tracer_get('chl','field',chl_array, cs%MOM_generic_tracer_CSp)
365  else
366  call mom_error(fatal, "get_chl_from_model was called in a configuration "// &
367  "that is unable to provide a sensible model-based value.\n"// &
368  "CS%use_MOM_generic_tracer is false and no other viable options are on.")
369  endif
370 #else
371  call mom_error(fatal, "get_chl_from_model was called in a configuration "// &
372  "that is unable to provide a sensible model-based value.\n"// &
373  "_USE_GENERIC_TRACER is undefined and no other options "//&
374  "are currently viable.")
375 #endif
376 
377 end subroutine get_chl_from_model
378 
379 !> This subroutine calls the individual tracer modules' subroutines to
380 !! specify or read quantities related to their surface forcing.
381 subroutine call_tracer_set_forcing(state, fluxes, day_start, day_interval, G, CS)
382 
383  type(surface), intent(inout) :: state !< A structure containing fields that
384  !! describe the surface state of the
385  !! ocean.
386  type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any
387  !! possible forcing fields. Unused fields
388  !! have NULL ptrs.
389  type(time_type), intent(in) :: day_start !< Start time of the fluxes.
390  type(time_type), intent(in) :: day_interval !< Length of time over which these
391  !! fluxes will be applied.
392  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
393  type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by a
394  !! previous call to call_tracer_register.
395 
396  if (.not. associated(cs)) call mom_error(fatal, "call_tracer_set_forcing"// &
397  "Module must be initialized via call_tracer_register before it is used.")
398 ! if (CS%use_ideal_age) &
399 ! call ideal_age_tracer_set_forcing(state, fluxes, day_start, day_interval, &
400 ! G, CS%ideal_age_tracer_CSp)
401 
402 end subroutine call_tracer_set_forcing
403 
404 !> This subroutine calls all registered tracer column physics subroutines.
405 subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, tv, optics, CS, &
406  debug, evap_CFL_limit, minimum_forcing_depth)
407  real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_old !< Layer thickness before entrainment
408  !! [H ~> m or kg m-2].
409  real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_new !< Layer thickness after entrainment
410  !! [H ~> m or kg m-2].
411  real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: ea !< an array to which the amount of
412  !! fluid entrained from the layer above during this call
413  !! will be added [H ~> m or kg m-2].
414  real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: eb !< an array to which the amount of
415  !! fluid entrained from the layer below during this call
416  !! will be added [H ~> m or kg m-2].
417  type(forcing), intent(in) :: fluxes !< A structure containing pointers to
418  !! any possible forcing fields.
419  !! Unused fields have NULL ptrs.
420  real, dimension(NIMEM_,NJMEM_), intent(in) :: hml !< Mixed layer depth [H ~> m or kg m-2]
421  real, intent(in) :: dt !< The amount of time covered by this
422  !! call [T ~> s]
423  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
424  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid
425  !! structure.
426  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
427  type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
428  !! thermodynamic variables.
429  type(optics_type), pointer :: optics !< The structure containing optical
430  !! properties.
431  type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by
432  !! a previous call to
433  !! call_tracer_register.
434  logical, intent(in) :: debug !< If true calculate checksums
435  real, optional, intent(in) :: evap_cfl_limit !< Limit on the fraction of
436  !! the water that can be fluxed out
437  !! of the top layer in a timestep [nondim]
438  real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over
439  !! which fluxes can be applied [H ~> m or kg m-2]
440 
441  if (.not. associated(cs)) call mom_error(fatal, "call_tracer_column_fns: "// &
442  "Module must be initialized via call_tracer_register before it is used.")
443 
444  ! Use the applyTracerBoundaryFluxesInOut to handle surface fluxes
445  if (present(evap_cfl_limit) .and. present(minimum_forcing_depth)) then
446  ! Add calls to tracer column functions here.
447  if (cs%use_USER_tracer_example) &
448  call tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
449  g, gv, us, cs%USER_tracer_example_CSp)
450  if (cs%use_DOME_tracer) &
451  call dome_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
452  g, gv, us, cs%DOME_tracer_CSp, &
453  evap_cfl_limit=evap_cfl_limit, &
454  minimum_forcing_depth=minimum_forcing_depth)
455  if (cs%use_ISOMIP_tracer) &
456  call isomip_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
457  g, gv, us, cs%ISOMIP_tracer_CSp, &
458  evap_cfl_limit=evap_cfl_limit, &
459  minimum_forcing_depth=minimum_forcing_depth)
460  if (cs%use_RGC_tracer) &
461  call rgc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
462  g, gv, us, cs%RGC_tracer_CSp, &
463  evap_cfl_limit=evap_cfl_limit, &
464  minimum_forcing_depth=minimum_forcing_depth)
465  if (cs%use_ideal_age) &
466  call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
467  g, gv, us, cs%ideal_age_tracer_CSp, &
468  evap_cfl_limit=evap_cfl_limit, &
469  minimum_forcing_depth=minimum_forcing_depth)
470  if (cs%use_regional_dyes) &
471  call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
472  g, gv, us, cs%dye_tracer_CSp, &
473  evap_cfl_limit=evap_cfl_limit, &
474  minimum_forcing_depth=minimum_forcing_depth)
475  if (cs%use_oil) &
476  call oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
477  g, gv, us, cs%oil_tracer_CSp, tv, &
478  evap_cfl_limit=evap_cfl_limit, &
479  minimum_forcing_depth=minimum_forcing_depth)
480 
481  if (cs%use_advection_test_tracer) &
482  call advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
483  g, gv, us, cs%advection_test_tracer_CSp, &
484  evap_cfl_limit=evap_cfl_limit, &
485  minimum_forcing_depth=minimum_forcing_depth)
486  if (cs%use_OCMIP2_CFC) &
487  call ocmip2_cfc_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
488  g, gv, us, cs%OCMIP2_CFC_CSp, &
489  evap_cfl_limit=evap_cfl_limit, &
490  minimum_forcing_depth=minimum_forcing_depth)
491 #ifdef _USE_GENERIC_TRACER
492  if (cs%use_MOM_generic_tracer) &
493  call mom_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, hml, us%T_to_s*dt, &
494  g, gv, cs%MOM_generic_tracer_CSp, tv, optics, &
495  evap_cfl_limit=evap_cfl_limit, &
496  minimum_forcing_depth=minimum_forcing_depth)
497 #endif
498  if (cs%use_pseudo_salt_tracer) &
499  call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
500  g, gv, us, cs%pseudo_salt_tracer_CSp, tv, debug, &
501  evap_cfl_limit=evap_cfl_limit, &
502  minimum_forcing_depth=minimum_forcing_depth)
503  if (cs%use_boundary_impulse_tracer) &
504  call boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
505  g, gv, us, cs%boundary_impulse_tracer_CSp, tv, debug, &
506  evap_cfl_limit=evap_cfl_limit, &
507  minimum_forcing_depth=minimum_forcing_depth)
508  if (cs%use_dyed_obc_tracer) &
509  call dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
510  g, gv, us, cs%dyed_obc_tracer_CSp, &
511  evap_cfl_limit=evap_cfl_limit, &
512  minimum_forcing_depth=minimum_forcing_depth)
513 
514 
515  else ! Apply tracer surface fluxes using ea on the first layer
516  if (cs%use_USER_tracer_example) &
517  call tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
518  g, gv, us, cs%USER_tracer_example_CSp)
519  if (cs%use_DOME_tracer) &
520  call dome_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
521  g, gv, us, cs%DOME_tracer_CSp)
522  if (cs%use_ISOMIP_tracer) &
523  call isomip_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
524  g, gv, us, cs%ISOMIP_tracer_CSp)
525  if (cs%use_RGC_tracer) &
526  call rgc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
527  g, gv, us, cs%RGC_tracer_CSp)
528  if (cs%use_ideal_age) &
529  call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
530  g, gv, us, cs%ideal_age_tracer_CSp)
531  if (cs%use_regional_dyes) &
532  call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
533  g, gv, us, cs%dye_tracer_CSp)
534  if (cs%use_oil) &
535  call oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
536  g, gv, us, cs%oil_tracer_CSp, tv)
537  if (cs%use_advection_test_tracer) &
538  call advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
539  g, gv, us, cs%advection_test_tracer_CSp)
540  if (cs%use_OCMIP2_CFC) &
541  call ocmip2_cfc_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
542  g, gv, us, cs%OCMIP2_CFC_CSp)
543 #ifdef _USE_GENERIC_TRACER
544  if (cs%use_MOM_generic_tracer) &
545  call mom_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, hml, us%T_to_s*dt, &
546  g, gv, cs%MOM_generic_tracer_CSp, tv, optics)
547 #endif
548  if (cs%use_pseudo_salt_tracer) &
549  call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
550  g, gv, us, cs%pseudo_salt_tracer_CSp, tv, debug)
551  if (cs%use_boundary_impulse_tracer) &
552  call boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
553  g, gv, us, cs%boundary_impulse_tracer_CSp, tv, debug)
554  if (cs%use_dyed_obc_tracer) &
555  call dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
556  g, gv, us, cs%dyed_obc_tracer_CSp)
557 
558  endif
559 
560 
561 end subroutine call_tracer_column_fns
562 
563 !> This subroutine calls all registered tracer packages to enable them to
564 !! add to the surface state returned to the coupler. These routines are optional.
565 subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_units, &
566  num_stocks, stock_index, got_min_max, global_min, global_max, &
567  xgmin, ygmin, zgmin, xgmax, ygmax, zgmax)
568  real, dimension(NIMEM_,NJMEM_,NKMEM_), &
569  intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
570  real, dimension(:), intent(out) :: stock_values !< The integrated amounts of a tracer
571  !! on the current PE, usually in kg x concentration [kg conc].
572  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
573  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
574  type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by a
575  !! previous call to
576  !! call_tracer_register.
577  character(len=*), dimension(:), &
578  optional, intent(out) :: stock_names !< Diagnostic names to use for each stock.
579  character(len=*), dimension(:), &
580  optional, intent(out) :: stock_units !< Units to use in the metadata for each stock.
581  integer, optional, intent(out) :: num_stocks !< The number of tracer stocks being returned.
582  integer, optional, intent(in) :: stock_index !< The integer stock index from
583  !! stocks_constants_mod of the stock to be returned. If this is
584  !! present and greater than 0, only a single stock can be returned.
585  logical, dimension(:), &
586  optional, intent(inout) :: got_min_max !< Indicates whether the global min and
587  !! max are found for each tracer
588  real, dimension(:), optional, intent(out) :: global_min !< The global minimum of each tracer
589  real, dimension(:), optional, intent(out) :: global_max !< The global maximum of each tracer
590  real, dimension(:), optional, intent(out) :: xgmin !< The x-position of the global minimum
591  real, dimension(:), optional, intent(out) :: ygmin !< The y-position of the global minimum
592  real, dimension(:), optional, intent(out) :: zgmin !< The z-position of the global minimum
593  real, dimension(:), optional, intent(out) :: xgmax !< The x-position of the global maximum
594  real, dimension(:), optional, intent(out) :: ygmax !< The y-position of the global maximum
595  real, dimension(:), optional, intent(out) :: zgmax !< The z-position of the global maximum
596 
597  ! Local variables
598  character(len=200), dimension(MAX_FIELDS_) :: names, units
599  character(len=200) :: set_pkg_name
600  real, dimension(MAX_FIELDS_) :: values
601  integer :: max_ns, ns_tot, ns, index, pkg, max_pkgs, nn
602 
603  if (.not. associated(cs)) call mom_error(fatal, "call_tracer_stocks: "// &
604  "Module must be initialized via call_tracer_register before it is used.")
605 
606  index = -1 ; if (present(stock_index)) index = stock_index
607  ns_tot = 0
608  max_ns = size(stock_values)
609  if (present(stock_names)) max_ns = min(max_ns,size(stock_names))
610  if (present(stock_units)) max_ns = min(max_ns,size(stock_units))
611 
612 ! Add other user-provided calls here.
613  if (cs%use_USER_tracer_example) then
614  ns = user_tracer_stock(h, values, g, gv, cs%USER_tracer_example_CSp, &
615  names, units, stock_index)
616  call store_stocks("tracer_example", ns, names, units, values, index, stock_values, &
617  set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
618  endif
619 ! if (CS%use_DOME_tracer) then
620 ! ns = DOME_tracer_stock(h, values, G, GV, CS%DOME_tracer_CSp, &
621 ! names, units, stock_index)
622 ! call store_stocks("DOME_tracer", ns, names, units, values, index, stock_values, &
623 ! set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
624 ! endif
625  if (cs%use_ideal_age) then
626  ns = ideal_age_stock(h, values, g, gv, cs%ideal_age_tracer_CSp, &
627  names, units, stock_index)
628  call store_stocks("ideal_age_example", ns, names, units, values, index, &
629  stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
630  endif
631  if (cs%use_regional_dyes) then
632  ns = dye_stock(h, values, g, gv, cs%dye_tracer_CSp, &
633  names, units, stock_index)
634  call store_stocks("regional_dyes", ns, names, units, values, index, &
635  stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
636  endif
637  if (cs%use_oil) then
638  ns = oil_stock(h, values, g, gv, cs%oil_tracer_CSp, &
639  names, units, stock_index)
640  call store_stocks("oil_tracer", ns, names, units, values, index, &
641  stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
642  endif
643  if (cs%use_OCMIP2_CFC) then
644  ns = ocmip2_cfc_stock(h, values, g, gv, cs%OCMIP2_CFC_CSp, names, units, stock_index)
645  call store_stocks("MOM_OCMIP2_CFC", ns, names, units, values, index, stock_values, &
646  set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
647  endif
648 
649  if (cs%use_advection_test_tracer) then
650  ns = advection_test_stock( h, values, g, gv, cs%advection_test_tracer_CSp, &
651  names, units, stock_index )
652  call store_stocks("advection_test_tracer", ns, names, units, values, index, &
653  stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
654  endif
655 
656 #ifdef _USE_GENERIC_TRACER
657  if (cs%use_MOM_generic_tracer) then
658  ns = mom_generic_tracer_stock(h, values, g, gv, cs%MOM_generic_tracer_CSp, &
659  names, units, stock_index)
660  call store_stocks("MOM_generic_tracer", ns, names, units, values, index, stock_values, &
661  set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
662  nn=ns_tot-ns+1
663  nn=mom_generic_tracer_min_max(nn, got_min_max, global_min, global_max, &
664  xgmin, ygmin, zgmin, xgmax, ygmax, zgmax ,&
665  g, cs%MOM_generic_tracer_CSp,names, units)
666 
667  endif
668 #endif
669  if (cs%use_pseudo_salt_tracer) then
670  ns = pseudo_salt_stock(h, values, g, gv, cs%pseudo_salt_tracer_CSp, &
671  names, units, stock_index)
672  call store_stocks("pseudo_salt_tracer", ns, names, units, values, index, &
673  stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
674  endif
675 
676  if (cs%use_boundary_impulse_tracer) then
677  ns = boundary_impulse_stock(h, values, g, gv, cs%boundary_impulse_tracer_CSp, &
678  names, units, stock_index)
679  call store_stocks("boundary_impulse_tracer", ns, names, units, values, index, &
680  stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
681  endif
682 
683  if (ns_tot == 0) stock_values(1) = 0.0
684 
685  if (present(num_stocks)) num_stocks = ns_tot
686 
687 end subroutine call_tracer_stocks
688 
689 !> This routine stores the stocks and does error handling for call_tracer_stocks.
690 subroutine store_stocks(pkg_name, ns, names, units, values, index, stock_values, &
691  set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
692  character(len=*), intent(in) :: pkg_name !< The tracer package name
693  integer, intent(in) :: ns !< The number of stocks associated with this tracer package
694  character(len=*), dimension(:), &
695  intent(in) :: names !< Diagnostic names to use for each stock.
696  character(len=*), dimension(:), &
697  intent(in) :: units !< Units to use in the metadata for each stock.
698  real, dimension(:), intent(in) :: values !< The values of the tracer stocks
699  integer, intent(in) :: index !< The integer stock index from
700  !! stocks_constants_mod of the stock to be returned. If this is
701  !! present and greater than 0, only a single stock can be returned.
702  real, dimension(:), intent(inout) :: stock_values !< The master list of stock values
703  character(len=*), intent(inout) :: set_pkg_name !< The name of the last tracer package whose
704  !! stocks were stored for a specific index. This is
705  !! used to trigger an error if there are redundant stocks.
706  integer, intent(in) :: max_ns !< The maximum size of the master stock list
707  integer, intent(inout) :: ns_tot !< The total number of stocks in the master list
708  character(len=*), dimension(:), &
709  optional, intent(inout) :: stock_names !< Diagnostic names to use for each stock in the master list
710  character(len=*), dimension(:), &
711  optional, intent(inout) :: stock_units !< Units to use in the metadata for each stock in the master list
712 
713 ! This routine stores the stocks and does error handling for call_tracer_stocks.
714  character(len=16) :: ind_text, ns_text, max_text
715  integer :: n
716 
717  if ((index > 0) .and. (ns > 0)) then
718  write(ind_text,'(i8)') index
719  if (ns > 1) then
720  call mom_error(fatal,"Tracer package "//trim(pkg_name)//&
721  " is not permitted to return more than one value when queried"//&
722  " for specific stock index "//trim(adjustl(ind_text))//".")
723  elseif (ns+ns_tot > 1) then
724  call mom_error(fatal,"Tracer packages "//trim(pkg_name)//" and "//&
725  trim(set_pkg_name)//" both attempted to set values for"//&
726  " specific stock index "//trim(adjustl(ind_text))//".")
727  else
728  set_pkg_name = pkg_name
729  endif
730  endif
731 
732  if (ns_tot+ns > max_ns) then
733  write(ns_text,'(i8)') ns_tot+ns ; write(max_text,'(i8)') max_ns
734  call mom_error(fatal,"Attempted to return more tracer stock values (at least "//&
735  trim(adjustl(ns_text))//") than the size "//trim(adjustl(max_text))//&
736  "of the smallest value, name, or units array.")
737  endif
738 
739  do n=1,ns
740  stock_values(ns_tot+n) = values(n)
741  if (present(stock_names)) stock_names(ns_tot+n) = names(n)
742  if (present(stock_units)) stock_units(ns_tot+n) = units(n)
743  enddo
744  ns_tot = ns_tot + ns
745 
746 end subroutine store_stocks
747 
748 !> This subroutine calls all registered tracer packages to enable them to
749 !! add to the surface state returned to the coupler. These routines are optional.
750 subroutine call_tracer_surface_state(state, h, G, CS)
751  type(surface), intent(inout) :: state !< A structure containing fields that
752  !! describe the surface state of the ocean.
753  real, dimension(NIMEM_,NJMEM_,NKMEM_), &
754  intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
755  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
756  type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by a
757  !! previous call to call_tracer_register.
758 
759  if (.not. associated(cs)) call mom_error(fatal, "call_tracer_surface_state: "// &
760  "Module must be initialized via call_tracer_register before it is used.")
761 
762 ! Add other user-provided calls here.
763  if (cs%use_USER_tracer_example) &
764  call user_tracer_surface_state(state, h, g, cs%USER_tracer_example_CSp)
765  if (cs%use_DOME_tracer) &
766  call dome_tracer_surface_state(state, h, g, cs%DOME_tracer_CSp)
767  if (cs%use_ISOMIP_tracer) &
768  call isomip_tracer_surface_state(state, h, g, cs%ISOMIP_tracer_CSp)
769  if (cs%use_ideal_age) &
770  call ideal_age_tracer_surface_state(state, h, g, cs%ideal_age_tracer_CSp)
771  if (cs%use_regional_dyes) &
772  call dye_tracer_surface_state(state, h, g, cs%dye_tracer_CSp)
773  if (cs%use_oil) &
774  call oil_tracer_surface_state(state, h, g, cs%oil_tracer_CSp)
775  if (cs%use_advection_test_tracer) &
776  call advection_test_tracer_surface_state(state, h, g, cs%advection_test_tracer_CSp)
777  if (cs%use_OCMIP2_CFC) &
778  call ocmip2_cfc_surface_state(state, h, g, cs%OCMIP2_CFC_CSp)
779 #ifdef _USE_GENERIC_TRACER
780  if (cs%use_MOM_generic_tracer) &
781  call mom_generic_tracer_surface_state(state, h, g, cs%MOM_generic_tracer_CSp)
782 #endif
783 
784 end subroutine call_tracer_surface_state
785 
786 subroutine tracer_flow_control_end(CS)
787  type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by a
788  !! previous call to call_tracer_register.
789 
790  if (cs%use_USER_tracer_example) &
791  call user_tracer_example_end(cs%USER_tracer_example_CSp)
792  if (cs%use_DOME_tracer) call dome_tracer_end(cs%DOME_tracer_CSp)
793  if (cs%use_ISOMIP_tracer) call isomip_tracer_end(cs%ISOMIP_tracer_CSp)
794  if (cs%use_RGC_tracer) call rgc_tracer_end(cs%RGC_tracer_CSp)
795  if (cs%use_ideal_age) call ideal_age_example_end(cs%ideal_age_tracer_CSp)
796  if (cs%use_regional_dyes) call regional_dyes_end(cs%dye_tracer_CSp)
797  if (cs%use_oil) call oil_tracer_end(cs%oil_tracer_CSp)
798  if (cs%use_advection_test_tracer) call advection_test_tracer_end(cs%advection_test_tracer_CSp)
799  if (cs%use_OCMIP2_CFC) call ocmip2_cfc_end(cs%OCMIP2_CFC_CSp)
800 #ifdef _USE_GENERIC_TRACER
801  if (cs%use_MOM_generic_tracer) call end_mom_generic_tracer(cs%MOM_generic_tracer_CSp)
802 #endif
803  if (cs%use_pseudo_salt_tracer) call pseudo_salt_tracer_end(cs%pseudo_salt_tracer_CSp)
804  if (cs%use_boundary_impulse_tracer) call boundary_impulse_tracer_end(cs%boundary_impulse_tracer_CSp)
805  if (cs%use_dyed_obc_tracer) call dyed_obc_tracer_end(cs%dyed_obc_tracer_CSp)
806 
807  if (associated(cs)) deallocate(cs)
808 end subroutine tracer_flow_control_end
809 
810 !> \namespace MOM_tracer_flow_control
811 !!
812 !! By Will Cooke, April 2003
813 !! Edited by Elizabeth Yankovsky, May 2019
814 !!
815 !! This module contains two subroutines into which calls to other
816 !! tracer initialization (call_tracer_init_fns) and column physics
817 !! routines (call_tracer_column_fns) can be inserted.
818 !!
819 end module mom_tracer_flow_control
regional_dyes::dye_tracer_column_physics
subroutine, public dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, evap_CFL_limit, minimum_forcing_depth)
This subroutine applies diapycnal diffusion and any other column tracer physics or chemistry to the t...
Definition: dye_example.F90:248
dyed_obc_tracer::initialize_dyed_obc_tracer
subroutine, public initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS)
Initializes the CSntr tracer fields in tr(:,:,:,:) and sets up the tracer output.
Definition: dyed_obc_tracer.F90:136
advection_test_tracer::advection_test_tracer_cs
The control structure for the advect_test_tracer module.
Definition: advection_test_tracer.F90:37
dome_tracer::dome_tracer_surface_state
subroutine, public dome_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: DOME_tracer.F90:342
mom_tracer_flow_control::tracer_flow_control_init
subroutine, public tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag, OBC, CS, sponge_CSp, ALE_sponge_CSp, tv)
This subroutine calls all registered tracer initialization subroutines.
Definition: MOM_tracer_flow_control.F90:278
rgc_tracer::initialize_rgc_tracer
subroutine, public initialize_rgc_tracer(restart, day, G, GV, h, diag, OBC, CS, layer_CSp, sponge_CSp)
Initializes the NTR tracer fields in tr(:,:,:,:) and it sets up the tracer output.
Definition: RGC_tracer.F90:156
mom_tracer_flow_control::call_tracer_surface_state
subroutine, public call_tracer_surface_state(state, h, G, CS)
This subroutine calls all registered tracer packages to enable them to add to the surface state retur...
Definition: MOM_tracer_flow_control.F90:751
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
oil_tracer::oil_tracer_surface_state
subroutine, public oil_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: oil_tracer.F90:458
advection_test_tracer::advection_test_tracer_surface_state
subroutine, public advection_test_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: advection_test_tracer.F90:320
regional_dyes
A tracer package for using dyes to diagnose regional flows.
Definition: dye_example.F90:2
ideal_age_example::ideal_age_stock
integer function, public ideal_age_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: ideal_age_example.F90:375
boundary_impulse_tracer::boundary_impulse_tracer_column_physics
subroutine, public boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, debug, evap_CFL_limit, minimum_forcing_depth)
Apply source or sink at boundary and do vertical diffusion.
Definition: boundary_impulse_tracer.F90:209
dyed_obc_tracer
This tracer package dyes flow through open boundaries.
Definition: dyed_obc_tracer.F90:2
advection_test_tracer::initialize_advection_test_tracer
subroutine, public initialize_advection_test_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp)
Initializes the NTR tracer fields in tr(:,:,:,:) and it sets up the tracer output.
Definition: advection_test_tracer.F90:168
regional_dyes::initialize_dye_tracer
subroutine, public initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp)
This subroutine initializes the CSntr tracer fields in tr(:,:,:,:) and it sets up the tracer output.
Definition: dye_example.F90:187
rgc_tracer
This module contains the routines used to set up a dynamically passive tracer. Set up and use passive...
Definition: RGC_tracer.F90:12
user_tracer_example::user_register_tracer_example
logical function, public user_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS)
This subroutine is used to register tracer fields and subroutines to be used with MOM.
Definition: tracer_example.F90:57
oil_tracer::register_oil_tracer
logical function, public register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS)
Register oil tracer fields and subroutines to be used with MOM.
Definition: oil_tracer.F90:78
user_tracer_example::user_tracer_stock
integer function, public user_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index)
This function calculates the mass-weighted integral of all tracer stocks, returning the number of sto...
Definition: tracer_example.F90:363
boundary_impulse_tracer::boundary_impulse_tracer_end
subroutine, public boundary_impulse_tracer_end(CS)
Performs finalization of boundary impulse tracer.
Definition: boundary_impulse_tracer.F90:369
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
ideal_age_example
A tracer package of ideal age tracers.
Definition: ideal_age_example.F90:2
mom_ocmip2_cfc::ocmip2_cfc_column_physics
subroutine, public ocmip2_cfc_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, evap_CFL_limit, minimum_forcing_depth)
This subroutine applies diapycnal diffusion, souces and sinks and any other column tracer physics or ...
Definition: MOM_OCMIP2_CFC.F90:411
boundary_impulse_tracer::boundary_impulse_tracer_cs
The control structure for the boundary impulse tracer package.
Definition: boundary_impulse_tracer.F90:40
ideal_age_example::ideal_age_tracer_surface_state
subroutine, public ideal_age_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: ideal_age_example.F90:424
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
user_tracer_example::user_tracer_surface_state
subroutine, public user_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: tracer_example.F90:409
mom_ocmip2_cfc::ocmip2_cfc_end
subroutine, public ocmip2_cfc_end(CS)
Deallocate any memory associated with the OCMIP2 CFC tracer package.
Definition: MOM_OCMIP2_CFC.F90:618
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
dome_tracer::initialize_dome_tracer
subroutine, public initialize_dome_tracer(restart, day, G, GV, US, h, diag, OBC, CS, sponge_CSp, param_file)
Initializes the NTR tracer fields in tr(:,:,:,:) and sets up the tracer output.
Definition: DOME_tracer.F90:144
boundary_impulse_tracer
Implements a boundary impulse response tracer to calculate Green's functions.
Definition: boundary_impulse_tracer.F90:2
mom_tracer_flow_control::call_tracer_column_fns
subroutine, public call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, tv, optics, CS, debug, evap_CFL_limit, minimum_forcing_depth)
This subroutine calls all registered tracer column physics subroutines.
Definition: MOM_tracer_flow_control.F90:407
mom_ale_sponge::ale_sponge_cs
ALE sponge control structure.
Definition: MOM_ALE_sponge.F90:84
oil_tracer::oil_tracer_cs
The control structure for the oil tracer package.
Definition: oil_tracer.F90:38
mom_ocmip2_cfc::ocmip2_cfc_stock
integer function, public ocmip2_cfc_stock(h, stocks, G, GV, CS, names, units, stock_index)
This function calculates the mass-weighted integral of all tracer stocks, returning the number of sto...
Definition: MOM_OCMIP2_CFC.F90:497
mom_tracer_flow_control::call_tracer_flux_init
subroutine, public call_tracer_flux_init(verbosity)
This subroutine carries out a series of calls to initialize the air-sea tracer fluxes,...
Definition: MOM_tracer_flow_control.F90:117
dome_tracer::dome_tracer_column_physics
subroutine, public dome_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, evap_CFL_limit, minimum_forcing_depth)
This subroutine applies diapycnal diffusion and any other column tracer physics or chemistry to the t...
Definition: DOME_tracer.F90:287
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
isomip_tracer::isomip_tracer_column_physics
subroutine, public isomip_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, evap_CFL_limit, minimum_forcing_depth)
This subroutine applies diapycnal diffusion, including the surface boundary conditions and any other ...
Definition: ISOMIP_tracer.F90:250
dyed_obc_tracer::dyed_obc_tracer_cs
The control structure for the dyed_obc tracer package.
Definition: dyed_obc_tracer.F90:33
mom_tracer_registry
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
Definition: MOM_tracer_registry.F90:5
advection_test_tracer::advection_test_tracer_column_physics
subroutine, public advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, evap_CFL_limit, minimum_forcing_depth)
Applies diapycnal diffusion and any other column tracer physics or chemistry to the tracers from this...
Definition: advection_test_tracer.F90:260
user_tracer_example::user_tracer_example_end
subroutine, public user_tracer_example_end(CS)
Clean up allocated memory at the end.
Definition: tracer_example.F90:440
mom_tracer_flow_control::get_chl_from_model
subroutine, public get_chl_from_model(Chl_array, G, CS)
This subroutine extracts the chlorophyll concentrations from the model state, if possible.
Definition: MOM_tracer_flow_control.F90:355
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
ideal_age_example::ideal_age_example_end
subroutine, public ideal_age_example_end(CS)
Deallocate any memory associated with this tracer package.
Definition: ideal_age_example.F90:455
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
mom_ocmip2_cfc::register_ocmip2_cfc
logical function, public register_ocmip2_cfc(HI, GV, param_file, CS, tr_Reg, restart_CS)
Register the OCMIP2 CFC tracers to be used with MOM and read the parameters that are used with this t...
Definition: MOM_OCMIP2_CFC.F90:93
mom_ale_sponge
This module contains the routines used to apply sponge layers when using the ALE mode.
Definition: MOM_ALE_sponge.F90:11
pseudo_salt_tracer
A tracer package that mimics salinity.
Definition: pseudo_salt_tracer.F90:2
mom_restart::mom_restart_cs
A restart registry and the control structure for restarts.
Definition: MOM_restart.F90:72
mom_ocmip2_cfc
Simulates CFCs using the OCMIP2 protocols.
Definition: MOM_OCMIP2_CFC.F90:2
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
advection_test_tracer::register_advection_test_tracer
logical function, public register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
Register tracer fields and subroutines to be used with MOM.
Definition: advection_test_tracer.F90:68
mom_get_input
Reads the only Fortran name list needed to boot-strap the model.
Definition: MOM_get_input.F90:6
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
user_tracer_example::user_initialize_tracer
subroutine, public user_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp)
This subroutine initializes the NTR tracer fields in tr(:,:,:,:) and it sets up the tracer output.
Definition: tracer_example.F90:141
ideal_age_example::ideal_age_tracer_cs
The control structure for the ideal_age_tracer package.
Definition: ideal_age_example.F90:38
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_generic_tracer
Definition: MOM_generic_tracer.F90:1
dome_tracer::dome_tracer_end
subroutine, public dome_tracer_end(CS)
Clean up memory allocations, if any.
Definition: DOME_tracer.F90:373
mom_forcing_type
This module implements boundary forcing for MOM6.
Definition: MOM_forcing_type.F90:2
mom_ocmip2_cfc::flux_init_ocmip2_cfc
subroutine, public flux_init_ocmip2_cfc(CS, verbosity)
This subroutine initializes the air-sea CFC fluxes, and optionally returns the indicies of these flux...
Definition: MOM_OCMIP2_CFC.F90:282
regional_dyes::regional_dyes_end
subroutine, public regional_dyes_end(CS)
Clean up any allocated memory after the run.
Definition: dye_example.F90:407
boundary_impulse_tracer::boundary_impulse_tracer_surface_state
subroutine, public boundary_impulse_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: boundary_impulse_tracer.F90:338
regional_dyes::register_dye_tracer
logical function, public register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS)
This subroutine is used to register tracer fields and subroutines to be used with MOM.
Definition: dye_example.F90:69
mom_verticalgrid::verticalgrid_type
Describes the vertical ocean grid, including unit conversion factors.
Definition: MOM_verticalGrid.F90:24
oil_tracer::oil_tracer_column_physics
subroutine, public oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, evap_CFL_limit, minimum_forcing_depth)
Apply sources, sinks, diapycnal mixing and rising motions to the oil tracers.
Definition: oil_tracer.F90:301
user_tracer_example::tracer_column_physics
subroutine, public tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS)
This subroutine applies diapycnal diffusion and any other column tracer physics or chemistry to the t...
Definition: tracer_example.F90:264
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
dyed_obc_tracer::dyed_obc_tracer_column_physics
subroutine, public dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, evap_CFL_limit, minimum_forcing_depth)
This subroutine applies diapycnal diffusion and any other column tracer physics or chemistry to the t...
Definition: dyed_obc_tracer.F90:205
mom_variables
Provides transparent structures with groups of MOM6 variables and supporting routines.
Definition: MOM_variables.F90:2
boundary_impulse_tracer::initialize_boundary_impulse_tracer
subroutine, public initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, tv)
Initialize tracer from restart or set to 1 at surface to initialize.
Definition: boundary_impulse_tracer.F90:153
oil_tracer::oil_tracer_end
subroutine, public oil_tracer_end(CS)
Deallocate memory associated with this tracer package.
Definition: oil_tracer.F90:489
ideal_age_example::register_ideal_age_tracer
logical function, public register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
Register the ideal age tracer fields to be used with MOM.
Definition: ideal_age_example.F90:73
mom_open_boundary
Controls where open boundary conditions are applied.
Definition: MOM_open_boundary.F90:2
advection_test_tracer::advection_test_tracer_end
subroutine, public advection_test_tracer_end(CS)
Deallocate memory associated with this module.
Definition: advection_test_tracer.F90:393
user_tracer_example::user_tracer_example_cs
The control structure for the USER_tracer_example module.
Definition: tracer_example.F90:35
mom_tracer_flow_control::tracer_flow_control_end
subroutine, public tracer_flow_control_end(CS)
Definition: MOM_tracer_flow_control.F90:787
dome_tracer
A tracer package that is used as a diagnostic in the DOME experiments.
Definition: DOME_tracer.F90:2
rgc_tracer::rgc_tracer_column_physics
subroutine, public rgc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, evap_CFL_limit, minimum_forcing_depth)
This subroutine applies diapycnal diffusion and any other column tracer physics or chemistry to the t...
Definition: RGC_tracer.F90:278
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
dyed_obc_tracer::register_dyed_obc_tracer
logical function, public register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
Register tracer fields and subroutines to be used with MOM.
Definition: dyed_obc_tracer.F90:55
regional_dyes::dye_stock
integer function, public dye_stock(h, stocks, G, GV, CS, names, units, stock_index)
This function calculates the mass-weighted integral of all tracer stocks, returning the number of sto...
Definition: dye_example.F90:329
dome_tracer::register_dome_tracer
logical function, public register_dome_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
Register tracer fields and subroutines to be used with MOM.
Definition: DOME_tracer.F90:64
advection_test_tracer
This tracer package is used to test advection schemes.
Definition: advection_test_tracer.F90:2
mom_tracer_flow_control
Orchestrates the registration and calling of tracer packages.
Definition: MOM_tracer_flow_control.F90:2
mom_get_input::get_mom_input
subroutine, public get_mom_input(param_file, dirs, check_params, default_input_filename, ensemble_num)
Get the names of the I/O directories and initialization file. Also calls the subroutine that opens ru...
Definition: MOM_get_input.F90:34
user_tracer_example
A sample tracer package that has striped initial conditions.
Definition: tracer_example.F90:2
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_ocmip2_cfc::initialize_ocmip2_cfc
subroutine, public initialize_ocmip2_cfc(restart, day, G, GV, US, h, diag, OBC, CS, sponge_CSp)
Initialize the OCMP2 CFC tracer fields and set up the tracer output.
Definition: MOM_OCMIP2_CFC.F90:317
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
isomip_tracer::register_isomip_tracer
logical function, public register_isomip_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
This subroutine is used to register tracer fields.
Definition: ISOMIP_tracer.F90:69
isomip_tracer::isomip_tracer_cs
ISOMIP tracer package control structure.
Definition: ISOMIP_tracer.F90:45
mom_unit_scaling
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Definition: MOM_unit_scaling.F90:2
regional_dyes::dye_tracer_cs
The control structure for the regional dyes tracer package.
Definition: dye_example.F90:41
mom_tracer_flow_control::tracer_flow_control_cs
The control structure for orchestrating the calling of tracer packages.
Definition: MOM_tracer_flow_control.F90:75
rgc_tracer::rgc_tracer_cs
tracer control structure
Definition: RGC_tracer.F90:45
mom_file_parser::close_param_file
subroutine, public close_param_file(CS, quiet_close, component)
Close any open input files and deallocate memory associated with this param_file_type....
Definition: MOM_file_parser.F90:242
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_ocmip2_cfc::ocmip2_cfc_surface_state
subroutine, public ocmip2_cfc_surface_state(state, h, G, CS)
This subroutine extracts the surface CFC concentrations and other fields that are shared with the atm...
Definition: MOM_OCMIP2_CFC.F90:546
boundary_impulse_tracer::boundary_impulse_stock
integer function, public boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index)
Calculate total inventory of tracer.
Definition: boundary_impulse_tracer.F90:287
mom_tracer_flow_control::call_tracer_stocks
subroutine, public call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_units, num_stocks, stock_index, got_min_max, global_min, global_max, xgmin, ygmin, zgmin, xgmax, ygmax, zgmax)
This subroutine calls all registered tracer packages to enable them to add to the surface state retur...
Definition: MOM_tracer_flow_control.F90:568
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
oil_tracer
A tracer package to mimic dissolved oil.
Definition: oil_tracer.F90:2
ideal_age_example::initialize_ideal_age_tracer
subroutine, public initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS, sponge_CSp)
Sets the ideal age traces to their initial values and sets up the tracer output.
Definition: ideal_age_example.F90:198
pseudo_salt_tracer::pseudo_salt_tracer_cs
The control structure for the pseudo-salt tracer.
Definition: pseudo_salt_tracer.F90:39
oil_tracer::oil_stock
integer function, public oil_stock(h, stocks, G, GV, CS, names, units, stock_index)
Calculate the mass-weighted integral of the oil tracer stocks, returning the number of stocks it has ...
Definition: oil_tracer.F90:408
dome_tracer::dome_tracer_cs
The DOME_tracer control structure.
Definition: DOME_tracer.F90:42
isomip_tracer::isomip_tracer_end
subroutine, public isomip_tracer_end(CS)
Deallocate any memory used by the ISOMIP tracer package.
Definition: ISOMIP_tracer.F90:361
rgc_tracer::register_rgc_tracer
logical function, public register_rgc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
This subroutine is used to register tracer fields.
Definition: RGC_tracer.F90:68
advection_test_tracer::advection_test_stock
integer function, public advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index)
Calculate the mass-weighted integral of all tracer stocks, returning the number of stocks it has calc...
Definition: advection_test_tracer.F90:352
isomip_tracer::isomip_tracer_surface_state
subroutine, public isomip_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: ISOMIP_tracer.F90:330
dyed_obc_tracer::dyed_obc_tracer_end
subroutine, public dyed_obc_tracer_end(CS)
Clean up memory allocations, if any.
Definition: dyed_obc_tracer.F90:259
rgc_tracer::rgc_tracer_end
subroutine, public rgc_tracer_end(CS)
Definition: RGC_tracer.F90:343
regional_dyes::dye_tracer_surface_state
subroutine, public dye_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: dye_example.F90:376
oil_tracer::initialize_oil_tracer
subroutine, public initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS, sponge_CSp)
Initialize the oil tracers and set up tracer output.
Definition: oil_tracer.F90:206
isomip_tracer
Routines used to set up and use a set of (one for now) dynamically passive tracers in the ISOMIP conf...
Definition: ISOMIP_tracer.F90:6
boundary_impulse_tracer::register_boundary_impulse_tracer
logical function, public register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
Read in runtime options and add boundary impulse tracer to tracer registry.
Definition: boundary_impulse_tracer.F90:67
mom_tracer_flow_control::store_stocks
subroutine store_stocks(pkg_name, ns, names, units, values, index, stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
This routine stores the stocks and does error handling for call_tracer_stocks.
Definition: MOM_tracer_flow_control.F90:692
isomip_tracer::initialize_isomip_tracer
subroutine, public initialize_isomip_tracer(restart, day, G, GV, h, diag, OBC, CS, ALE_sponge_CSp)
Initializes the NTR tracer fields in tr(:,:,:,:)
Definition: ISOMIP_tracer.F90:150
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
ideal_age_example::ideal_age_tracer_column_physics
subroutine, public ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, evap_CFL_limit, minimum_forcing_depth)
Applies diapycnal diffusion, aging and regeneration at the surface to the ideal age tracers.
Definition: ideal_age_example.F90:286
mom_ocmip2_cfc::ocmip2_cfc_cs
The control structure for the OCMPI2_CFC tracer package.
Definition: MOM_OCMIP2_CFC.F90:40
mom_tracer_flow_control::call_tracer_set_forcing
subroutine, public call_tracer_set_forcing(state, fluxes, day_start, day_interval, G, CS)
This subroutine calls the individual tracer modules' subroutines to specify or read quantities relate...
Definition: MOM_tracer_flow_control.F90:382
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
mom_tracer_flow_control::call_tracer_register
subroutine, public call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS)
This subroutine determines which tracer packages are to be used and does the calls to register their ...
Definition: MOM_tracer_flow_control.F90:152