MOM6
MOM_generic_tracer.F90
Go to the documentation of this file.
2 
3 ! This file is part of MOM6. See LICENSE.md for the license.
4 
5 #include <MOM_memory.h>
6 
7 #ifdef _USE_GENERIC_TRACER
8 #include <fms_platform.h>
9 
10  use mpp_mod, only: stdout, mpp_error, fatal,warning,note
11  use field_manager_mod, only: fm_get_index,fm_string_len
12 
13  use generic_tracer, only: generic_tracer_register, generic_tracer_get_diag_list
14  use generic_tracer, only: generic_tracer_init, generic_tracer_source, generic_tracer_register_diag
15  use generic_tracer, only: generic_tracer_coupler_get, generic_tracer_coupler_set
16  use generic_tracer, only: generic_tracer_end, generic_tracer_get_list, do_generic_tracer
17  use generic_tracer, only: generic_tracer_update_from_bottom,generic_tracer_vertdiff_g
18  use generic_tracer, only: generic_tracer_coupler_accumulate
19 
20  use g_tracer_utils, only: g_tracer_get_name,g_tracer_set_values,g_tracer_set_common,g_tracer_get_common
21  use g_tracer_utils, only: g_tracer_get_next,g_tracer_type,g_tracer_is_prog,g_tracer_flux_init
22  use g_tracer_utils, only: g_tracer_send_diag,g_tracer_get_values
23  use g_tracer_utils, only: g_tracer_get_pointer,g_tracer_get_alias,g_tracer_set_csdiag
24 
25  use mom_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
27  use mom_error_handler, only : mom_error, fatal, warning, note, is_root_pe
29  use mom_forcing_type, only : forcing, optics_type
30  use mom_grid, only : ocean_grid_type
31  use mom_hor_index, only : hor_index_type
32  use mom_io, only : file_exists, mom_read_data, slasher
37  use mom_time_manager, only : time_type, set_time
46 
47 
48  implicit none ; private
49  logical :: g_registered = .false.
50 
51  public register_mom_generic_tracer, initialize_mom_generic_tracer
52  public mom_generic_tracer_column_physics, mom_generic_tracer_surface_state
53  public end_mom_generic_tracer, mom_generic_tracer_get
54  public mom_generic_tracer_stock
55  public mom_generic_flux_init
56  public mom_generic_tracer_min_max
57  public mom_generic_tracer_fluxes_accumulate
58 
59  type, public :: mom_generic_tracer_cs ; private
60  character(len = 200) :: IC_file ! The file in which the generic tracer initial values can
61  ! be found, or an empty string for internal initialization.
62  logical :: Z_IC_file ! If true, the generic_tracer IC_file is in Z-space. The default is false.
63  real :: tracer_IC_val = 0.0 ! The initial value assigned to tracers.
64  real :: tracer_land_val = -1.0 ! The values of tracers used where land is masked out.
65  logical :: tracers_may_reinit ! If true, tracers may go through the
66  ! initialization code if they are not found in the
67  ! restart files.
68 
69  type(diag_ctrl), pointer :: diag => null() ! A structure that is used to
70  ! regulate the timing of diagnostic output.
71  type(MOM_restart_CS), pointer :: restart_CSp => null()
72 
73  ! The following pointer will be directed to the first element of the
74  ! linked list of generic tracers.
75  type(g_tracer_type), pointer :: g_tracer_list => null()
76 
77  integer :: H_to_m !Auxiliary to access GV%H_to_m in routines that do not have access to GV
78 
79  end type mom_generic_tracer_cs
80 
81 ! This include declares and sets the variable "version".
82 #include "version_variable.h"
83 
84 contains
85 
86  !> Initializes the generic tracer packages and adds their tracers to the list
87  !! Adds the tracers in the list of generic tracers to the set of MOM tracers (i.e., MOM-register them)
88  !! Register these tracers for restart
89  function register_mom_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
90  type(hor_index_type), intent(in) :: HI !< Horizontal index ranges
91  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
92  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
93  type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module
94  type(tracer_registry_type), pointer :: tr_Reg !< Pointer to the control structure for the tracer
95  !! advection and diffusion module.
96  type(MOM_restart_CS), pointer :: restart_CS !< Pointer to the restart control structure.
97 
98 ! Local variables
99  logical :: register_MOM_generic_tracer
100 
101  character(len=fm_string_len), parameter :: sub_name = 'register_MOM_generic_tracer'
102  character(len=200) :: inputdir ! The directory where NetCDF input files are.
103  ! These can be overridden later in via the field manager?
104 
105  integer :: ntau, k,i,j,axes(3)
106  type(g_tracer_type), pointer :: g_tracer,g_tracer_next
107  character(len=fm_string_len) :: g_tracer_name,longname,units
108  real, dimension(:,:,:,:), pointer :: tr_field
109  real, dimension(:,:,:), pointer :: tr_ptr
110  real, dimension(HI%isd:HI%ied, HI%jsd:HI%jed,GV%ke) :: grid_tmask
111  integer, dimension(HI%isd:HI%ied, HI%jsd:HI%jed) :: grid_kmt
112 
113  register_mom_generic_tracer = .false.
114  if (associated(cs)) then
115  call mpp_error(warning, "register_MOM_generic_tracer called with an "// &
116  "associated control structure.")
117  return
118  endif
119  allocate(cs)
120 
121 
122  !Register all the generic tracers used and create the list of them.
123  !This can be called by ALL PE's. No array fields allocated.
124  if (.not. g_registered) then
125  call generic_tracer_register
126  g_registered = .true.
127  endif
128 
129 
130  ! Read all relevant parameters and write them to the model log.
131  call log_version(param_file, sub_name, version, "")
132  call get_param(param_file, sub_name, "GENERIC_TRACER_IC_FILE", cs%IC_file, &
133  "The file in which the generic trcer initial values can "//&
134  "be found, or an empty string for internal initialization.", &
135  default=" ")
136  if ((len_trim(cs%IC_file) > 0) .and. (scan(cs%IC_file,'/') == 0)) then
137  ! Add the directory if CS%IC_file is not already a complete path.
138  call get_param(param_file, sub_name, "INPUTDIR", inputdir, default=".")
139  cs%IC_file = trim(slasher(inputdir))//trim(cs%IC_file)
140  call log_param(param_file, sub_name, "INPUTDIR/GENERIC_TRACER_IC_FILE", cs%IC_file)
141  endif
142  call get_param(param_file, sub_name, "GENERIC_TRACER_IC_FILE_IS_Z", cs%Z_IC_file, &
143  "If true, GENERIC_TRACER_IC_FILE is in depth space, not "//&
144  "layer space.",default=.false.)
145  call get_param(param_file, sub_name, "TRACERS_MAY_REINIT", cs%tracers_may_reinit, &
146  "If true, tracers may go through the initialization code "//&
147  "if they are not found in the restart files. Otherwise "//&
148  "it is a fatal error if tracers are not found in the "//&
149  "restart files of a restarted run.", default=.false.)
150 
151  cs%restart_CSp => restart_cs
152 
153 
154  ntau=1 ! MOM needs the fields at only one time step
155 
156 
157  ! At this point G%mask2dT and CS%diag%axesTL are not allocated.
158  ! postpone diag_registeration to initialize_MOM_generic_tracer
159 
160  !Fields cannot be diag registered as they are allocated and have to registered later.
161  grid_tmask(:,:,:) = 0.0
162  grid_kmt(:,:) = 0.0
163  axes(:) = -1
164 
165  !
166  ! Initialize all generic tracers
167  !
168  call generic_tracer_init(hi%isc,hi%iec,hi%jsc,hi%jec,hi%isd,hi%ied,hi%jsd,hi%jed,&
169  gv%ke,ntau,axes,grid_tmask,grid_kmt,set_time(0,0))
170 
171 
172  !
173  ! MOM-register the generic tracers
174  !
175 
176  !Get the tracer list
177  call generic_tracer_get_list(cs%g_tracer_list)
178  if (.NOT. associated(cs%g_tracer_list)) call mpp_error(fatal, trim(sub_name)//&
179  ": No tracer in the list.")
180  ! For each tracer name get its T_prog index and get its fields
181 
182  g_tracer=>cs%g_tracer_list
183  do
184  call g_tracer_get_alias(g_tracer,g_tracer_name)
185 
186  call g_tracer_get_pointer(g_tracer,g_tracer_name,'field',tr_field)
187  call g_tracer_get_values(g_tracer,g_tracer_name,'longname', longname)
188  call g_tracer_get_values(g_tracer,g_tracer_name,'units',units )
189 
190  !!nnz: MOM field is 3D. Does this affect performance? Need it be override field?
191  tr_ptr => tr_field(:,:,:,1)
192  ! Register prognastic tracer for horizontal advection, diffusion, and restarts.
193  if (g_tracer_is_prog(g_tracer)) then
194  call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, &
195  name=g_tracer_name, longname=longname, units=units, &
196  registry_diags=.false., & !### CHANGE TO TRUE?
197  restart_cs=restart_cs, mandatory=.not.cs%tracers_may_reinit)
198  else
199  call register_restart_field(tr_ptr, g_tracer_name, .not.cs%tracers_may_reinit, &
200  restart_cs, longname=longname, units=units)
201  endif
202 
203  !traverse the linked list till hit NULL
204  call g_tracer_get_next(g_tracer, g_tracer_next)
205  if (.NOT. associated(g_tracer_next)) exit
206  g_tracer=>g_tracer_next
207 
208  enddo
209 
210  register_mom_generic_tracer = .true.
211  end function register_mom_generic_tracer
212 
213  !> Initialize phase II: Initialize required variables for generic tracers
214  !! There are some steps of initialization that cannot be done in register_MOM_generic_tracer
215  !! This is the place and time to do them:
216  !! Set the grid mask and initial time for all generic tracers.
217  !! Diag_register them.
218  !! Z_diag_register them.
219  !!
220  !! This subroutine initializes the NTR tracer fields in tr(:,:,:,:)
221  !! and it sets up the tracer output.
222  subroutine initialize_mom_generic_tracer(restart, day, G, GV, US, h, param_file, diag, OBC, CS, &
223  sponge_CSp, ALE_sponge_CSp)
224  logical, intent(in) :: restart !< .true. if the fields have already been
225  !! read from a restart file.
226  type(time_type), target, intent(in) :: day !< Time of the start of the run.
227  type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
228  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
229  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
230  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
231  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
232  type(diag_ctrl), target, intent(in) :: diag !< Regulates diagnostic output.
233  type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether,
234  !! where, and what open boundary conditions are used.
235  type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
236  type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges.
237  type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< Pointer to the control structure for the
238  !! ALE sponges.
239 
240  character(len=fm_string_len), parameter :: sub_name = 'initialize_MOM_generic_tracer'
241  logical :: OK
242  integer :: i, j, k, isc, iec, jsc, jec, nk
243  type(g_tracer_type), pointer :: g_tracer,g_tracer_next
244  character(len=fm_string_len) :: g_tracer_name
245  real, dimension(:,:,:,:), pointer :: tr_field
246  real, dimension(:,:,:), pointer :: tr_ptr
247  real, dimension(G%isd:G%ied, G%jsd:G%jed,1:G%ke) :: grid_tmask
248  integer, dimension(G%isd:G%ied, G%jsd:G%jed) :: grid_kmt
249 
250  !! 2010/02/04 Add code to re-initialize Generic Tracers if needed during a model simulation
251  !! By default, restart cpio should not contain a Generic Tracer IC file and step below will be skipped.
252  !! Ideally, the generic tracer IC file should have the tracers on Z levels.
253 
254  isc = g%isc ; iec = g%iec ; jsc = g%jsc ; jec = g%jec ; nk = g%ke
255 
256  cs%diag=>diag
257  !Get the tracer list
258  if (.NOT. associated(cs%g_tracer_list)) call mpp_error(fatal, trim(sub_name)//&
259  ": No tracer in the list.")
260  !For each tracer name get its fields
261  g_tracer=>cs%g_tracer_list
262 
263  do
264  if (index(cs%IC_file, '_NULL_') /= 0) then
265  call mom_error(warning,"The name of the IC_file "//trim(cs%IC_file)//&
266  " indicates no MOM initialization was asked for the generic tracers."//&
267  "Bypassing the MOM initialization of ALL generic tracers!")
268  exit
269  endif
270  call g_tracer_get_alias(g_tracer,g_tracer_name)
271  call g_tracer_get_pointer(g_tracer,g_tracer_name,'field',tr_field)
272  tr_ptr => tr_field(:,:,:,1)
273 
274  if (.not.restart .or. (cs%tracers_may_reinit .and. &
275  .not.query_initialized(tr_ptr, g_tracer_name, cs%restart_CSp))) then
276 
277  if (g_tracer%requires_src_info ) then
278  call mom_error(note,"initialize_MOM_generic_tracer: "//&
279  "initializing generic tracer "//trim(g_tracer_name)//&
280  " using MOM_initialize_tracer_from_Z ")
281 
282  call mom_initialize_tracer_from_z(h, tr_ptr, g, gv, us, param_file, &
283  src_file = g_tracer%src_file, &
284  src_var_nam = g_tracer%src_var_name, &
285  src_var_unit_conversion = g_tracer%src_var_unit_conversion,&
286  src_var_record = g_tracer%src_var_record, &
287  src_var_gridspec = g_tracer%src_var_gridspec )
288 
289  !Check/apply the bounds for each g_tracer
290  do k=1,nk ; do j=jsc,jec ; do i=isc,iec
291  if (tr_ptr(i,j,k) /= cs%tracer_land_val) then
292  if (tr_ptr(i,j,k) < g_tracer%src_var_valid_min) tr_ptr(i,j,k) = g_tracer%src_var_valid_min
293  !Jasmin does not want to apply the maximum for now
294  !if (tr_ptr(i,j,k) > g_tracer%src_var_valid_max) tr_ptr(i,j,k) = g_tracer%src_var_valid_max
295  endif
296  enddo ; enddo ; enddo
297 
298  !jgj: Reset CASED to 0 below K=1
299  if ( (trim(g_tracer_name) == 'cased') .or. (trim(g_tracer_name) == 'ca13csed') ) then
300  do k=2,nk ; do j=jsc,jec ; do i=isc,iec
301  if (tr_ptr(i,j,k) /= cs%tracer_land_val) then
302  tr_ptr(i,j,k) = 0.0
303  endif
304  enddo ; enddo ; enddo
305  endif
306  elseif(.not. g_tracer%requires_restart) then
307  !Do nothing for this tracer, it is initialized by the tracer package
308  call mom_error(note,"initialize_MOM_generic_tracer: "//&
309  "skip initialization of generic tracer "//trim(g_tracer_name))
310  else !Do it old way if the tracer is not registered to start from a specific source file.
311  !This path should be deprecated if all generic tracers are required to start from specified sources.
312  if (len_trim(cs%IC_file) > 0) then
313  ! Read the tracer concentrations from a netcdf file.
314  if (.not.file_exists(cs%IC_file)) call mom_error(fatal, &
315  "initialize_MOM_Generic_tracer: Unable to open "//cs%IC_file)
316  if (cs%Z_IC_file) then
317  ok = tracer_z_init(tr_ptr, h, cs%IC_file, g_tracer_name, g, us)
318  if (.not.ok) then
319  ok = tracer_z_init(tr_ptr, h, cs%IC_file, trim(g_tracer_name), g, us)
320  if (.not.ok) call mom_error(fatal,"initialize_MOM_Generic_tracer: "//&
321  "Unable to read "//trim(g_tracer_name)//" from "//&
322  trim(cs%IC_file)//".")
323  endif
324  call mom_error(note,"initialize_MOM_generic_tracer: "//&
325  "initialized generic tracer "//trim(g_tracer_name)//&
326  " using Generic Tracer File on Z: "//cs%IC_file)
327  else
328  ! native grid
329  call mom_error(note,"initialize_MOM_generic_tracer: "//&
330  "Using Generic Tracer IC file on native grid "//trim(cs%IC_file)//&
331  " for tracer "//trim(g_tracer_name))
332  call mom_read_data(cs%IC_file, trim(g_tracer_name), tr_ptr, g%Domain)
333  endif
334  else
335  call mom_error(fatal,"initialize_MOM_generic_tracer: "//&
336  "check Generic Tracer IC filename "//trim(cs%IC_file)//&
337  " for tracer "//trim(g_tracer_name))
338  endif
339 
340  endif
341  endif
342 
343  !traverse the linked list till hit NULL
344  call g_tracer_get_next(g_tracer, g_tracer_next)
345  if (.NOT. associated(g_tracer_next)) exit
346  g_tracer=>g_tracer_next
347  enddo
348  !! end section to re-initialize generic tracers
349 
350 
351  !Now we can reset the grid mask, axes and time to their true values
352  !Note that grid_tmask must be set correctly on the data domain boundary
353  !so that coast mask can be deduced from it.
354  grid_tmask(:,:,:) = 0.0
355  grid_kmt(:,:) = 0
356  do j = g%jsd, g%jed ; do i = g%isd, g%ied
357  if (g%mask2dT(i,j) > 0) then
358  grid_tmask(i,j,:) = 1.0
359  grid_kmt(i,j) = g%ke ! Tell the code that a layer thicker than 1m is the bottom layer.
360  endif
361  enddo ; enddo
362  call g_tracer_set_common(g%isc,g%iec,g%jsc,g%jec,g%isd,g%ied,g%jsd,g%jed,&
363  gv%ke,1,cs%diag%axesTL%handles,grid_tmask,grid_kmt,day)
364 
365  ! Register generic tracer modules diagnostics
366 
367 #ifdef _USE_MOM6_DIAG
368  call g_tracer_set_csdiag(cs%diag)
369 #endif
370  call generic_tracer_register_diag()
371 #ifdef _USE_MOM6_DIAG
372  call g_tracer_set_csdiag(cs%diag)
373 #endif
374 
375  cs%H_to_m = gv%H_to_m
376 
377  end subroutine initialize_mom_generic_tracer
378 
379  !> Column physics for generic tracers.
380  !! Get the coupler values for generic tracers that exchange with atmosphere
381  !! Update generic tracer concentration fields from sources and sinks.
382  !! Vertically diffuse generic tracer concentration fields.
383  !! Update generic tracers from bottom and their bottom reservoir.
384  !!
385  !! This subroutine applies diapycnal diffusion and any other column
386  !! tracer physics or chemistry to the tracers from this file.
387  !! CFCs are relatively simple, as they are passive tracers. with only a surface
388  !! flux as a source.
389  subroutine mom_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, CS, tv, optics, &
390  evap_CFL_limit, minimum_forcing_depth)
391  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
392  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
393  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
394  intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2].
395  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
396  intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2].
397  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
398  intent(in) :: ea !< The amount of fluid entrained from the layer
399  !! above during this call [H ~> m or kg m-2].
400  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
401  intent(in) :: eb !< The amount of fluid entrained from the layer
402  !! below during this call [H ~> m or kg m-2].
403  type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic
404  !! and tracer forcing fields.
405  real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hml !< Mixed layer depth [H ~> m or kg m-2]
406  real, intent(in) :: dt !< The amount of time covered by this call [s]
407  type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
408  type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
409  type(optics_type), intent(in) :: optics !< The structure containing optical properties.
410  real, optional, intent(in) :: evap_CFL_limit !< Limits how much water can be fluxed out of
411  !! the top layer Stored previously in diabatic CS.
412  real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes
413  !! can be applied [H ~> m or kg m-2]
414  ! Stored previously in diabatic CS.
415  ! The arguments to this subroutine are redundant in that
416  ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1)
417 
418  ! Local variables
419  character(len=fm_string_len), parameter :: sub_name = 'MOM_generic_tracer_column_physics'
420 
421  type(g_tracer_type), pointer :: g_tracer, g_tracer_next
422  character(len=fm_string_len) :: g_tracer_name
423  real, dimension(:,:), pointer :: stf_array,trunoff_array,runoff_tracer_flux_array
424 
425  real :: surface_field(SZI_(G),SZJ_(G))
426  real :: sosga
427 
428  real, dimension(G%isd:G%ied,G%jsd:G%jed,G%ke) :: rho_dzt, dzt
429  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
430  integer :: i, j, k, isc, iec, jsc, jec, nk
431 
432  isc = g%isc ; iec = g%iec ; jsc = g%jsc ; jec = g%jec ; nk = g%ke
433 
434  !Get the tracer list
435  if (.NOT. associated(cs%g_tracer_list)) call mpp_error(fatal,&
436  trim(sub_name)//": No tracer in the list.")
437 
438 #ifdef _USE_MOM6_DIAG
439  call g_tracer_set_csdiag(cs%diag)
440 #endif
441 
442  !
443  !Extract the tracer surface fields from coupler and update tracer fields from sources
444  !
445  !call generic_tracer_coupler_get(fluxes%tr_fluxes)
446  !Niki: This is moved out to ocean_model_MOM.F90 because if dt_therm>dt_cpld we need to average
447  ! the fluxes without coming into this subroutine.
448  ! MOM5 has to modified to conform.
449 
450  !
451  !Add contribution of river to surface flux
452  !
453  g_tracer=>cs%g_tracer_list
454  do
455  if (_allocated(g_tracer%trunoff)) then
456  call g_tracer_get_alias(g_tracer,g_tracer_name)
457  call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array)
458  call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array)
459  call g_tracer_get_pointer(g_tracer,g_tracer_name,'runoff_tracer_flux',runoff_tracer_flux_array)
460  !nnz: Why is fluxes%river = 0?
461  runoff_tracer_flux_array(:,:) = trunoff_array(:,:) * &
462  g%US%R_to_kg_m3*g%US%Z_to_m*g%US%s_to_T*fluxes%lrunoff(:,:)
463  stf_array = stf_array + runoff_tracer_flux_array
464  endif
465 
466  !traverse the linked list till hit NULL
467  call g_tracer_get_next(g_tracer, g_tracer_next)
468  if (.NOT. associated(g_tracer_next)) exit
469  g_tracer=>g_tracer_next
470 
471  enddo
472 
473  !
474  !Prepare input arrays for source update
475  !
476 
477  rho_dzt(:,:,:) = gv%H_to_kg_m2 * gv%Angstrom_H
478  do k = 1, nk ; do j = jsc, jec ; do i = isc, iec !{
479  rho_dzt(i,j,k) = gv%H_to_kg_m2 * h_old(i,j,k)
480  enddo ; enddo ; enddo !}
481 
482  dzt(:,:,:) = 1.0
483  do k = 1, nk ; do j = jsc, jec ; do i = isc, iec !{
484  dzt(i,j,k) = gv%H_to_m * h_old(i,j,k)
485  enddo ; enddo ; enddo !}
486 
487  do j=jsc,jec ; do i=isc,iec
488  surface_field(i,j) = tv%S(i,j,1)
489  enddo ; enddo
490  sosga = global_area_mean(surface_field, g)
491 
492  !
493  !Calculate tendencies (i.e., field changes at dt) from the sources / sinks
494  !
495 
496  call generic_tracer_source(tv%T,tv%S,rho_dzt,dzt,hml,g%isd,g%jsd,1,dt,&
497  g%US%L_to_m**2*g%areaT(:,:), get_diag_time_end(cs%diag), &
498  optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, &
499  internal_heat=tv%internal_heat, &
500  frunoff=g%US%R_to_kg_m3*g%US%Z_to_m*g%US%s_to_T*fluxes%frunoff(:,:), sosga=sosga)
501 
502  ! This uses applyTracerBoundaryFluxesInOut to handle the change in tracer due to freshwater fluxes
503  ! usually in ALE mode
504  if (present(evap_cfl_limit) .and. present(minimum_forcing_depth)) then
505  g_tracer=>cs%g_tracer_list
506  do
507  if (g_tracer_is_prog(g_tracer)) then
508  do k=1,nk ;do j=jsc,jec ; do i=isc,iec
509  h_work(i,j,k) = h_old(i,j,k)
510  enddo ; enddo ; enddo
511  call applytracerboundaryfluxesinout(g, gv, g_tracer%field(:,:,:,1), g%US%s_to_T*dt, &
512  fluxes, h_work, evap_cfl_limit, minimum_forcing_depth)
513  endif
514 
515  !traverse the linked list till hit NULL
516  call g_tracer_get_next(g_tracer, g_tracer_next)
517  if (.NOT. associated(g_tracer_next)) exit
518  g_tracer=>g_tracer_next
519  enddo
520  endif
521 
522  !
523  !Update Tr(n)%field from explicit vertical diffusion
524  !
525  ! Use a tridiagonal solver to determine the concentrations after the
526  ! surface source is applied and diapycnal advection and diffusion occurs.
527  if (present(evap_cfl_limit) .and. present(minimum_forcing_depth)) then
528  ! Last arg is tau which is always 1 for MOM6
529  call generic_tracer_vertdiff_g(h_work, ea, eb, dt, gv%kg_m2_to_H, gv%m_to_H, 1)
530  else
531  ! Last arg is tau which is always 1 for MOM6
532  call generic_tracer_vertdiff_g(h_old, ea, eb, dt, gv%kg_m2_to_H, gv%m_to_H, 1)
533  endif
534 
535  ! Update bottom fields after vertical processes
536 
537  ! Second arg is tau which is always 1 for MOM6
538  call generic_tracer_update_from_bottom(dt, 1, get_diag_time_end(cs%diag))
539 
540  !Output diagnostics via diag_manager for all generic tracers and their fluxes
541  call g_tracer_send_diag(cs%g_tracer_list, get_diag_time_end(cs%diag), tau=1)
542 #ifdef _USE_MOM6_DIAG
543  call g_tracer_set_csdiag(cs%diag)
544 #endif
545 
546  end subroutine mom_generic_tracer_column_physics
547 
548  !> This subroutine calculates mass-weighted integral on the PE either
549  !! of all available tracer concentrations, or of a tracer that is
550  !! being requested specifically, returning the number of stocks it has
551  !! calculated. If the stock_index is present, only the stock corresponding
552  !! to that coded index is returned.
553  function mom_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index)
554  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
555  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
556  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
557  real, dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each
558  !! tracer, in kg times concentration units [kg conc].
559  type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
560  character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated.
561  character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated.
562  integer, optional, intent(in) :: stock_index !< The coded index of a specific stock
563  !! being sought.
564  integer :: MOM_generic_tracer_stock !< Return value, the
565  !! number of stocks calculated here.
566 
567 ! Local variables
568  type(g_tracer_type), pointer :: g_tracer, g_tracer_next
569  real, dimension(:,:,:,:), pointer :: tr_field
570  real, dimension(:,:,:), pointer :: tr_ptr
571  character(len=fm_string_len), parameter :: sub_name = 'MOM_generic_tracer_stock'
572 
573  integer :: i, j, k, is, ie, js, je, nz, m
574  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
575 
576  mom_generic_tracer_stock = 0
577  if (.not.associated(cs)) return
578 
579  if (present(stock_index)) then ; if (stock_index > 0) then
580  ! Check whether this stock is available from this routine.
581 
582  ! No stocks from this routine are being checked yet. Return 0.
583  return
584  endif ; endif
585 
586  if (.NOT. associated(cs%g_tracer_list)) return ! No stocks.
587 
588  m=1 ; g_tracer=>cs%g_tracer_list
589  do
590  call g_tracer_get_alias(g_tracer,names(m))
591  call g_tracer_get_values(g_tracer,names(m),'units',units(m))
592  units(m) = trim(units(m))//" kg"
593  call g_tracer_get_pointer(g_tracer,names(m),'field',tr_field)
594 
595  stocks(m) = 0.0
596  tr_ptr => tr_field(:,:,:,1)
597  do k=1,nz ; do j=js,je ; do i=is,ie
598  stocks(m) = stocks(m) + tr_ptr(i,j,k) * &
599  (g%mask2dT(i,j) * g%US%L_to_m**2*g%areaT(i,j) * h(i,j,k))
600  enddo ; enddo ; enddo
601  stocks(m) = gv%H_to_kg_m2 * stocks(m)
602 
603  !traverse the linked list till hit NULL
604  call g_tracer_get_next(g_tracer, g_tracer_next)
605  if (.NOT. associated(g_tracer_next)) exit
606  g_tracer=>g_tracer_next
607  m = m+1
608  enddo
609 
610  mom_generic_tracer_stock = m
611 
612  end function mom_generic_tracer_stock
613 
614  !> This subroutine find the global min and max of either of all
615  !! available tracer concentrations, or of a tracer that is being
616  !! requested specifically, returning the number of tracers it has gone through.
617  function mom_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, ygmin, zgmin, &
618  xgmax, ygmax, zgmax , G, CS, names, units)
619  use mpp_utilities_mod, only: mpp_array_global_min_max
620  integer, intent(in) :: ind_start !< The index of the tracer to start with
621  logical, dimension(:), intent(out) :: got_minmax !< Indicates whether the global min and
622  !! max are found for each tracer
623  real, dimension(:), intent(out) :: gmin !< Global minimum of each tracer, in kg
624  !! times concentration units.
625  real, dimension(:), intent(out) :: gmax !< Global maximum of each tracer, in kg
626  !! times concentration units.
627  real, dimension(:), intent(out) :: xgmin !< The x-position of the global minimum
628  real, dimension(:), intent(out) :: ygmin !< The y-position of the global minimum
629  real, dimension(:), intent(out) :: zgmin !< The z-position of the global minimum
630  real, dimension(:), intent(out) :: xgmax !< The x-position of the global maximum
631  real, dimension(:), intent(out) :: ygmax !< The y-position of the global maximum
632  real, dimension(:), intent(out) :: zgmax !< The z-position of the global maximum
633  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
634  type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
635  character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated.
636  character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated.
637  integer :: MOM_generic_tracer_min_max !< Return value, the
638  !! number of tracers done here.
639 
640 ! Local variables
641  type(g_tracer_type), pointer :: g_tracer, g_tracer_next
642  real, dimension(:,:,:,:), pointer :: tr_field
643  real, dimension(:,:,:), pointer :: tr_ptr
644  character(len=fm_string_len), parameter :: sub_name = 'MOM_generic_tracer_min_max'
645 
646  real, dimension(:,:,:),pointer :: grid_tmask
647  integer :: isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau
648 
649  integer :: i, j, k, is, ie, js, je, nz, m
650  real, allocatable, dimension(:) :: geo_z
651 
652  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
653 
654  mom_generic_tracer_min_max = 0
655  if (.not.associated(cs)) return
656 
657  if (.NOT. associated(cs%g_tracer_list)) return ! No stocks.
658 
659 
660  call g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,grid_tmask=grid_tmask)
661 
662  ! Because the use of a simple z-coordinate can not be assumed, simply
663  ! use the layer index as the vertical label.
664  allocate(geo_z(nk))
665  do k=1,nk ; geo_z(k) = real(k) ; enddo
666 
667  m=ind_start ; g_tracer=>cs%g_tracer_list
668  do
669  call g_tracer_get_alias(g_tracer,names(m))
670  call g_tracer_get_values(g_tracer,names(m),'units',units(m))
671  units(m) = trim(units(m))//" kg"
672  call g_tracer_get_pointer(g_tracer,names(m),'field',tr_field)
673 
674  gmin(m) = -1.0
675  gmax(m) = -1.0
676 
677  tr_ptr => tr_field(:,:,:,1)
678 
679  call mpp_array_global_min_max(tr_ptr, grid_tmask,isd,jsd,isc,iec,jsc,jec,nk , gmin(m), gmax(m), &
680  g%geoLonT,g%geoLatT,geo_z,xgmin(m), ygmin(m), zgmin(m), &
681  xgmax(m), ygmax(m), zgmax(m))
682 
683  got_minmax(m) = .true.
684 
685  !traverse the linked list till hit NULL
686  call g_tracer_get_next(g_tracer, g_tracer_next)
687  if (.NOT. associated(g_tracer_next)) exit
688  g_tracer=>g_tracer_next
689  m = m+1
690  enddo
691 
692  mom_generic_tracer_min_max = m
693 
694  end function mom_generic_tracer_min_max
695 
696 
697  !> This subroutine calculates the surface state and sets coupler values for
698  !! those generic tracers that have flux exchange with atmosphere.
699  !!
700  !! This subroutine sets up the fields that the coupler needs to calculate the
701  !! CFC fluxes between the ocean and atmosphere.
702  subroutine mom_generic_tracer_surface_state(state, h, G, CS)
703  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
704  type(surface), intent(inout) :: state !< A structure containing fields that
705  !! describe the surface state of the ocean.
706  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
707  type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
708 
709 ! Local variables
710  real :: sosga
711 
712  character(len=fm_string_len), parameter :: sub_name = 'MOM_generic_tracer_surface_state'
713  real, dimension(G%isd:G%ied,G%jsd:G%jed,1:G%ke,1) :: rho0
714  real, dimension(G%isd:G%ied,G%jsd:G%jed,1:G%ke) :: dzt
715  type(g_tracer_type), pointer :: g_tracer
716 
717  !Set coupler values
718  !nnz: fake rho0
719  rho0=1.0
720 
721  dzt(:,:,:) = cs%H_to_m * h(:,:,:)
722 
723  sosga = global_area_mean(state%SSS, g)
724 
725  call generic_tracer_coupler_set(state%tr_fields,&
726  st=state%SST,&
727  ss=state%SSS,&
728  rho=rho0,& !nnz: required for MOM5 and previous versions.
729  ilb=g%isd, jlb=g%jsd,&
730  dzt=dzt,& !This is needed for the Mocsy method of carbonate system vars
731  tau=1,sosga=sosga,model_time=get_diag_time_end(cs%diag))
732 
733  !Output diagnostics via diag_manager for all tracers in this module
734 ! if (.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL, trim(sub_name)//&
735 ! "No tracer in the list.")
736 ! call g_tracer_send_diag(CS%g_tracer_list, get_diag_time_end(CS%diag), tau=1)
737  !Niki: The problem with calling diagnostic outputs here is that this subroutine is called every dt_cpld
738  ! hence if dt_therm > dt_cpld we get output (and contribution to the mean) at times that tracers
739  ! had not been updated.
740  ! Moving this to the end of column physics subrotuine fixes this issue.
741 
742  end subroutine mom_generic_tracer_surface_state
743 
744 !ALL PE subroutine on Ocean! Due to otpm design the fluxes should be initialized like this on ALL PE's!
745  subroutine mom_generic_flux_init(verbosity)
746  integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity.
747 
748  integer :: ind
749  character(len=fm_string_len) :: g_tracer_name,longname, package,units,old_package,file_in,file_out
750  real :: const_init_value
751  character(len=fm_string_len), parameter :: sub_name = 'MOM_generic_flux_init'
752  type(g_tracer_type), pointer :: g_tracer_list,g_tracer,g_tracer_next
753 
754  if (.not. g_registered) then
755  call generic_tracer_register
756  g_registered = .true.
757  endif
758 
759  call generic_tracer_get_list(g_tracer_list)
760  if (.NOT. associated(g_tracer_list)) then
761  call mpp_error(warning, trim(sub_name)// ": No generic tracer in the list.")
762  return
763  endif
764 
765  g_tracer=>g_tracer_list
766  do
767 
768  call g_tracer_flux_init(g_tracer) !, verbosity=verbosity) !### Add this after ocean shared is updated.
769 
770  !traverse the linked list till hit NULL
771  call g_tracer_get_next(g_tracer, g_tracer_next)
772  if (.NOT. associated(g_tracer_next)) exit
773  g_tracer=>g_tracer_next
774 
775  enddo
776 
777  end subroutine mom_generic_flux_init
778 
779  subroutine mom_generic_tracer_fluxes_accumulate(flux_tmp, weight)
780  type(forcing), intent(in) :: flux_tmp !< A structure containing pointers to
781  !! thermodynamic and tracer forcing fields.
782  real, intent(in) :: weight !< A weight for accumulating this flux
783 
784  call generic_tracer_coupler_accumulate(flux_tmp%tr_fluxes, weight)
785 
786  end subroutine mom_generic_tracer_fluxes_accumulate
787 
788  !> Copy the requested tracer into an array.
789  subroutine mom_generic_tracer_get(name,member,array, CS)
790  character(len=*), intent(in) :: name !< Name of requested tracer.
791  character(len=*), intent(in) :: member !< The tracer element to return.
792  real, dimension(:,:,:), intent(out) :: array !< Array filled by this routine.
793  type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
794 
795  real, dimension(:,:,:), pointer :: array_ptr
796  character(len=fm_string_len), parameter :: sub_name = 'MOM_generic_tracer_get'
797 
798  call g_tracer_get_pointer(cs%g_tracer_list,name,member,array_ptr)
799  array(:,:,:) = array_ptr(:,:,:)
800 
801  end subroutine mom_generic_tracer_get
802 
803  !> This subroutine deallocates the memory owned by this module.
804  subroutine end_mom_generic_tracer(CS)
805  type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
806 
807  call generic_tracer_end
808 
809  if (associated(cs)) then
810  deallocate(cs)
811  endif
812  end subroutine end_mom_generic_tracer
813 
814 #endif /* _USE_GENERIC_TRACER */
815 !----------------------------------------------------------------
816 ! <CONTACT EMAIL="Niki.Zadeh@noaa.gov"> Niki Zadeh
817 ! </CONTACT>
818 !
819 ! <REVIEWER EMAIL="William.Cooke@noaa.gov"> William Cooke
820 ! </REVIEWER>
821 !
822 ! <OVERVIEW>
823 ! This module drives the generic version of tracers TOPAZ and CFC
824 ! </OVERVIEW>
825 !----------------------------------------------------------------
826 
827 end module mom_generic_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_spatial_means
Functions and routines to take area, volume, mass-weighted, layerwise, zonal or meridional means.
Definition: MOM_spatial_means.F90:2
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
mom_tracer_diabatic::applytracerboundaryfluxesinout
subroutine, public applytracerboundaryfluxesinout(G, GV, Tr, dt, fluxes, h, evap_CFL_limit, minimum_forcing_depth, in_flux_optional, out_flux_optional, update_h_opt)
This routine is modeled after applyBoundaryFluxesInOut in MOM_diabatic_aux.F90 NOTE: Please note that...
Definition: MOM_tracer_diabatic.F90:230
mom_sponge::set_up_sponge_field
subroutine, public set_up_sponge_field(sp_val, f_ptr, G, nlay, CS, sp_val_i_mean)
This subroutine stores the reference profile for the variable whose address is given by f_ptr....
Definition: MOM_sponge.F90:214
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
mom_diag_mediator
The subroutines here provide convenient wrappers to the fms diag_manager interfaces with additional d...
Definition: MOM_diag_mediator.F90:3
mom_variables::thermo_var_ptrs
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Definition: MOM_variables.F90:78
mom_diag_mediator::register_diag_field
integer function, public register_diag_field(module_name, field_name, axes_in, init_time, long_name, units, missing_value, range, mask_variant, standard_name, verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name, cell_methods, x_cell_method, y_cell_method, v_cell_method, conversion, v_extensive)
Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics derived fr...
Definition: MOM_diag_mediator.F90:1878
mom_ale_sponge::ale_sponge_cs
ALE sponge control structure.
Definition: MOM_ALE_sponge.F90:84
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_tracer_initialization_from_z
Initializes hydrography from z-coordinate climatology files.
Definition: MOM_tracer_initialization_from_Z.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_tracer_z_init
Used to initialize tracers from a depth- (or z*-) space file.
Definition: MOM_tracer_Z_init.F90:2
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
mom_tracer_diabatic
This module contains routines that implement physical fluxes of tracers (e.g. due to surface fluxes o...
Definition: MOM_tracer_diabatic.F90:4
mom_diag_mediator::post_data
Make a diagnostic available for averaging or output.
Definition: MOM_diag_mediator.F90:70
mom_generic_tracer
Definition: MOM_generic_tracer.F90:1
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_spatial_means::global_area_mean
real function, public global_area_mean(var, G, scale)
Return the global area mean of a variable. This uses reproducing sums.
Definition: MOM_spatial_means.F90:29
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_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_diag_mediator::get_diag_time_end
type(time_type) function, public get_diag_time_end(diag_cs)
This function returns the valid end time for use with diagnostics that are handled outside of the MOM...
Definition: MOM_diag_mediator.F90:1863
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_error_handler::is_root_pe
logical function, public is_root_pe()
This returns .true. if the current PE is the root PE.
Definition: MOM_error_handler.F90:44
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::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
mom_tracer_initialization_from_z::mom_initialize_tracer_from_z
subroutine, public mom_initialize_tracer_from_z(h, tr, G, GV, US, PF, src_file, src_var_nam, src_var_unit_conversion, src_var_record, homogenize, useALEremapping, remappingScheme, src_var_gridspec)
Initializes a tracer from a z-space data file.
Definition: MOM_tracer_initialization_from_Z.F90:49
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
mom_restart::query_initialized
Indicate whether a field has been read from a restart file.
Definition: MOM_restart.F90:116
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:26
mom_diag_mediator::diag_ctrl
The following data type a list of diagnostic fields an their variants, as well as variables that cont...
Definition: MOM_diag_mediator.F90:239