MOM6
boundary_impulse_tracer.F90
Go to the documentation of this file.
1 !> Implements a boundary impulse response tracer to calculate Green's functions
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
7 use mom_error_handler, only : mom_error, fatal, warning
9 use mom_forcing_type, only : forcing
10 use mom_grid, only : ocean_grid_type
11 use mom_hor_index, only : hor_index_type
12 use mom_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc
16 use mom_time_manager, only : time_type
21 use mom_variables, only : surface
24 
25 use coupler_types_mod, only : coupler_type_set_data, ind_csurf
27 
28 implicit none ; private
29 
30 #include <MOM_memory.h>
31 
35 
36 !> NTR_MAX is the maximum number of tracers in this module.
37 integer, parameter :: ntr_max = 1
38 
39 !> The control structure for the boundary impulse tracer package
40 type, public :: boundary_impulse_tracer_cs ; private
41  integer :: ntr=ntr_max !< The number of tracers that are actually used.
42  logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
43  type(time_type), pointer :: time => null() !< A pointer to the ocean model's clock.
44  type(tracer_registry_type), pointer :: tr_reg => null() !< A pointer to the tracer registry
45  real, pointer :: tr(:,:,:,:) => null() !< The array of tracers used in this subroutine, in g m-3?
46  logical :: tracers_may_reinit !< If true, boundary_impulse can be initialized if not found in restart file
47  integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the
48  !! surface tracer concentrations are to be provided to the coupler.
49 
50  integer :: nkml !< Number of layers in mixed layer
51  real, dimension(NTR_MAX) :: land_val = -1.0 !< A value to use to fill in tracers over land
52  real :: kw_eff !< An effective piston velocity used to flux tracer out at the surface
53  real :: remaining_source_time !< How much longer (same units as the timestep) to
54  !! inject the tracer at the surface [s]
55 
56  type(diag_ctrl), pointer :: diag => null() !< A structure that is used to
57  !! regulate the timing of diagnostic output.
58  type(mom_restart_cs), pointer :: restart_csp => null() !< A pointer to the retart control structure
59 
60  type(vardesc) :: tr_desc(ntr_max) !< Descriptions and metadata for the tracers
62 
63 contains
64 
65 !> Read in runtime options and add boundary impulse tracer to tracer registry
66 function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
67  type(hor_index_type), intent(in ) :: hi !< A horizontal index type structure
68  type(verticalgrid_type), intent(in ) :: gv !< The ocean's vertical grid structure
69  type(param_file_type), intent(in ) :: param_file !< A structure to parse for run-time parameters
70  type(boundary_impulse_tracer_cs), pointer :: cs !< The control structure returned by a previous
71  !! call to register_boundary_impulse_tracer.
72  type(tracer_registry_type), pointer :: tr_reg !< A pointer that is set to point to the control
73  !! structure for the tracer advection and
74  !! diffusion module
75  type(mom_restart_cs), pointer :: restart_cs !< A pointer to the restart control structure
76 
77  ! Local variables
78  character(len=40) :: mdl = "boundary_impulse_tracer" ! This module's name.
79  character(len=200) :: inputdir ! The directory where the input files are.
80  character(len=48) :: var_name ! The variable's name.
81  character(len=3) :: name_tag ! String for creating identifying boundary_impulse
82  character(len=48) :: flux_units ! The units for tracer fluxes, usually
83  ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1.
84  ! This include declares and sets the variable "version".
85 #include "version_variable.h"
86  real, pointer :: tr_ptr(:,:,:) => null()
87  real, pointer :: rem_time_ptr => null()
89  integer :: isd, ied, jsd, jed, nz, m, i, j
90  isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
91 
92  if (associated(cs)) then
93  call mom_error(warning, "register_boundary_impulse_tracer called with an "// &
94  "associated control structure.")
95  return
96  endif
97  allocate(cs)
98 
99  ! Read all relevant parameters and write them to the model log.
100  call log_version(param_file, mdl, version, "")
101  call get_param(param_file, mdl, "IMPULSE_SOURCE_TIME", cs%remaining_source_time, &
102  "Length of time for the boundary tracer to be injected "//&
103  "into the mixed layer. After this time has elapsed, the "//&
104  "surface becomes a sink for the boundary impulse tracer.", &
105  default=31536000.0)
106  call get_param(param_file, mdl, "TRACERS_MAY_REINIT", cs%tracers_may_reinit, &
107  "If true, tracers may go through the initialization code "//&
108  "if they are not found in the restart files. Otherwise "//&
109  "it is a fatal error if the tracers are not found in the "//&
110  "restart files of a restarted run.", default=.false.)
111  cs%ntr = ntr_max
112  allocate(cs%tr(isd:ied,jsd:jed,nz,cs%ntr)) ; cs%tr(:,:,:,:) = 0.0
113 
114  cs%nkml = max(gv%nkml,1)
115 
116  do m=1,cs%ntr
117  ! This is needed to force the compiler not to do a copy in the registration
118  ! calls. Curses on the designers and implementers of Fortran90.
119  cs%tr_desc(m) = var_desc(trim("boundary_impulse"), "kg kg-1", &
120  "Boundary impulse tracer", caller=mdl)
121  if (gv%Boussinesq) then ; flux_units = "kg kg-1 m3 s-1"
122  else ; flux_units = "kg s-1" ; endif
123 
124  tr_ptr => cs%tr(:,:,:,m)
125  call query_vardesc(cs%tr_desc(m), name=var_name, caller="register_boundary_impulse_tracer")
126  ! Register the tracer for horizontal advection, diffusion, and restarts.
127  call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, tr_desc=cs%tr_desc(m), &
128  registry_diags=.true., flux_units=flux_units, &
129  restart_cs=restart_cs, mandatory=.not.cs%tracers_may_reinit)
130 
131  ! Set coupled_tracers to be true (hard-coded above) to provide the surface
132  ! values to the coupler (if any). This is meta-code and its arguments will
133  ! currently (deliberately) give fatal errors if it is used.
134  if (cs%coupled_tracers) &
135  cs%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//'_flux', &
136  flux_type=' ', implementation=' ', caller="register_boundary_impulse_tracer")
137  enddo
138  ! Register remaining source time as a restart field
139  rem_time_ptr => cs%remaining_source_time
140  call register_restart_field(rem_time_ptr, "bir_remain_time", &
141  .not.cs%tracers_may_reinit, restart_cs, &
142  "Remaining time to apply BIR source", "s")
143 
144  cs%tr_Reg => tr_reg
145  cs%restart_CSp => restart_cs
147 
149 
150 !> Initialize tracer from restart or set to 1 at surface to initialize
151 subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, CS, &
152  sponge_CSp, tv)
153  logical, intent(in) :: restart !< .true. if the fields have already
154  !! been read from a restart file.
155  type(time_type), target, intent(in) :: day !< Time of the start of the run.
156  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
157  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
158  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
159  intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
160  type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate
161  !! diagnostic output.
162  type(ocean_obc_type), pointer :: obc !< This open boundary condition type specifies
163  !! whether, where, and what open boundary
164  !! conditions are used.
165  type(boundary_impulse_tracer_cs), pointer :: cs !< The control structure returned by a previous
166  !! call to register_boundary_impulse_tracer.
167  type(sponge_cs), pointer :: sponge_csp !< Pointer to the control structure for the sponges.
168  type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
169  !! thermodynamic variables
170  ! Local variables
171  character(len=16) :: name ! A variable's name in a NetCDF file.
172  character(len=72) :: longname ! The long name of that variable.
173  character(len=48) :: units ! The dimensions of the variable.
174  character(len=48) :: flux_units ! The units for age tracer fluxes, either
175  ! years m3 s-1 or years kg s-1.
176  logical :: ok
177  integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
178  integer :: isdb, iedb, jsdb, jedb
179 
180  if (.not.associated(cs)) return
181  if (cs%ntr < 1) return
182  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
183  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
184  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
185 
186  cs%Time => day
187  cs%diag => diag
188  name = "boundary_impulse"
189 
190  do m=1,cs%ntr
191  call query_vardesc(cs%tr_desc(m), name=name, caller="initialize_boundary_impulse_tracer")
192  if ((.not.restart) .or. (.not. &
193  query_initialized(cs%tr(:,:,:,m), name, cs%restart_CSp))) then
194  do k=1,cs%nkml ; do j=jsd,jed ; do i=isd,ied
195  cs%tr(i,j,k,m) = 1.0
196  enddo ; enddo ; enddo
197  endif
198  enddo ! Tracer loop
199 
200  if (associated(obc)) then
201  ! Steal from updated DOME in the fullness of time.
202  endif
203 
205 
206 !> Apply source or sink at boundary and do vertical diffusion
207 subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, &
208  tv, debug, evap_CFL_limit, minimum_forcing_depth)
209  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
210  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
211  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
212  intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2].
213  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
214  intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2].
215  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
216  intent(in) :: ea !< an array to which the amount of fluid entrained
217  !! from the layer above during this call will be
218  !! added [H ~> m or kg m-2].
219  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
220  intent(in) :: eb !< an array to which the amount of fluid entrained
221  !! from the layer below during this call will be
222  !! added [H ~> m or kg m-2].
223  type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic
224  !! and tracer forcing fields. Unused fields have NULL ptrs.
225  real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]
226  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
227  type(boundary_impulse_tracer_cs), pointer :: cs !< The control structure returned by a previous
228  !! call to register_boundary_impulse_tracer.
229  type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
230  !! thermodynamic variables
231  logical, intent(in) :: debug !< If true calculate checksums
232  real, optional, intent(in) :: evap_cfl_limit !< Limit on the fraction of the water that can
233  !! be fluxed out of the top layer in a timestep [nondim]
234  real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which
235  !! fluxes can be applied [H ~> m or kg m-2]
236 
237 ! This subroutine applies diapycnal diffusion and any other column
238 ! tracer physics or chemistry to the tracers from this file.
239 ! This is a simple example of a set of advected passive tracers.
240 
241 ! The arguments to this subroutine are redundant in that
242 ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1)
243 
244  ! Local variables
245  real :: isecs_per_year = 1.0 / (365.0*86400.0)
246  real :: year, h_total, scale, htot, ih_limit
247  integer :: secs, days
248  integer :: i, j, k, is, ie, js, je, nz, m, k_max
249  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
250 
251  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
252 
253  if (.not.associated(cs)) return
254  if (cs%ntr < 1) return
255 
256  ! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode
257  if (present(evap_cfl_limit) .and. present(minimum_forcing_depth)) then
258  do k=1,nz ;do j=js,je ; do i=is,ie
259  h_work(i,j,k) = h_old(i,j,k)
260  enddo ; enddo ; enddo
261  call applytracerboundaryfluxesinout(g, gv, cs%tr(:,:,:,1), dt, fluxes, h_work, &
262  evap_cfl_limit, minimum_forcing_depth)
263  call tracer_vertdiff(h_work, ea, eb, dt, cs%tr(:,:,:,1), g, gv)
264  else
265  call tracer_vertdiff(h_old, ea, eb, dt, cs%tr(:,:,:,1), g, gv)
266  endif
267 
268  ! Set surface conditions
269  do m=1,1
270  if (cs%remaining_source_time>0.0) then
271  do k=1,cs%nkml ; do j=js,je ; do i=is,ie
272  cs%tr(i,j,k,m) = 1.0
273  enddo ; enddo ; enddo
274  cs%remaining_source_time = cs%remaining_source_time-us%T_to_s*dt
275  else
276  do k=1,cs%nkml ; do j=js,je ; do i=is,ie
277  cs%tr(i,j,k,m) = 0.0
278  enddo ; enddo ; enddo
279  endif
280 
281  enddo
282 
284 
285 !> Calculate total inventory of tracer
286 function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index)
287  type(ocean_grid_type), intent(in ) :: g !< The ocean's grid structure
288  type(verticalgrid_type), intent(in ) :: gv !< The ocean's vertical grid structure
289  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h !< Layer thicknesses [H ~> m or kg m-2]
290  real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each
291  !! tracer, in kg times concentration units [kg conc].
292  type(boundary_impulse_tracer_cs), pointer :: cs !< The control structure returned by a previous
293  !! call to register_boundary_impulse_tracer.
294  character(len=*), dimension(:), intent( out) :: names !< The names of the stocks calculated.
295  character(len=*), dimension(:), intent( out) :: units !< The units of the stocks calculated.
296  integer, optional, intent(in ) :: stock_index !< The coded index of a specific stock
297  !! being sought.
298  integer :: boundary_impulse_stock !< Return value: the number of stocks calculated here.
299 
300 ! This function calculates the mass-weighted integral of all tracer stocks,
301 ! returning the number of stocks it has calculated. If the stock_index
302 ! is present, only the stock corresponding to that coded index is returned.
303 
304  ! Local variables
305  integer :: i, j, k, is, ie, js, je, nz, m
306  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
307 
309  if (.not.associated(cs)) return
310  if (cs%ntr < 1) return
311 
312  if (present(stock_index)) then ; if (stock_index > 0) then
313  ! Check whether this stock is available from this routine.
314 
315  ! No stocks from this routine are being checked yet. Return 0.
316  return
317  endif ; endif
318 
319  do m=1,1
320  call query_vardesc(cs%tr_desc(m), name=names(m), units=units(m), caller="boundary_impulse_stock")
321  units(m) = trim(units(m))//" kg"
322  stocks(m) = 0.0
323  do k=1,nz ; do j=js,je ; do i=is,ie
324  stocks(m) = stocks(m) + cs%tr(i,j,k,m) * &
325  (g%mask2dT(i,j) * g%US%L_to_m**2*g%areaT(i,j) * h(i,j,k))
326  enddo ; enddo ; enddo
327  stocks(m) = gv%H_to_kg_m2 * stocks(m)
328  enddo
329 
330  boundary_impulse_stock = cs%ntr
331 
332 end function boundary_impulse_stock
333 
334 !> This subroutine extracts the surface fields from this tracer package that
335 !! are to be shared with the atmosphere in coupled configurations.
336 !! This particular tracer package does not report anything back to the coupler.
337 subroutine boundary_impulse_tracer_surface_state(state, h, G, CS)
338  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
339  type(surface), intent(inout) :: state !< A structure containing fields that
340  !! describe the surface state of the ocean.
341  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
342  intent(in) :: h !< Layer thickness [H ~> m or kg m-2].
343  type(boundary_impulse_tracer_cs), pointer :: cs !< The control structure returned by a previous
344  !! call to register_boundary_impulse_tracer.
345 
346  ! This particular tracer package does not report anything back to the coupler.
347  ! The code that is here is just a rough guide for packages that would.
348 
349  integer :: m, is, ie, js, je, isd, ied, jsd, jed
350  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
351  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
352 
353  if (.not.associated(cs)) return
354 
355  if (cs%coupled_tracers) then
356  do m=1,cs%ntr
357  ! This call loads the surface values into the appropriate array in the
358  ! coupler-type structure.
359  call coupler_type_set_data(cs%tr(:,:,1,m), cs%ind_tr(m), ind_csurf, &
360  state%tr_fields, idim=(/isd, is, ie, ied/), &
361  jdim=(/jsd, js, je, jed/) )
362  enddo
363  endif
364 
366 
367 !> Performs finalization of boundary impulse tracer
368 subroutine boundary_impulse_tracer_end(CS)
369  type(boundary_impulse_tracer_cs), pointer :: cs !< The control structure returned by a previous
370  !! call to register_boundary_impulse_tracer.
371  integer :: m
372 
373  if (associated(cs)) then
374  if (associated(cs%tr)) deallocate(cs%tr)
375  deallocate(cs)
376  endif
377 end subroutine boundary_impulse_tracer_end
378 
379 !> \namespace boundary_impulse_tracer
380 !!
381 !! \section section_BIT_desc Boundary Impulse Response Tracer and Transit Time Distributions
382 !! Transit time distributions (TTD) are the Green's function solution of the passive tracer equation between
383 !! the oceanic surface and interior. The name derives from the idea that the 'age' (e.g. time since last
384 !! contact with the atmosphere) of a water parcel is best characterized as a distribution of ages
385 !! because water parcels leaving the surface arrive at a particular interior point at different times.
386 !! The more commonly used ideal age tracer is the first moment of the TTD, equivalently referred to as the
387 !! mean age.
388 !!
389 !! A boundary impulse response (BIR) is a passive tracer whose surface boundary condition is a rectangle
390 !! function with width \f$\Delta t\f$. In the case of unsteady flow, multiple BIRs, initiated at different
391 !! times in the model can be used to infer the transit time distribution or Green's function between
392 !! the oceanic surface and interior. In the case of steady or cyclostationary flow, a single BIR is
393 !! sufficient.
394 !!
395 !! In the References section, both the theoretical discussion of TTDs and BIRs are listed along with
396 !! modeling studies which have this used framework in scientific investigations
397 !!
398 !! \section section_BIT_params Run-time parameters
399 !! -DO_BOUNDARY_IMPULSE_TRACER: Enables the boundary impulse tracer model
400 !! -IMPULSE_SOURCE_TIME: Length of time that the surface layer acts as a source of the BIR tracer
401 !!
402 !! \section section_BIT_refs References
403 !! \subsection TTD and BIR Theory
404 !! -Holzer, M., and T.M. Hall, 2000: Transit-time and tracer-age distributions in geophysical flows.
405 !! J. Atmos. Sci., 57, 3539-3558, doi:10.1175/1520-0469(2000)057<3539:TTATAD>2.0.CO;2.
406 !! -T.W.N. Haine, H. Zhang, D.W. Waugh, M. Holzer, On transit-time distributions in unsteady circulation
407 !! models, Ocean Modelling, Volume 21, Issues 1–2, 2008, Pages 35-45, ISSN 1463-5003
408 !! http://dx.doi.org/10.1016/j.ocemod.2007.11.004.
409 !! \subsection section_BIT_apps Modelling applications
410 !! -Peacock, S., and M. Maltrud (2006), Transit-time distributions in a global ocean model,
411 !! J. Phys. Oceanogr., 36(3), 474–495, doi:10.1175/JPO2860.1.
412 !! -Maltrud, M., Bryan, F. & Peacock, Boundary impulse response functions in a century-long eddying global
413 !! ocean simulation, S. Environ Fluid Mech (2010) 10: 275. doi:10.1007/s10652-009-9154-3
414 !!
415 end module boundary_impulse_tracer
mom_time_manager
Wraps the FMS time manager functions.
Definition: MOM_time_manager.F90:2
mom_tracer_registry::register_tracer
subroutine, public register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, units, cmor_name, cmor_units, cmor_longname, tr_desc, OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, df_x, df_y, ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, flux_nameroot, flux_longname, flux_units, flux_scale, convergence_units, convergence_scale, cmor_tendprefix, diag_form, restart_CS, mandatory)
This subroutine registers a tracer to be advected and laterally diffused.
Definition: MOM_tracer_registry.F90:158
mom_variables::surface
Pointers to various fields which may be used describe the surface state of MOM, and which will be ret...
Definition: MOM_variables.F90:38
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
mom_io::var_desc
type(vardesc) function, public var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, cmor_units, cmor_longname, conversion, caller)
Returns a vardesc type whose elements have been filled with the provided fields. The argument name is...
Definition: MOM_io.F90:600
mom_io::query_vardesc
subroutine, public query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, cmor_units, cmor_longname, conversion, caller)
This routine queries vardesc.
Definition: MOM_io.F90:699
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
mom_tracer_diabatic::applytracerboundaryfluxesinout
subroutine, public applytracerboundaryfluxesinout(G, GV, Tr, dt, fluxes, h, evap_CFL_limit, minimum_forcing_depth, in_flux_optional, out_flux_optional, update_h_opt)
This routine is modeled after applyBoundaryFluxesInOut in MOM_diabatic_aux.F90 NOTE: Please note that...
Definition: MOM_tracer_diabatic.F90:230
mom_sponge::set_up_sponge_field
subroutine, public set_up_sponge_field(sp_val, f_ptr, G, nlay, CS, sp_val_i_mean)
This subroutine stores the reference profile for the variable whose address is given by f_ptr....
Definition: MOM_sponge.F90:214
boundary_impulse_tracer::boundary_impulse_tracer_cs
The control structure for the boundary impulse tracer package.
Definition: boundary_impulse_tracer.F90:40
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
atmos_ocean_fluxes_mod
A dummy version of atmos_ocean_fluxes_mod module for use when the vastly larger FMS package is not ne...
Definition: atmos_ocean_fluxes.F90:3
mom_diag_mediator
The subroutines here provide convenient wrappers to the fms diag_manager interfaces with additional d...
Definition: MOM_diag_mediator.F90:3
mom_variables::thermo_var_ptrs
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Definition: MOM_variables.F90:78
boundary_impulse_tracer
Implements a boundary impulse response tracer to calculate Green's functions.
Definition: boundary_impulse_tracer.F90:2
boundary_impulse_tracer::ntr_max
integer, parameter ntr_max
NTR_MAX is the maximum number of tracers in this module.
Definition: boundary_impulse_tracer.F90:37
mom_tracer_registry
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
Definition: MOM_tracer_registry.F90:5
mom_file_parser::param_file_type
A structure that can be parsed to read and document run-time parameters.
Definition: MOM_file_parser.F90:54
mom_file_parser::get_param
An overloaded interface to read and log the values of various types of parameters.
Definition: MOM_file_parser.F90:102
mom_hor_index
Defines the horizontal index type (hor_index_type) used for providing index ranges.
Definition: MOM_hor_index.F90:2
mom_io
This module contains I/O framework code.
Definition: MOM_io.F90:2
mom_restart::mom_restart_cs
A restart registry and the control structure for restarts.
Definition: MOM_restart.F90:72
mom_tracer_z_init
Used to initialize tracers from a depth- (or z*-) space file.
Definition: MOM_tracer_Z_init.F90:2
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
mom_tracer_diabatic
This module contains routines that implement physical fluxes of tracers (e.g. due to surface fluxes o...
Definition: MOM_tracer_diabatic.F90:4
mom_forcing_type
This module implements boundary forcing for MOM6.
Definition: MOM_forcing_type.F90:2
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
mom_tracer_diabatic::tracer_vertdiff
subroutine, public tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, sfc_flux, btm_flux, btm_reservoir, sink_rate, convert_flux_in)
This subroutine solves a tridiagonal equation for the final tracer concentrations after the dual-entr...
Definition: MOM_tracer_diabatic.F90:27
mom_verticalgrid::verticalgrid_type
Describes the vertical ocean grid, including unit conversion factors.
Definition: MOM_verticalGrid.F90:24
mom_restart
The MOM6 facility for reading and writing restart files, and querying what has been read.
Definition: MOM_restart.F90:2
mom_variables
Provides transparent structures with groups of MOM6 variables and supporting routines.
Definition: MOM_variables.F90:2
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
mom_open_boundary
Controls where open boundary conditions are applied.
Definition: MOM_open_boundary.F90:2
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
mom_sponge
Implements sponge regions in isopycnal mode.
Definition: MOM_sponge.F90:2
mom_tracer_z_init::tracer_z_init
logical function, public tracer_z_init(tr, h, filename, tr_name, G, US, missing_val, land_val)
This function initializes a tracer by reading a Z-space file, returning .true. if this appears to hav...
Definition: MOM_tracer_Z_init.F90:31
mom_tracer_registry::tracer_registry_type
Type to carry basic tracer information.
Definition: MOM_tracer_registry.F90:138
mom_hor_index::hor_index_type
Container for horizontal index ranges for data, computational and global domains.
Definition: MOM_hor_index.F90:15
mom_grid
Provides the ocean grid type.
Definition: MOM_grid.F90:2
mom_open_boundary::ocean_obc_type
Open-boundary data.
Definition: MOM_open_boundary.F90:195
mom_sponge::sponge_cs
This control structure holds memory and parameters for the MOM_sponge module.
Definition: MOM_sponge.F90:41
mom_restart::register_restart_field
Register fields for restarts.
Definition: MOM_restart.F90:107
mom_unit_scaling
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Definition: MOM_unit_scaling.F90:2
mom_forcing_type::forcing
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
Definition: MOM_forcing_type.F90:50
mom_io::vardesc
Type for describing a variable, typically a tracer.
Definition: MOM_io.F90:53
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_io::file_exists
Indicate whether a file exists, perhaps with domain decomposition.
Definition: MOM_io.F90:68
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
atmos_ocean_fluxes_mod::aof_set_coupler_flux
integer function, public aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, param, flag, mol_wt, ice_restart_file, ocean_restart_file, units, caller, verbosity)
This subroutine duplicates an interface used by the FMS coupler, but only returns a value of -1....
Definition: atmos_ocean_fluxes.F90:18
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
mom_restart::query_initialized
Indicate whether a field has been read from a restart file.
Definition: MOM_restart.F90:116
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_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:26
mom_diag_mediator::diag_ctrl
The following data type a list of diagnostic fields an their variants, as well as variables that cont...
Definition: MOM_diag_mediator.F90:239