MOM6
ISOMIP_tracer.F90
Go to the documentation of this file.
1 !> Routines used to set up and use a set of (one for now)
2 !! dynamically passive tracers in the ISOMIP configuration.
3 !!
4 !! For now, just one passive tracer is injected in
5 !! the sponge layer.
7 
8 ! This file is part of MOM6. See LICENSE.md for the license.
9 
10 ! Original sample tracer package by Robert Hallberg, 2002
11 ! Adapted to the ISOMIP test case by Gustavo Marques, May 2016
12 
13 use mom_coms, only : max_across_pes
14 use mom_diag_mediator, only : diag_ctrl
15 use mom_error_handler, only : mom_error, fatal, warning
17 use mom_forcing_type, only : forcing
18 use mom_hor_index, only : hor_index_type
19 use mom_grid, only : ocean_grid_type
22 use mom_restart, only : mom_restart_cs
24 use mom_time_manager, only : time_type
28 use mom_variables, only : surface
30 
31 use coupler_types_mod, only : coupler_type_set_data, ind_csurf
33 
34 implicit none ; private
35 
36 #include <MOM_memory.h>
37 
38 !< Publicly available functions
41 
42 integer, parameter :: ntr = 1 !< ntr is the number of tracers in this module.
43 
44 !> ISOMIP tracer package control structure
45 type, public :: isomip_tracer_cs ; private
46  logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
47  character(len = 200) :: tracer_ic_file !< The full path to the IC file, or " " to initialize internally.
48  type(time_type), pointer :: time !< A pointer to the ocean model's clock.
49  type(tracer_registry_type), pointer :: tr_reg => null() !< A pointer to the MOM tracer registry
50  real, pointer :: tr(:,:,:,:) => null() !< The array of tracers used in this package, in g m-3?
51  real :: land_val(ntr) = -1.0 !< The value of tr used where land is masked out.
52  logical :: use_sponge !< If true, sponges may be applied somewhere in the domain.
53 
54  integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux
55  !< if it is used and the surface tracer concentrations are to be
56  !< provided to the coupler.
57 
58  type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
59  !! timing of diagnostic output.
60 
61  type(vardesc) :: tr_desc(ntr) !< Descriptions and metadata for the tracers in this package
62 end type isomip_tracer_cs
63 
64 contains
65 
66 
67 !> This subroutine is used to register tracer fields
68 function register_isomip_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
69  type(hor_index_type), intent(in) :: hi !<A horizontal index type structure.
70  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
71  type(param_file_type), intent(in) :: param_file !< A structure indicating the open file
72  !! to parse for model parameter values.
73  type(isomip_tracer_cs), pointer :: cs !<A pointer that is set to point to the control
74  !! structure for this module (in/out).
75  type(tracer_registry_type), pointer :: tr_reg !<A pointer to the tracer registry.
76  type(mom_restart_cs), pointer :: restart_cs !<A pointer to the restart control structure.
77 
78  character(len=80) :: name, longname
79 ! This include declares and sets the variable "version".
80 #include "version_variable.h"
81  character(len=40) :: mdl = "ISOMIP_tracer" ! This module's name.
82  character(len=200) :: inputdir
83  character(len=48) :: flux_units ! The units for tracer fluxes, usually
84  ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1.
85  real, pointer :: tr_ptr(:,:,:) => null()
86  logical :: register_isomip_tracer
87  integer :: isd, ied, jsd, jed, nz, m
88  isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
89 
90  if (associated(cs)) then
91  call mom_error(warning, "ISOMIP_register_tracer called with an "// &
92  "associated control structure.")
93  return
94  endif
95  allocate(cs)
96 
97  ! Read all relevant parameters and write them to the model log.
98  call log_version(param_file, mdl, version, "")
99  call get_param(param_file, mdl, "ISOMIP_TRACER_IC_FILE", cs%tracer_IC_file, &
100  "The name of a file from which to read the initial "//&
101  "conditions for the ISOMIP tracers, or blank to initialize "//&
102  "them internally.", default=" ")
103  if (len_trim(cs%tracer_IC_file) >= 1) then
104  call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
105  inputdir = slasher(inputdir)
106  cs%tracer_IC_file = trim(inputdir)//trim(cs%tracer_IC_file)
107  call log_param(param_file, mdl, "INPUTDIR/ISOMIP_TRACER_IC_FILE", &
108  cs%tracer_IC_file)
109  endif
110  call get_param(param_file, mdl, "SPONGE", cs%use_sponge, &
111  "If true, sponges may be applied anywhere in the domain. "//&
112  "The exact location and properties of those sponges are "//&
113  "specified from MOM_initialization.F90.", default=.false.)
114 
115  allocate(cs%tr(isd:ied,jsd:jed,nz,ntr)) ; cs%tr(:,:,:,:) = 0.0
116 
117  do m=1,ntr
118  if (m < 10) then ; write(name,'("tr_D",I1.1)') m
119  else ; write(name,'("tr_D",I2.2)') m ; endif
120  write(longname,'("Concentration of ISOMIP Tracer ",I2.2)') m
121  cs%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mdl)
122  if (gv%Boussinesq) then ; flux_units = "kg kg-1 m3 s-1"
123  else ; flux_units = "kg s-1" ; endif
124 
125  ! This is needed to force the compiler not to do a copy in the registration
126  ! calls. Curses on the designers and implementers of Fortran90.
127  tr_ptr => cs%tr(:,:,:,m)
128  ! Register the tracer for horizontal advection, diffusion, and restarts.
129  call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, &
130  name=name, longname=longname, units="kg kg-1", &
131  registry_diags=.true., flux_units=flux_units, &
132  restart_cs=restart_cs)
133 
134  ! Set coupled_tracers to be true (hard-coded above) to provide the surface
135  ! values to the coupler (if any). This is meta-code and its arguments will
136  ! currently (deliberately) give fatal errors if it is used.
137  if (cs%coupled_tracers) &
138  cs%ind_tr(m) = aof_set_coupler_flux(trim(name)//'_flux', &
139  flux_type=' ', implementation=' ', caller="register_ISOMIP_tracer")
140  enddo
141 
142  cs%tr_Reg => tr_reg
143  register_isomip_tracer = .true.
144 end function register_isomip_tracer
145 
146 !> Initializes the NTR tracer fields in tr(:,:,:,:)
147 ! and it sets up the tracer output.
148 subroutine initialize_isomip_tracer(restart, day, G, GV, h, diag, OBC, CS, &
149  ALE_sponge_CSp)
150 
151  type(ocean_grid_type), intent(in) :: g !< Grid structure.
152  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
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  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2].
157  type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate
158  !! diagnostic output.
159  type(ocean_obc_type), pointer :: obc !< This open boundary condition type specifies
160  !! whether, where, and what open boundary conditions
161  !! are used. This is not being used for now.
162  type(isomip_tracer_cs), pointer :: cs !< The control structure returned by a previous call
163  !! to ISOMIP_register_tracer.
164  type(ale_sponge_cs), pointer :: ale_sponge_csp !< A pointer to the control structure for
165  !! the sponges, if they are in use. Otherwise this
166  !! may be unassociated.
167 
168  real, allocatable :: temp(:,:,:)
169  real, pointer, dimension(:,:,:) :: &
170  obc_tr1_u => null(), & ! These arrays should be allocated and set to
171  obc_tr1_v => null() ! specify the values of tracer 1 that should come
172  ! in through u- and v- points through the open
173  ! boundary conditions, in the same units as tr.
174  character(len=16) :: name ! A variable's name in a NetCDF file.
175  character(len=72) :: longname ! The long name of that variable.
176  character(len=48) :: units ! The dimensions of the variable.
177  character(len=48) :: flux_units ! The units for tracer fluxes, usually
178  ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1.
179  real, pointer :: tr_ptr(:,:,:) => null()
180  real :: h_neglect ! A thickness that is so small it is usually lost
181  ! in roundoff and can be neglected [H ~> m or kg m-2].
182  real :: e(szk_(g)+1), e_top, e_bot, d_tr
183  integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
184  integer :: isdb, iedb, jsdb, jedb
185 
186  if (.not.associated(cs)) return
187  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
188  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
189  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
190  h_neglect = gv%H_subroundoff
191 
192  cs%Time => day
193  cs%diag => diag
194 
195  if (.not.restart) then
196  if (len_trim(cs%tracer_IC_file) >= 1) then
197  ! Read the tracer concentrations from a netcdf file.
198  if (.not.file_exists(cs%tracer_IC_file, g%Domain)) &
199  call mom_error(fatal, "ISOMIP_initialize_tracer: Unable to open "// &
200  cs%tracer_IC_file)
201  do m=1,ntr
202  call query_vardesc(cs%tr_desc(m), name, caller="initialize_ISOMIP_tracer")
203  call mom_read_data(cs%tracer_IC_file, trim(name), cs%tr(:,:,:,m), g%Domain)
204  enddo
205  else
206  do m=1,ntr
207  do k=1,nz ; do j=js,je ; do i=is,ie
208  cs%tr(i,j,k,m) = 0.0
209  enddo ; enddo ; enddo
210  enddo
211  endif
212  endif ! restart
213 
214 ! the following does not work in layer mode yet
215 !! if ( CS%use_sponge ) then
216  ! If sponges are used, this example damps tracers in sponges in the
217  ! northern half of the domain to 1 and tracers in the southern half
218  ! to 0. For any tracers that are not damped in the sponge, the call
219  ! to set_up_sponge_field can simply be omitted.
220 ! if (.not.associated(ALE_sponge_CSp)) &
221 ! call MOM_error(FATAL, "ISOMIP_initialize_tracer: "// &
222 ! "The pointer to ALEsponge_CSp must be associated if SPONGE is defined.")
223 
224 ! allocate(temp(G%isd:G%ied,G%jsd:G%jed,nz))
225 
226 ! do j=js,je ; do i=is,ie
227 ! if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then
228 ! temp(i,j,:) = 1.0
229 ! else
230 ! temp(i,j,:) = 0.0
231 ! endif
232 ! enddo ; enddo
233 
234  ! do m=1,NTR
235 ! do m=1,1
236  ! This is needed to force the compiler not to do a copy in the sponge
237  ! calls. Curses on the designers and implementers of Fortran90.
238 ! tr_ptr => CS%tr(:,:,:,m)
239 ! call set_up_ALE_sponge_field(temp, G, tr_ptr, ALE_sponge_CSp)
240 ! enddo
241 ! deallocate(temp)
242 ! endif
243 
244 end subroutine initialize_isomip_tracer
245 
246 !> This subroutine applies diapycnal diffusion, including the surface boundary
247 !! conditions and any other column tracer physics or chemistry to the tracers from this file.
248 subroutine isomip_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, &
249  evap_CFL_limit, minimum_forcing_depth)
250  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
251  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
252  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
253  intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2].
254  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
255  intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2].
256  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
257  intent(in) :: ea !< an array to which the amount of fluid entrained
258  !! from the layer above during this call will be
259  !! added [H ~> m or kg m-2].
260  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
261  intent(in) :: eb !< an array to which the amount of fluid entrained
262  !! from the layer below during this call will be
263  !! added [H ~> m or kg m-2].
264  type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic
265  !! and tracer forcing fields. Unused fields have NULL ptrs.
266  real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]
267  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
268  type(isomip_tracer_cs), pointer :: cs !< The control structure returned by a previous
269  !! call to ISOMIP_register_tracer.
270  real, optional, intent(in) :: evap_cfl_limit !< Limit on the fraction of the water that can
271  !! be fluxed out of the top layer in a timestep [nondim]
272  real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which
273  !! fluxes can be applied [H ~> m or kg m-2]
274 
275 ! The arguments to this subroutine are redundant in that
276 ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1)
277 
278  ! Local variables
279  real :: mmax
280  real :: b1(szi_(g)) ! b1 and c1 are variables used by the
281  real :: c1(szi_(g),szk_(g)) ! tridiagonal solver.
282  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
283  real :: melt(szi_(g),szj_(g)) ! melt water (positive for melting
284  ! negative for freezing)
285  character(len=256) :: mesg ! The text of an error message
286  integer :: i, j, k, is, ie, js, je, nz, m
287  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
288 
289  if (.not.associated(cs)) return
290 
291  melt(:,:) = fluxes%iceshelf_melt
292 
293  ! max. melt
294  mmax = maxval(melt(is:ie,js:je))
295  call max_across_pes(mmax)
296  ! write(mesg,*) 'max melt = ', mmax
297  ! call MOM_mesg(mesg, 5)
298  ! dye melt water (m=1), dye = 1 if melt=max(melt)
299  do m=1,ntr
300  do j=js,je ; do i=is,ie
301  if (melt(i,j) > 0.0) then ! melting
302  cs%tr(i,j,1:2,m) = melt(i,j)/mmax ! inject dye in the ML
303  else ! freezing
304  cs%tr(i,j,1:2,m) = 0.0
305  endif
306  enddo ; enddo
307  enddo
308 
309  if (present(evap_cfl_limit) .and. present(minimum_forcing_depth)) then
310  do m=1,ntr
311  do k=1,nz ;do j=js,je ; do i=is,ie
312  h_work(i,j,k) = h_old(i,j,k)
313  enddo ; enddo ; enddo
314  call applytracerboundaryfluxesinout(g, gv, cs%tr(:,:,:,m), dt, fluxes, h_work, &
315  evap_cfl_limit, minimum_forcing_depth)
316  call tracer_vertdiff(h_work, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
317  enddo
318  else
319  do m=1,ntr
320  call tracer_vertdiff(h_old, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
321  enddo
322  endif
323 
324 end subroutine isomip_tracer_column_physics
325 
326 !> This subroutine extracts the surface fields from this tracer package that
327 !! are to be shared with the atmosphere in coupled configurations.
328 !! This particular tracer package does not report anything back to the coupler.
329 subroutine isomip_tracer_surface_state(state, h, G, CS)
330  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
331  type(surface), intent(inout) :: state !< A structure containing fields that
332  !! describe the surface state of the ocean.
333  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
334  intent(in) :: h !< Layer thickness [H ~> m or kg m-2].
335  type(isomip_tracer_cs), pointer :: cs !< The control structure returned by a previous
336  !! call to ISOMIP_register_tracer.
337 
338  ! This particular tracer package does not report anything back to the coupler.
339  ! The code that is here is just a rough guide for packages that would.
340 
341  integer :: m, is, ie, js, je, isd, ied, jsd, jed
342  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
343  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
344 
345  if (.not.associated(cs)) return
346 
347  if (cs%coupled_tracers) then
348  do m=1,ntr
349  ! This call loads the surface values into the appropriate array in the
350  ! coupler-type structure.
351  call coupler_type_set_data(cs%tr(:,:,1,m), cs%ind_tr(m), ind_csurf, &
352  state%tr_fields, idim=(/isd, is, ie, ied/), &
353  jdim=(/jsd, js, je, jed/) )
354  enddo
355  endif
356 
357 end subroutine isomip_tracer_surface_state
358 
359 !> Deallocate any memory used by the ISOMIP tracer package
360 subroutine isomip_tracer_end(CS)
361  type(isomip_tracer_cs), pointer :: cs !< The control structure returned by a previous
362  !! call to ISOMIP_register_tracer.
363  integer :: m
364 
365  if (associated(cs)) then
366  if (associated(cs%tr)) deallocate(cs%tr)
367  deallocate(cs)
368  endif
369 end subroutine isomip_tracer_end
370 
371 end module isomip_tracer
mom_time_manager
Wraps the FMS time manager functions.
Definition: MOM_time_manager.F90:2
mom_tracer_registry::register_tracer
subroutine, public register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, units, cmor_name, cmor_units, cmor_longname, tr_desc, OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, df_x, df_y, ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, flux_nameroot, flux_longname, flux_units, flux_scale, convergence_units, convergence_scale, cmor_tendprefix, diag_form, restart_CS, mandatory)
This subroutine registers a tracer to be advected and laterally diffused.
Definition: MOM_tracer_registry.F90:158
mom_variables::surface
Pointers to various fields which may be used describe the surface state of MOM, and which will be ret...
Definition: MOM_variables.F90:38
mom_io::var_desc
type(vardesc) function, public var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, cmor_units, cmor_longname, conversion, caller)
Returns a vardesc type whose elements have been filled with the provided fields. The argument name is...
Definition: MOM_io.F90:600
mom_io::query_vardesc
subroutine, public query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, cmor_units, cmor_longname, conversion, caller)
This routine queries vardesc.
Definition: MOM_io.F90:699
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
mom_tracer_diabatic::applytracerboundaryfluxesinout
subroutine, public applytracerboundaryfluxesinout(G, GV, Tr, dt, fluxes, h, evap_CFL_limit, minimum_forcing_depth, in_flux_optional, out_flux_optional, update_h_opt)
This routine is modeled after applyBoundaryFluxesInOut in MOM_diabatic_aux.F90 NOTE: Please note that...
Definition: MOM_tracer_diabatic.F90:230
mom_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_ale_sponge::ale_sponge_cs
ALE sponge control structure.
Definition: MOM_ALE_sponge.F90:84
isomip_tracer::ntr
integer, parameter ntr
ntr is the number of tracers in this module.
Definition: ISOMIP_tracer.F90:42
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
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_ale_sponge
This module contains the routines used to apply sponge layers when using the ALE mode.
Definition: MOM_ALE_sponge.F90:11
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_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_coms
Interfaces to non-domain-oriented communication subroutines, including the MOM6 reproducing sums faci...
Definition: MOM_coms.F90:3
mom_forcing_type
This module implements boundary forcing for MOM6.
Definition: MOM_forcing_type.F90:2
mom_ale_sponge::set_up_ale_sponge_field
Store the reference profile at h points for a variable.
Definition: MOM_ALE_sponge.F90:33
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
mom_io::mom_read_data
Read a data field from a file.
Definition: MOM_io.F90:74
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_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
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
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
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
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
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
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
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
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
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