MOM_tracer_flow_control.F90

1! This file is part of MOM6, the Modular Ocean Model version 6.
2! See the LICENSE file for licensing information.
3! SPDX-License-Identifier: Apache-2.0
4
5!> Orchestrates the registration and calling of tracer packages
7
8use mom_coms, only : efp_type, assignment(=), efp_to_real, real_to_efp, efp_sum_across_pes
9use mom_diag_mediator, only : time_type, diag_ctrl
10use mom_error_handler, only : mom_error, fatal, warning
11use mom_file_parser, only : get_param, log_version, param_file_type, close_param_file
12use mom_forcing_type, only : forcing, optics_type
14use mom_grid, only : ocean_grid_type
17use mom_cvmix_kpp, only : kpp_cs
20use mom_sponge, only : sponge_cs
22use mom_tracer_registry, only : tracer_registry_type
26#include <MOM_memory.h>
27
28! Add references to other user-provide tracer modules here.
80
81implicit none ; private
82
87
88!> The control structure for orchestrating the calling of tracer packages
89type, public :: tracer_flow_control_cs ; private
90 logical :: use_user_tracer_example = .false. !< If true, use the USER_tracer_example package
91 logical :: use_dome_tracer = .false. !< If true, use the DOME_tracer package
92 logical :: use_isomip_tracer = .false. !< If true, use the ISOMPE_tracer package
93 logical :: use_rgc_tracer =.false. !< If true, use the RGC_tracer package
94 logical :: use_ideal_age = .false. !< If true, use the ideal age tracer package
95 logical :: use_marbl_tracers = .false. !< If true, use the MARBL tracer package
96 logical :: use_regional_dyes = .false. !< If true, use the regional dyes tracer package
97 logical :: use_oil = .false. !< If true, use the oil tracer package
98 logical :: use_advection_test_tracer = .false. !< If true, use the advection_test_tracer package
99 logical :: use_ocmip2_cfc = .false. !< If true, use the OCMIP2_CFC tracer package
100 logical :: use_cfc_cap = .false. !< If true, use the CFC_cap tracer package
101 logical :: use_mom_generic_tracer = .false. !< If true, use the MOM_generic_tracer packages
102 logical :: use_pseudo_salt_tracer = .false. !< If true, use the psuedo_salt tracer package
103 logical :: use_boundary_impulse_tracer = .false. !< If true, use the boundary impulse tracer package
104 logical :: use_dyed_obc_tracer = .false. !< If true, use the dyed OBC tracer package
105 logical :: use_nw2_tracers = .false. !< If true, use the NW2 tracer package
106 logical :: get_chl_from_marbl = .false. !< If true, use the MARBL-provided Chl for shortwave penetration
107 !>@{ Pointers to the control strucures for the tracer packages
108 type(user_tracer_example_cs), pointer :: user_tracer_example_csp => null()
109 type(dome_tracer_cs), pointer :: dome_tracer_csp => null()
110 type(isomip_tracer_cs), pointer :: isomip_tracer_csp => null()
111 type(rgc_tracer_cs), pointer :: rgc_tracer_csp => null()
112 type(ideal_age_tracer_cs), pointer :: ideal_age_tracer_csp => null()
113 type(marbl_tracers_cs), pointer :: marbl_tracers_csp => null()
114 type(dye_tracer_cs), pointer :: dye_tracer_csp => null()
115 type(oil_tracer_cs), pointer :: oil_tracer_csp => null()
116 type(advection_test_tracer_cs), pointer :: advection_test_tracer_csp => null()
117 type(ocmip2_cfc_cs), pointer :: ocmip2_cfc_csp => null()
118 type(cfc_cap_cs), pointer :: cfc_cap_csp => null()
119 type(mom_generic_tracer_cs), pointer :: mom_generic_tracer_csp => null()
120 type(pseudo_salt_tracer_cs), pointer :: pseudo_salt_tracer_csp => null()
121 type(boundary_impulse_tracer_cs), pointer :: boundary_impulse_tracer_csp => null()
122 type(dyed_obc_tracer_cs), pointer :: dyed_obc_tracer_csp => null()
123 type(nw2_tracers_cs), pointer :: nw2_tracers_csp => null()
124 !>@}
126
127contains
128
129
130!> This subroutine carries out a series of calls to initialize the air-sea
131!! tracer fluxes, but it does not record the generated indicies, and it may
132!! be called _before_ the ocean model has been initialized and may be called
133!! on non-ocean PEs. It is not necessary to call this routine for ocean-only
134!! runs, because the same calls are made again inside of the routines called by
135!! call_tracer_register
136subroutine call_tracer_flux_init(verbosity)
137 integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity.
138
139 type(param_file_type) :: param_file ! A structure to parse for run-time parameters
140 character(len=40) :: mdl = "call_tracer_flux_init" ! This module's name.
141 logical :: use_ocmip_cfcs, use_mom_generic_tracer
142
143 ! Determine which tracer routines with tracer fluxes are to be called. Note
144 ! that not every tracer package is required to have a flux_init call.
145 call get_mom_input(param_file, check_params=.false.)
146
147 call get_param(param_file, mdl, "USE_OCMIP2_CFC", use_ocmip_cfcs, &
148 default=.false., do_not_log=.true.)
149 call get_param(param_file, mdl, "USE_generic_tracer", use_mom_generic_tracer,&
150 default=.false., do_not_log=.true.)
151 call close_param_file(param_file, quiet_close=.true.)
152
153 if (use_ocmip_cfcs) call flux_init_ocmip2_cfc(verbosity=verbosity)
154 if (use_mom_generic_tracer) then
155 call mom_generic_flux_init(verbosity=verbosity)
156 endif
157
158end subroutine call_tracer_flux_init
159
160! The following 5 subroutines and associated definitions provide the machinery to register and call
161! the subroutines that initialize tracers and apply vertical column processes to tracers.
162
163!> This subroutine determines which tracer packages are to be used and does the calls to
164!! register their tracers to be advected, diffused, and read from restarts.
165subroutine call_tracer_register(G, GV, US, param_file, CS, tr_Reg, restart_CS)
166 type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
167 type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
168 type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
169 type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
170 !! parameters.
171 type(tracer_flow_control_cs), pointer :: cs !< A pointer that is set to point to the
172 !! control structure for this module.
173 type(tracer_registry_type), pointer :: tr_reg !< A pointer that is set to point to the
174 !! control structure for the tracer
175 !! advection and diffusion module.
176 type(mom_restart_cs), intent(inout) :: restart_cs !< A pointer to the restart control
177 !! structure.
178
179 ! This include declares and sets the variable "version".
180# include "version_variable.h"
181 character(len=40) :: mdl = "MOM_tracer_flow_control" ! This module's name.
182
183 if (associated(cs)) then
184 call mom_error(warning, "call_tracer_register called with an associated "// &
185 "control structure.")
186 return
187 else ; allocate(cs) ; endif
188
189 ! Read all relevant parameters and write them to the model log.
190 call log_version(param_file, mdl, version, "")
191 call get_param(param_file, mdl, "USE_USER_TRACER_EXAMPLE", cs%use_USER_tracer_example, &
192 "If true, use the USER_tracer_example tracer package.", &
193 default=.false.)
194 call get_param(param_file, mdl, "USE_DOME_TRACER", cs%use_DOME_tracer, &
195 "If true, use the DOME_tracer tracer package.", &
196 default=.false.)
197 call get_param(param_file, mdl, "USE_ISOMIP_TRACER", cs%use_ISOMIP_tracer, &
198 "If true, use the ISOMIP_tracer tracer package.", &
199 default=.false.)
200 call get_param(param_file, mdl, "USE_RGC_TRACER", cs%use_RGC_tracer, &
201 "If true, use the RGC_tracer tracer package.", &
202 default=.false.)
203 call get_param(param_file, mdl, "USE_IDEAL_AGE_TRACER", cs%use_ideal_age, &
204 "If true, use the ideal_age_example tracer package.", &
205 default=.false.)
206 call get_param(param_file, mdl, "USE_MARBL_TRACERS", cs%use_MARBL_tracers, &
207 "If true, use the MARBL tracer package.", &
208 default=.false.)
209 call get_param(param_file, mdl, "USE_REGIONAL_DYES", cs%use_regional_dyes, &
210 "If true, use the regional_dyes tracer package.", &
211 default=.false.)
212 call get_param(param_file, mdl, "USE_OIL_TRACER", cs%use_oil, &
213 "If true, use the oil_tracer tracer package.", &
214 default=.false.)
215 call get_param(param_file, mdl, "USE_ADVECTION_TEST_TRACER", cs%use_advection_test_tracer, &
216 "If true, use the advection_test_tracer tracer package.", &
217 default=.false.)
218 call get_param(param_file, mdl, "USE_OCMIP2_CFC", cs%use_OCMIP2_CFC, &
219 "If true, use the MOM_OCMIP2_CFC tracer package.", &
220 default=.false.)
221 call get_param(param_file, mdl, "USE_CFC_CAP", cs%use_CFC_cap, &
222 "If true, use the MOM_CFC_cap tracer package.", &
223 default=.false.)
224 call get_param(param_file, mdl, "USE_generic_tracer", cs%use_MOM_generic_tracer, &
225 "If true and _USE_GENERIC_TRACER is defined as a "//&
226 "preprocessor macro, use the MOM_generic_tracer packages.", &
227 default=.false.)
228 call get_param(param_file, mdl, "USE_PSEUDO_SALT_TRACER", cs%use_pseudo_salt_tracer, &
229 "If true, use the pseudo salt tracer, typically run as a diagnostic.", &
230 default=.false.)
231 call get_param(param_file, mdl, "USE_BOUNDARY_IMPULSE_TRACER", cs%use_boundary_impulse_tracer, &
232 "If true, use the boundary impulse tracer.", &
233 default=.false.)
234 call get_param(param_file, mdl, "USE_DYED_OBC_TRACER", cs%use_dyed_obc_tracer, &
235 "If true, use the dyed_obc_tracer tracer package.", &
236 default=.false.)
237 call get_param(param_file, mdl, "USE_NW2_TRACERS", cs%use_nw2_tracers, &
238 "If true, use the NeverWorld2 tracers.", &
239 default=.false.)
240
241! Add other user-provided calls to register tracers for restarting here. Each
242! tracer package registration call returns a logical false if it cannot be run
243! for some reason. This then overrides the run-time selection from above.
244 if (cs%use_USER_tracer_example) cs%use_USER_tracer_example = &
245 user_register_tracer_example(g, gv, us, param_file, cs%USER_tracer_example_CSp, &
246 tr_reg, restart_cs)
247 if (cs%use_DOME_tracer) cs%use_DOME_tracer = &
248 register_dome_tracer(g, gv, us, param_file, cs%DOME_tracer_CSp, &
249 tr_reg, restart_cs)
250 if (cs%use_ISOMIP_tracer) cs%use_ISOMIP_tracer = &
251 register_isomip_tracer(g%HI, gv, param_file, cs%ISOMIP_tracer_CSp, &
252 tr_reg, restart_cs)
253 if (cs%use_RGC_tracer) cs%use_RGC_tracer = &
254 register_rgc_tracer(g, gv, param_file, cs%RGC_tracer_CSp, &
255 tr_reg, restart_cs)
256 if (cs%use_ideal_age) cs%use_ideal_age = &
257 register_ideal_age_tracer(g%HI, gv, param_file, cs%ideal_age_tracer_CSp, &
258 tr_reg, restart_cs)
259 if (cs%use_MARBL_tracers) cs%use_MARBL_tracers = &
260 register_marbl_tracers(g%HI, gv, us, param_file, cs%MARBL_tracers_CSp, &
261 tr_reg, restart_cs, cs%get_chl_from_MARBL)
262 if (cs%use_regional_dyes) cs%use_regional_dyes = &
263 register_dye_tracer(g%HI, gv, us, param_file, cs%dye_tracer_CSp, &
264 tr_reg, restart_cs)
265 if (cs%use_oil) cs%use_oil = &
266 register_oil_tracer(g%HI, gv, us, param_file, cs%oil_tracer_CSp, &
267 tr_reg, restart_cs)
268 if (cs%use_advection_test_tracer) cs%use_advection_test_tracer = &
269 register_advection_test_tracer(g, gv, param_file, cs%advection_test_tracer_CSp, &
270 tr_reg, restart_cs)
271 if (cs%use_OCMIP2_CFC) cs%use_OCMIP2_CFC = &
272 register_ocmip2_cfc(g%HI, gv, param_file, cs%OCMIP2_CFC_CSp, &
273 tr_reg, restart_cs)
274 if (cs%use_CFC_cap) cs%use_CFC_cap = &
275 register_cfc_cap(g%HI, gv, param_file, cs%CFC_cap_CSp, &
276 tr_reg, restart_cs)
277 if (cs%use_MOM_generic_tracer) cs%use_MOM_generic_tracer = &
278 register_mom_generic_tracer(g%HI, gv, param_file, cs%MOM_generic_tracer_CSp, &
279 tr_reg, restart_cs)
280 if (cs%use_pseudo_salt_tracer) cs%use_pseudo_salt_tracer = &
281 register_pseudo_salt_tracer(g%HI, gv, param_file, cs%pseudo_salt_tracer_CSp, &
282 tr_reg, restart_cs)
283 if (cs%use_boundary_impulse_tracer) cs%use_boundary_impulse_tracer = &
284 register_boundary_impulse_tracer(g%HI, gv, us, param_file, cs%boundary_impulse_tracer_CSp, &
285 tr_reg, restart_cs)
286 if (cs%use_dyed_obc_tracer) cs%use_dyed_obc_tracer = &
287 register_dyed_obc_tracer(g%HI, gv, param_file, cs%dyed_obc_tracer_CSp, &
288 tr_reg, restart_cs)
289 if (cs%use_nw2_tracers) cs%use_nw2_tracers = &
290 register_nw2_tracers(g%HI, gv, us, param_file, cs%nw2_tracers_CSp, tr_reg, restart_cs)
291
292end subroutine call_tracer_register
293
294!> This subroutine calls all registered tracer initialization
295!! subroutines.
296subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag, OBC, &
297 CS, sponge_CSp, ALE_sponge_CSp, tv)
298 logical, intent(in) :: restart !< 1 if the fields have already
299 !! been read from a restart file.
300 type(time_type), target, intent(in) :: day !< Time of the start of the run.
301 type(ocean_grid_type), intent(inout) :: g !< The ocean's grid structure.
302 type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid
303 !! structure.
304 type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
305 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
306 intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
307 type(param_file_type), intent(in) :: param_file !< A structure to parse for
308 !! run-time parameters
309 type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to
310 !! regulate diagnostic output.
311 type(ocean_obc_type), pointer :: obc !< This open boundary condition
312 !! type specifies whether, where,
313 !! and what open boundary
314 !! conditions are used.
315 type(tracer_flow_control_cs), pointer :: cs !< The control structure returned
316 !! by a previous call to
317 !! call_tracer_register.
318 type(sponge_cs), pointer :: sponge_csp !< A pointer to the control
319 !! structure for the sponges, if they are in use.
320 !! Otherwise this may be unassociated.
321 type(ale_sponge_cs), pointer :: ale_sponge_csp !< A pointer to the control
322 !! structure for the ALE sponges, if they are in use.
323 !! Otherwise this may be unassociated.
324 type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
325 !! thermodynamic variables
326
327 if (.not. associated(cs)) call mom_error(fatal, "tracer_flow_control_init: "// &
328 "Module must be initialized via call_tracer_register before it is used.")
329
330! Add other user-provided calls here.
331 if (cs%use_USER_tracer_example) &
332 call user_initialize_tracer(restart, day, g, gv, us, h, diag, obc, cs%USER_tracer_example_CSp, &
333 sponge_csp)
334 if (cs%use_DOME_tracer) &
335 call initialize_dome_tracer(restart, day, g, gv, us, h, diag, obc, cs%DOME_tracer_CSp, &
336 sponge_csp, tv)
337 if (cs%use_ISOMIP_tracer) &
338 call initialize_isomip_tracer(restart, day, g, gv, h, diag, obc, cs%ISOMIP_tracer_CSp, &
339 ale_sponge_csp)
340 if (cs%use_RGC_tracer) &
341 call initialize_rgc_tracer(restart, day, g, gv, h, diag, obc, cs%RGC_tracer_CSp, &
342 sponge_csp, ale_sponge_csp)
343 if (cs%use_ideal_age) &
344 call initialize_ideal_age_tracer(restart, day, g, gv, us, h, diag, obc, cs%ideal_age_tracer_CSp, &
345 sponge_csp)
346 if (cs%use_MARBL_tracers) &
347 call initialize_marbl_tracers(restart, day, g, gv, us, h, param_file, diag, obc, cs%MARBL_tracers_CSp, &
348 sponge_csp)
349 if (cs%use_regional_dyes) &
350 call initialize_dye_tracer(restart, day, g, gv, us, h, diag, obc, cs%dye_tracer_CSp, sponge_csp, tv)
351 if (cs%use_oil) &
352 call initialize_oil_tracer(restart, day, g, gv, us, h, diag, obc, cs%oil_tracer_CSp, sponge_csp)
353 if (cs%use_advection_test_tracer) &
354 call initialize_advection_test_tracer(restart, day, g, gv, h, diag, obc, cs%advection_test_tracer_CSp, &
355 sponge_csp)
356 if (cs%use_OCMIP2_CFC) &
357 call initialize_ocmip2_cfc(restart, day, g, gv, us, h, diag, obc, cs%OCMIP2_CFC_CSp, sponge_csp)
358 if (cs%use_CFC_cap) &
359 call initialize_cfc_cap(restart, day, g, gv, us, h, diag, obc, cs%CFC_cap_CSp)
360
361 if (cs%use_MOM_generic_tracer) &
362 call initialize_mom_generic_tracer(restart, day, g, gv, us, h, tv, param_file, diag, obc, &
363 cs%MOM_generic_tracer_CSp, sponge_csp, ale_sponge_csp)
364 if (cs%use_pseudo_salt_tracer) &
365 call initialize_pseudo_salt_tracer(restart, day, g, gv, us, h, diag, obc, cs%pseudo_salt_tracer_CSp, &
366 sponge_csp, tv)
367 if (cs%use_boundary_impulse_tracer) &
368 call initialize_boundary_impulse_tracer(restart, day, g, gv, us, h, diag, obc, cs%boundary_impulse_tracer_CSp, &
369 sponge_csp, tv)
370 if (cs%use_dyed_obc_tracer) &
371 call initialize_dyed_obc_tracer(restart, day, g, gv, h, diag, obc, cs%dyed_obc_tracer_CSp)
372 if (cs%use_nw2_tracers) &
373 call initialize_nw2_tracers(restart, day, g, gv, us, h, tv, diag, cs%nw2_tracers_CSp)
374
375end subroutine tracer_flow_control_init
376
377!> This subroutine calls all registered tracers to register their OBC segments
378!! similar to register_temp_salt_segments for T&S
379subroutine call_tracer_register_obc_segments(GV, param_file, CS, tr_Reg, OBC)
380 type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
381 type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
382 !! parameters.
383 type(tracer_flow_control_cs), pointer :: cs !< A pointer that is set to point to the
384 !! control structure for this module.
385 type(tracer_registry_type), pointer :: tr_reg !< A pointer that is set to point to the
386 !! control structure for the tracer
387 !! advection and diffusion module.
388 type(ocean_obc_type), pointer :: obc !< This open boundary condition
389 !! type specifies whether, where,
390 !! and what open boundary
391 !! conditions are used.
392
393 if (cs%use_MOM_generic_tracer) &
394 call register_mom_generic_tracer_segments(cs%MOM_generic_tracer_CSp, gv, obc, tr_reg, param_file)
395
397
398!> This subroutine extracts the chlorophyll concentrations from the model state, if possible
399subroutine get_chl_from_model(Chl_array, G, GV, CS)
400 type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
401 type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
402 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
403 intent(out) :: chl_array !< The array in which to store the model's
404 !! Chlorophyll-A concentrations [mg m-3].
405 type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by a
406 !! previous call to call_tracer_register.
407
408 if (cs%get_chl_from_MARBL) then
409 call marbl_tracers_get('Chl', g, gv, chl_array, cs%MARBL_tracers_CSp)
410 elseif (cs%use_MOM_generic_tracer) then
411 call mom_generic_tracer_get('chl', 'field', chl_array, cs%MOM_generic_tracer_CSp)
412 else
413 call mom_error(fatal, "get_chl_from_model was called in a configuration "// &
414 "that is unable to provide a sensible model-based value.\n"// &
415 "CS%use_MOM_generic_tracer is false and no other viable options are on.")
416 endif
417
418end subroutine get_chl_from_model
419
420!> Returns pointers or values of members within the tracer_flow_control_CS type. For extensibility,
421!! each returned argument is an optional argument
422subroutine extract_tracer_flow_member(CS, use_MARBL_tracers)
423 type(tracer_flow_control_cs), target, intent(in) :: cs !< module control structure
424 ! All output arguments are optional
425 logical, optional, intent(out) :: use_marbl_tracers !< If true, MARBL tracers are active
426
427 ! Constants within tracer_flow_control_CS
428 if (present(use_marbl_tracers)) use_marbl_tracers = cs%use_MARBL_tracers
429end subroutine extract_tracer_flow_member
430
431!> This subroutine calls the individual tracer modules' subroutines to
432!! specify or read quantities related to their surface forcing.
433subroutine call_tracer_set_forcing(sfc_state, fluxes, day_start, day_interval, G, US, Rho0, CS)
434
435 type(surface), intent(inout) :: sfc_state !< A structure containing fields that
436 !! describe the surface state of the
437 !! ocean.
438 type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any
439 !! possible forcing fields. Unused fields
440 !! have NULL ptrs.
441 type(time_type), intent(in) :: day_start !< Start time of the fluxes.
442 type(time_type), intent(in) :: day_interval !< Length of time over which these
443 !! fluxes will be applied.
444 type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
445 type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
446 real, intent(in) :: rho0 !< The mean ocean density [R ~> kg m-3]
447 type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by a
448 !! previous call to call_tracer_register.
449
450 if (.not. associated(cs)) call mom_error(fatal, "call_tracer_set_forcing: "// &
451 "Module must be initialized via call_tracer_register before it is used.")
452! if (CS%use_ideal_age) &
453! call ideal_age_tracer_set_forcing(sfc_state, fluxes, day_start, day_interval, &
454! G, CS%ideal_age_tracer_CSp)
455 if (cs%use_CFC_cap) &
456 call cfc_cap_set_forcing(sfc_state, fluxes, day_start, day_interval, g, us, rho0, &
457 cs%CFC_cap_CSp)
458
459 if (cs%use_MARBL_tracers) &
460 call marbl_tracers_set_forcing(day_start, g, cs%MARBL_tracers_CSp)
461
462end subroutine call_tracer_set_forcing
463
464!> This subroutine calls all registered tracer column physics subroutines.
465subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, mld, dt, G, GV, US, tv, optics, CS, &
466 debug, KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth, &
467 h_BL, prediabatic_T, prediabatic_S)
468 type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
469 type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
470 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Layer thickness before entrainment
471 !! [H ~> m or kg m-2].
472 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Layer thickness after entrainment
473 !! [H ~> m or kg m-2].
474 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: ea !< an array to which the amount of
475 !! fluid entrained from the layer above during this call
476 !! will be added [H ~> m or kg m-2].
477 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< an array to which the amount of
478 !! fluid entrained from the layer below during this call
479 !! will be added [H ~> m or kg m-2].
480 type(forcing), intent(in) :: fluxes !< A structure containing pointers to
481 !! any possible forcing fields.
482 !! Unused fields have NULL ptrs.
483 real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mld !< Mixed layer depth [Z ~> m]
484 real, intent(in) :: dt !< The amount of time covered by this
485 !! call [T ~> s]
486 type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
487 type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
488 !! thermodynamic variables.
489 type(optics_type), pointer :: optics !< The structure containing optical
490 !! properties.
491 type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by
492 !! a previous call to
493 !! call_tracer_register.
494 logical, intent(in) :: debug !< If true calculate checksums
495 type(kpp_cs), optional, pointer :: kpp_csp !< KPP control structure
496 real, optional, intent(in) :: nonlocaltrans(:,:,:) !< Non-local transport [nondim]
497 real, optional, intent(in) :: evap_cfl_limit !< Limit on the fraction of
498 !! the water that can be fluxed out
499 !! of the top layer in a timestep [nondim]
500 real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over
501 !! which fluxes can be applied [H ~> m or kg m-2]
502 real, dimension(:,:), optional, pointer :: h_bl !< Thickness of active mixing layer [H ~> m or kg m-2]
503 real, dimension(:,:,:), optional, intent(in) :: prediabatic_t !< Temperature prior to calling
504 !! diabatic driver [C ~> degC]
505 real, dimension(:,:,:), optional, intent(in) :: prediabatic_s !< Salinity prior to calling
506 !! diabatic driver [S ~> ppt]
507
508 ! Local variables
509 real :: hbl(szi_(g),szj_(g)) !< Boundary layer thickness [H ~> m or kg m-2]
510 logical :: use_h_bl
511
512 if (.not. associated(cs)) call mom_error(fatal, "call_tracer_column_fns: "// &
513 "Module must be initialized via call_tracer_register before it is used.")
514
515 ! Use the applyTracerBoundaryFluxesInOut to handle surface fluxes
516 if (present(evap_cfl_limit) .and. present(minimum_forcing_depth)) then
517 ! Add calls to tracer column functions here.
518 if (cs%use_USER_tracer_example) &
519 call tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
520 g, gv, us, cs%USER_tracer_example_CSp)
521 if (cs%use_DOME_tracer) &
522 call dome_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
523 g, gv, us, cs%DOME_tracer_CSp, &
524 evap_cfl_limit=evap_cfl_limit, &
525 minimum_forcing_depth=minimum_forcing_depth)
526 if (cs%use_ISOMIP_tracer) &
527 call isomip_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
528 g, gv, us, cs%ISOMIP_tracer_CSp, &
529 evap_cfl_limit=evap_cfl_limit, &
530 minimum_forcing_depth=minimum_forcing_depth)
531 if (cs%use_RGC_tracer) &
532 call rgc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
533 g, gv, us, cs%RGC_tracer_CSp, &
534 evap_cfl_limit=evap_cfl_limit, &
535 minimum_forcing_depth=minimum_forcing_depth)
536 if (cs%use_ideal_age) then
537 use_h_bl = .false. ; if (present(h_bl)) use_h_bl = associated(h_bl)
538 if (present(h_bl)) then
539 hbl(:,:) = h_bl(:,:)
540 else ! This option is here mostly to support the offline tracers.
541 call convert_mld_to_ml_thickness(mld, h_new, hbl, tv, g, gv)
542 endif
543 call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
544 g, gv, us, cs%ideal_age_tracer_CSp, &
545 evap_cfl_limit=evap_cfl_limit, &
546 minimum_forcing_depth=minimum_forcing_depth, hbl=hbl)
547 endif
548 if (cs%use_MARBL_tracers) then
549 if ((.not. present(prediabatic_t)) .or. (.not. present(prediabatic_s))) &
550 call mom_error(fatal, 'Must pass prediabatic_T and prediabatic_S when using MARBL')
551 call marbl_tracers_column_physics(h_old, ea, eb, fluxes, dt, &
552 g, gv, us, cs%MARBL_tracers_CSp, &
553 prediabatic_t, prediabatic_s, &
554 kpp_csp=kpp_csp, &
555 nonlocaltrans=nonlocaltrans, &
556 evap_cfl_limit=evap_cfl_limit, &
557 minimum_forcing_depth=minimum_forcing_depth)
558 endif
559 if (cs%use_regional_dyes) &
560 call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
561 g, gv, us, tv, cs%dye_tracer_CSp, &
562 evap_cfl_limit=evap_cfl_limit, &
563 minimum_forcing_depth=minimum_forcing_depth)
564 if (cs%use_oil) &
565 call oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
566 g, gv, us, cs%oil_tracer_CSp, tv, &
567 evap_cfl_limit=evap_cfl_limit, &
568 minimum_forcing_depth=minimum_forcing_depth)
569
570 if (cs%use_advection_test_tracer) &
571 call advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
572 g, gv, us, cs%advection_test_tracer_CSp, &
573 evap_cfl_limit=evap_cfl_limit, &
574 minimum_forcing_depth=minimum_forcing_depth)
575 if (cs%use_OCMIP2_CFC) &
576 call ocmip2_cfc_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
577 g, gv, us, cs%OCMIP2_CFC_CSp, &
578 evap_cfl_limit=evap_cfl_limit, &
579 minimum_forcing_depth=minimum_forcing_depth)
580 if (cs%use_CFC_cap) &
581 call cfc_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
582 g, gv, us, cs%CFC_cap_CSp, &
583 kpp_csp=kpp_csp, &
584 nonlocaltrans=nonlocaltrans, &
585 evap_cfl_limit=evap_cfl_limit, &
586 minimum_forcing_depth=minimum_forcing_depth)
587 if (cs%use_MOM_generic_tracer) then
588 if (us%QRZ_T_to_W_m2 /= 1.0) call mom_error(fatal, "MOM_generic_tracer_column_physics "//&
589 "has not been written to permit dimensionsal rescaling. Set all 4 of the "//&
590 "[QRZT]_RESCALE_POWER parameters to 0.")
591 call mom_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, mld, dt, &
592 g, gv, us, cs%MOM_generic_tracer_CSp, tv, optics, &
593 evap_cfl_limit=evap_cfl_limit, &
594 minimum_forcing_depth=minimum_forcing_depth)
595 endif
596 if (cs%use_pseudo_salt_tracer) &
597 call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
598 g, gv, us, cs%pseudo_salt_tracer_CSp, tv, &
599 debug, &
600 kpp_csp=kpp_csp, &
601 nonlocaltrans=nonlocaltrans, &
602 evap_cfl_limit=evap_cfl_limit, &
603 minimum_forcing_depth=minimum_forcing_depth)
604 if (cs%use_boundary_impulse_tracer) &
605 call boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
606 g, gv, us, cs%boundary_impulse_tracer_CSp, tv, debug, &
607 evap_cfl_limit=evap_cfl_limit, &
608 minimum_forcing_depth=minimum_forcing_depth)
609 if (cs%use_dyed_obc_tracer) &
610 call dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
611 g, gv, us, cs%dyed_obc_tracer_CSp, &
612 evap_cfl_limit=evap_cfl_limit, &
613 minimum_forcing_depth=minimum_forcing_depth)
614 if (cs%use_nw2_tracers) &
615 call nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
616 g, gv, us, tv, cs%nw2_tracers_CSp, &
617 evap_cfl_limit=evap_cfl_limit, &
618 minimum_forcing_depth=minimum_forcing_depth)
619 else ! Apply tracer surface fluxes using ea on the first layer
620 if (cs%use_USER_tracer_example) &
621 call tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
622 g, gv, us, cs%USER_tracer_example_CSp)
623 if (cs%use_DOME_tracer) &
624 call dome_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
625 g, gv, us, cs%DOME_tracer_CSp)
626 if (cs%use_ISOMIP_tracer) &
627 call isomip_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
628 g, gv, us, cs%ISOMIP_tracer_CSp)
629 if (cs%use_RGC_tracer) &
630 call rgc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
631 g, gv, us, cs%RGC_tracer_CSp)
632 if (cs%use_ideal_age) then
633 use_h_bl = .false. ; if (present(h_bl)) use_h_bl = associated(h_bl)
634 if (present(h_bl)) then
635 hbl(:,:) = h_bl(:,:)
636 else ! This option is here mostly to support the offline tracers.
637 call convert_mld_to_ml_thickness(mld, h_new, hbl, tv, g, gv)
638 endif
639 call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
640 g, gv, us, cs%ideal_age_tracer_CSp, hbl=hbl)
641 endif
642 if (cs%use_MARBL_tracers) then
643 if ((.not. present(prediabatic_t)) .or. (.not. present(prediabatic_s))) &
644 call mom_error(fatal, 'Must pass prediabatic_T and prediabatic_S when using MARBL')
645 call marbl_tracers_column_physics(h_old, ea, eb, fluxes, dt, &
646 g, gv, us, cs%MARBL_tracers_CSp, &
647 prediabatic_t, prediabatic_s, &
648 kpp_csp=kpp_csp, &
649 nonlocaltrans=nonlocaltrans)
650 endif
651 if (cs%use_regional_dyes) &
652 call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
653 g, gv, us, tv, cs%dye_tracer_CSp)
654 if (cs%use_oil) &
655 call oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
656 g, gv, us, cs%oil_tracer_CSp, tv)
657 if (cs%use_advection_test_tracer) &
658 call advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
659 g, gv, us, cs%advection_test_tracer_CSp)
660 if (cs%use_OCMIP2_CFC) &
661 call ocmip2_cfc_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
662 g, gv, us, cs%OCMIP2_CFC_CSp)
663 if (cs%use_CFC_cap) &
664 call cfc_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
665 g, gv, us, cs%CFC_cap_CSp, &
666 kpp_csp=kpp_csp, &
667 nonlocaltrans=nonlocaltrans)
668 if (cs%use_MOM_generic_tracer) then
669 if (us%QRZ_T_to_W_m2 /= 1.0) call mom_error(fatal, "MOM_generic_tracer_column_physics "//&
670 "has not been written to permit dimensionsal rescaling. Set all 4 of the "//&
671 "[QRZT]_RESCALE_POWER parameters to 0.")
672 call mom_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, mld, dt, &
673 g, gv, us, cs%MOM_generic_tracer_CSp, tv, optics)
674 endif
675 if (cs%use_pseudo_salt_tracer) &
676 call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
677 g, gv, us, cs%pseudo_salt_tracer_CSp, &
678 tv, debug, &
679 kpp_csp=kpp_csp, &
680 nonlocaltrans=nonlocaltrans)
681 if (cs%use_boundary_impulse_tracer) &
682 call boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
683 g, gv, us, cs%boundary_impulse_tracer_CSp, tv, debug)
684 if (cs%use_dyed_obc_tracer) &
685 call dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
686 g, gv, us, cs%dyed_obc_tracer_CSp)
687 if (cs%use_nw2_tracers) call nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
688 g, gv, us, tv, cs%nw2_tracers_CSp)
689 endif
690
691end subroutine call_tracer_column_fns
692
693!> This subroutine calls all registered tracer packages to enable them to
694!! add to the surface state returned to the coupler. These routines are optional.
695subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock_units, &
696 num_stocks, stock_index, got_min_max, global_min, global_max, &
697 xgmin, ygmin, zgmin, xgmax, ygmax, zgmax)
698 type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
699 type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
700 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
701 intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
702 real, dimension(:), intent(out) :: stock_values !< The globally mass-integrated
703 !! amount of a tracer [kg conc].
704 type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
705 type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by a
706 !! previous call to
707 !! call_tracer_register.
708 character(len=*), dimension(:), &
709 optional, intent(out) :: stock_names !< Diagnostic names to use for each stock.
710 character(len=*), dimension(:), &
711 optional, intent(out) :: stock_units !< Units to use in the metadata for each stock.
712 integer, optional, intent(out) :: num_stocks !< The number of tracer stocks being returned.
713 integer, optional, intent(in) :: stock_index !< The integer stock index from
714 !! stocks_constants_mod of the stock to be returned. If this is
715 !! present and greater than 0, only a single stock can be returned.
716 logical, dimension(:), &
717 optional, intent(inout) :: got_min_max !< Indicates whether the global min and
718 !! max are found for each tracer
719 real, dimension(:), optional, intent(out) :: global_min !< The global minimum of each tracer [conc]
720 real, dimension(:), optional, intent(out) :: global_max !< The global maximum of each tracer [conc]
721 real, dimension(:), optional, intent(out) :: xgmin !< The x-position of the global minimum in the
722 !! units of G%geoLonT, often [degrees_E] or [km]
723 real, dimension(:), optional, intent(out) :: ygmin !< The y-position of the global minimum in the
724 !! units of G%geoLatT, often [degrees_N] or [km]
725 real, dimension(:), optional, intent(out) :: zgmin !< The z-position of the global minimum [layer]
726 real, dimension(:), optional, intent(out) :: xgmax !< The x-position of the global maximum in the
727 !! units of G%geoLonT, often [degrees_E] or [km]
728 real, dimension(:), optional, intent(out) :: ygmax !< The y-position of the global maximum in the
729 !! units of G%geoLatT, often [degrees_N] or [km]
730 real, dimension(:), optional, intent(out) :: zgmax !< The z-position of the global maximum [layer]
731
732 ! Local variables
733 character(len=200), dimension(MAX_FIELDS_) :: names, units
734 character(len=200) :: set_pkg_name
735 ! real, dimension(MAX_FIELDS_) :: values ! Globally integrated tracer amounts in a
736 ! new list for each tracer package [kg conc]
737 type(efp_type), dimension(MAX_FIELDS_) :: values_efp ! Globally integrated tracer amounts in a
738 ! new list for each tracer package [kg conc]
739 type(efp_type), dimension(MAX_FIELDS_) :: stock_val_efp ! Globally integrated tracer amounts in a
740 ! single master list for all tracers [kg conc]
741 integer :: max_ns, ns_tot, ns, index, nn, n
742
743 if (.not. associated(cs)) call mom_error(fatal, "call_tracer_stocks: "// &
744 "Module must be initialized via call_tracer_register before it is used.")
745
746 index = -1 ; if (present(stock_index)) index = stock_index
747 ns_tot = 0
748 max_ns = size(stock_values)
749 if (present(stock_names)) max_ns = min(max_ns,size(stock_names))
750 if (present(stock_units)) max_ns = min(max_ns,size(stock_units))
751
752! Add other user-provided calls here.
753 if (cs%use_USER_tracer_example) then
754 ns = user_tracer_stock(h, values_efp, g, gv, cs%USER_tracer_example_CSp, &
755 names, units, stock_index)
756 call store_stocks("tracer_example", ns, names, units, values_efp, index, stock_val_efp, &
757 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
758 endif
759! if (CS%use_DOME_tracer) then
760! ns = DOME_tracer_stock(h, values, G, GV, CS%DOME_tracer_CSp, &
761! names, units, stock_index)
762! do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo
763! call store_stocks("DOME_tracer", ns, names, units, values_EFP, index, stock_val_EFP, &
764! set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
765! endif
766 if (cs%use_ideal_age) then
767 ns = ideal_age_stock(h, values_efp, g, gv, cs%ideal_age_tracer_CSp, &
768 names, units, stock_index)
769 call store_stocks("ideal_age_example", ns, names, units, values_efp, index, stock_val_efp, &
770 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
771 endif
772 if (cs%use_MARBL_tracers) then
773 ns = marbl_tracers_stock(h, values_efp, g, gv, cs%MARBL_tracers_CSp, &
774 names, units, stock_index)
775 call store_stocks("MARBL_tracers", ns, names, units, values_efp, index, stock_val_efp, &
776 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
777 endif
778 if (cs%use_regional_dyes) then
779 ns = dye_stock(h, values_efp, g, gv, cs%dye_tracer_CSp, names, units, stock_index)
780 call store_stocks("regional_dyes", ns, names, units, values_efp, index, stock_val_efp, &
781 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
782 endif
783 if (cs%use_oil) then
784 ns = oil_stock(h, values_efp, g, gv, cs%oil_tracer_CSp, names, units, stock_index)
785 call store_stocks("oil_tracer", ns, names, units, values_efp, index, stock_val_efp, &
786 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
787 endif
788 if (cs%use_OCMIP2_CFC) then
789 ns = ocmip2_cfc_stock(h, values_efp, g, gv, cs%OCMIP2_CFC_CSp, names, units, stock_index)
790 call store_stocks("MOM_OCMIP2_CFC", ns, names, units, values_efp, index, stock_val_efp, &
791 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
792 endif
793
794 if (cs%use_CFC_cap) then
795 ns = cfc_cap_stock(h, values_efp, g, gv, cs%CFC_cap_CSp, names, units, stock_index)
796 call store_stocks("MOM_CFC_cap", ns, names, units, values_efp, index, stock_val_efp, &
797 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
798 endif
799
800 if (cs%use_advection_test_tracer) then
801 ns = advection_test_stock( h, values_efp, g, gv, cs%advection_test_tracer_CSp, &
802 names, units, stock_index )
803 ! do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo
804 call store_stocks("advection_test_tracer", ns, names, units, values_efp, index, stock_val_efp, &
805 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
806 endif
807
808 if (cs%use_MOM_generic_tracer) then
809 ns = mom_generic_tracer_stock(h, values_efp, g, gv, cs%MOM_generic_tracer_CSp, &
810 names, units, stock_index)
811 call store_stocks("MOM_generic_tracer", ns, names, units, values_efp, index, stock_val_efp, &
812 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
813 nn=ns_tot-ns+1
814 if (present(got_min_max) .and. present(global_min) .and. present(global_max)) &
815 nn = mom_generic_tracer_min_max(nn, got_min_max, global_min, global_max, &
816 g, cs%MOM_generic_tracer_CSp, names, units, &
817 xgmin, ygmin, zgmin, xgmax, ygmax, zgmax)
818
819 endif
820 if (cs%use_pseudo_salt_tracer) then
821 ns = pseudo_salt_stock(h, values_efp, g, gv, cs%pseudo_salt_tracer_CSp, &
822 names, units, stock_index)
823 call store_stocks("pseudo_salt_tracer", ns, names, units, values_efp, index, stock_val_efp, &
824 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
825 endif
826
827 if (cs%use_boundary_impulse_tracer) then
828 ns = boundary_impulse_stock(h, values_efp, g, gv, cs%boundary_impulse_tracer_CSp, &
829 names, units, stock_index)
830 call store_stocks("boundary_impulse_tracer", ns, names, units, values_efp, index, stock_val_efp, &
831 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
832 endif
833
834 ! Sum the various quantities across all the processors.
835 if (ns_tot > 0) then
836 call efp_sum_across_pes(stock_val_efp, ns_tot)
837 do n=1,ns_tot ; stock_values(n) = efp_to_real(stock_val_efp(n)) ; enddo
838 else
839 stock_values(1) = 0.0
840 endif
841
842 if (present(num_stocks)) num_stocks = ns_tot
843
844end subroutine call_tracer_stocks
845
846!> This routine stores the stocks and does error handling for call_tracer_stocks.
847subroutine store_stocks(pkg_name, ns, names, units, values, index, stock_values, &
848 set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
849 character(len=*), intent(in) :: pkg_name !< The tracer package name
850 integer, intent(in) :: ns !< The number of stocks associated with this tracer package
851 character(len=*), dimension(:), &
852 intent(in) :: names !< Diagnostic names to use for each stock.
853 character(len=*), dimension(:), &
854 intent(in) :: units !< Units to use in the metadata for each stock.
855 type(efp_type), dimension(:), &
856 intent(in) :: values !< The values of the tracer stocks [conc kg]
857 integer, intent(in) :: index !< The integer stock index from
858 !! stocks_constants_mod of the stock to be returned. If this is
859 !! present and greater than 0, only a single stock can be returned.
860 type(efp_type), dimension(:), &
861 intent(inout) :: stock_values !< The master list of stock values [conc kg]
862 character(len=*), intent(inout) :: set_pkg_name !< The name of the last tracer package whose
863 !! stocks were stored for a specific index. This is
864 !! used to trigger an error if there are redundant stocks.
865 integer, intent(in) :: max_ns !< The maximum size of the master stock list
866 integer, intent(inout) :: ns_tot !< The total number of stocks in the master list
867 character(len=*), dimension(:), &
868 optional, intent(inout) :: stock_names !< Diagnostic names to use for each stock in the master list
869 character(len=*), dimension(:), &
870 optional, intent(inout) :: stock_units !< Units to use in the metadata for each stock in the master list
871
872! This routine stores the stocks and does error handling for call_tracer_stocks.
873 character(len=16) :: ind_text, ns_text, max_text
874 integer :: n
875
876 if ((index > 0) .and. (ns > 0)) then
877 write(ind_text,'(I0)') index
878 if (ns > 1) then
879 call mom_error(fatal,"Tracer package "//trim(pkg_name)//&
880 " is not permitted to return more than one value when queried "//&
881 "for specific stock index "//trim(ind_text)//".")
882 elseif (ns+ns_tot > 1) then
883 call mom_error(fatal,"Tracer packages "//trim(pkg_name)//" and "//&
884 trim(set_pkg_name)//" both attempted to set values for "//&
885 "specific stock index "//trim(ind_text)//".")
886 else
887 set_pkg_name = pkg_name
888 endif
889 endif
890
891 if (ns_tot+ns > max_ns) then
892 write(ns_text,'(I0)') ns_tot+ns ; write(max_text,'(I0)') max_ns
893 call mom_error(fatal,"Attempted to return more tracer stock values (at least "//&
894 trim(ns_text)//") than the size "//trim(max_text)//&
895 "of the smallest value, name, or units array.")
896 endif
897
898 do n=1,ns
899 stock_values(ns_tot+n) = values(n)
900 if (present(stock_names)) stock_names(ns_tot+n) = names(n)
901 if (present(stock_units)) stock_units(ns_tot+n) = units(n)
902 enddo
903 ns_tot = ns_tot + ns
904
905end subroutine store_stocks
906
907!> This subroutine calls all registered tracer packages to enable them to
908!! add to the surface state returned to the coupler. These routines are optional.
909subroutine call_tracer_surface_state(sfc_state, h, G, GV, US, CS)
910 type(surface), intent(inout) :: sfc_state !< A structure containing fields that
911 !! describe the surface state of the ocean.
912 type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
913 type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
914 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
915 intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
916 type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
917 type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by a
918 !! previous call to call_tracer_register.
919
920 if (.not. associated(cs)) call mom_error(fatal, "call_tracer_surface_state: "// &
921 "Module must be initialized via call_tracer_register before it is used.")
922
923! Add other user-provided calls here.
924 if (cs%use_USER_tracer_example) &
925 call user_tracer_surface_state(sfc_state, h, g, gv, cs%USER_tracer_example_CSp)
926 if (cs%use_DOME_tracer) &
927 call dome_tracer_surface_state(sfc_state, h, g, gv, cs%DOME_tracer_CSp)
928 if (cs%use_ISOMIP_tracer) &
929 call isomip_tracer_surface_state(sfc_state, h, g, gv, cs%ISOMIP_tracer_CSp)
930 if (cs%use_ideal_age) &
931 call ideal_age_tracer_surface_state(sfc_state, h, g, gv, cs%ideal_age_tracer_CSp)
932 if (cs%use_MARBL_tracers) &
933 call marbl_tracers_surface_state(sfc_state, g, us, cs%MARBL_tracers_CSp)
934 if (cs%use_regional_dyes) &
935 call dye_tracer_surface_state(sfc_state, h, g, gv, cs%dye_tracer_CSp)
936 if (cs%use_oil) &
937 call oil_tracer_surface_state(sfc_state, h, g, gv, cs%oil_tracer_CSp)
938 if (cs%use_advection_test_tracer) &
939 call advection_test_tracer_surface_state(sfc_state, h, g, gv, cs%advection_test_tracer_CSp)
940 if (cs%use_OCMIP2_CFC) &
941 call ocmip2_cfc_surface_state(sfc_state, h, g, gv, us, cs%OCMIP2_CFC_CSp)
942 if (cs%use_MOM_generic_tracer) &
943 call mom_generic_tracer_surface_state(sfc_state, h, g, gv, cs%MOM_generic_tracer_CSp)
944
945end subroutine call_tracer_surface_state
946
947subroutine tracer_flow_control_end(CS)
948 type(tracer_flow_control_cs), pointer :: cs !< The control structure returned by a
949 !! previous call to call_tracer_register.
950
951 if (cs%use_USER_tracer_example) &
952 call user_tracer_example_end(cs%USER_tracer_example_CSp)
953 if (cs%use_DOME_tracer) call dome_tracer_end(cs%DOME_tracer_CSp)
954 if (cs%use_ISOMIP_tracer) call isomip_tracer_end(cs%ISOMIP_tracer_CSp)
955 if (cs%use_RGC_tracer) call rgc_tracer_end(cs%RGC_tracer_CSp)
956 if (cs%use_ideal_age) call ideal_age_example_end(cs%ideal_age_tracer_CSp)
957 if (cs%use_MARBL_tracers) call marbl_tracers_end(cs%MARBL_tracers_CSp)
958 if (cs%use_regional_dyes) call regional_dyes_end(cs%dye_tracer_CSp)
959 if (cs%use_oil) call oil_tracer_end(cs%oil_tracer_CSp)
960 if (cs%use_advection_test_tracer) call advection_test_tracer_end(cs%advection_test_tracer_CSp)
961 if (cs%use_OCMIP2_CFC) call ocmip2_cfc_end(cs%OCMIP2_CFC_CSp)
962 if (cs%use_CFC_cap) call cfc_cap_end(cs%CFC_cap_CSp)
963 if (cs%use_MOM_generic_tracer) call end_mom_generic_tracer(cs%MOM_generic_tracer_CSp)
964 if (cs%use_pseudo_salt_tracer) call pseudo_salt_tracer_end(cs%pseudo_salt_tracer_CSp)
965 if (cs%use_boundary_impulse_tracer) call boundary_impulse_tracer_end(cs%boundary_impulse_tracer_CSp)
966 if (cs%use_dyed_obc_tracer) call dyed_obc_tracer_end(cs%dyed_obc_tracer_CSp)
967 if (cs%use_nw2_tracers) call nw2_tracers_end(cs%nw2_tracers_CSp)
968
969 if (associated(cs)) deallocate(cs)
970end subroutine tracer_flow_control_end
971
972!> \namespace MOM_tracer_flow_control
973!!
974!! By Will Cooke, April 2003
975!! Edited by Elizabeth Yankovsky, May 2019
976!!
977!! This module contains two subroutines into which calls to other
978!! tracer initialization (call_tracer_init_fns) and column physics
979!! routines (call_tracer_column_fns) can be inserted.
980!!