MOM6
dyed_obc_tracer.F90
Go to the documentation of this file.
1 !> This tracer package dyes flow through open boundaries
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_hor_index, only : hor_index_type
11 use mom_grid, only : ocean_grid_type
14 use mom_restart, only : mom_restart_cs
15 use mom_time_manager, only : time_type
19 use mom_variables, only : surface
21 
22 use coupler_types_mod, only : coupler_type_set_data, ind_csurf
24 
25 implicit none ; private
26 
27 #include <MOM_memory.h>
28 
31 
32 !> The control structure for the dyed_obc tracer package
33 type, public :: dyed_obc_tracer_cs ; private
34  integer :: ntr !< The number of tracers that are actually used.
35  logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
36  character(len=200) :: tracer_ic_file !< The full path to the IC file, or " " to initialize internally.
37  type(time_type), pointer :: time => null() !< A pointer to the ocean model's clock.
38  type(tracer_registry_type), pointer :: tr_reg => null() !< A pointer to the tracer registry
39  real, pointer :: tr(:,:,:,:) => null() !< The array of tracers used in this subroutine, in g m-3?
40 
41  integer, allocatable, dimension(:) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the
42  !! surface tracer concentrations are to be provided to the coupler.
43 
44  type(diag_ctrl), pointer :: diag => null() !< A structure that is used to
45  !! regulate the timing of diagnostic output.
46  type(mom_restart_cs), pointer :: restart_csp => null() !< A pointer to the restart control structure
47 
48  type(vardesc), allocatable :: tr_desc(:) !< Descriptions and metadata for the tracers
49 end type dyed_obc_tracer_cs
50 
51 contains
52 
53 !> Register tracer fields and subroutines to be used with MOM.
54 function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
55  type(hor_index_type), intent(in) :: hi !< A horizontal index type structure.
56  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
57  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
58  type(dyed_obc_tracer_cs), pointer :: cs !< A pointer that is set to point to the
59  !! control structure for this module
60  type(tracer_registry_type), pointer :: tr_reg !< A pointer to the tracer registry.
61  type(mom_restart_cs), pointer :: restart_cs !< A pointer to the restart control structure.
62 
63 ! Local variables
64  character(len=80) :: name, longname
65 ! This include declares and sets the variable "version".
66 #include "version_variable.h"
67  character(len=40) :: mdl = "dyed_obc_tracer" ! This module's name.
68  character(len=200) :: inputdir
69  character(len=48) :: flux_units ! The units for tracer fluxes, usually
70  ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1.
71  real, pointer :: tr_ptr(:,:,:) => null()
72  logical :: register_dyed_obc_tracer
73  integer :: isd, ied, jsd, jed, nz, m
74  isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
75 
76  if (associated(cs)) then
77  call mom_error(warning, "dyed_obc_register_tracer called with an "// &
78  "associated control structure.")
79  return
80  endif
81  allocate(cs)
82 
83  ! Read all relevant parameters and write them to the model log.
84  call log_version(param_file, mdl, version, "")
85  call get_param(param_file, mdl, "NUM_DYE_TRACERS", cs%ntr, &
86  "The number of dye tracers in this run. Each tracer "//&
87  "should have a separate boundary segment.", default=0)
88  allocate(cs%ind_tr(cs%ntr))
89  allocate(cs%tr_desc(cs%ntr))
90 
91  call get_param(param_file, mdl, "dyed_obc_TRACER_IC_FILE", cs%tracer_IC_file, &
92  "The name of a file from which to read the initial "//&
93  "conditions for the dyed_obc tracers, or blank to initialize "//&
94  "them internally.", default=" ")
95  if (len_trim(cs%tracer_IC_file) >= 1) then
96  call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
97  inputdir = slasher(inputdir)
98  cs%tracer_IC_file = trim(inputdir)//trim(cs%tracer_IC_file)
99  call log_param(param_file, mdl, "INPUTDIR/dyed_obc_TRACER_IC_FILE", &
100  cs%tracer_IC_file)
101  endif
102 
103  allocate(cs%tr(isd:ied,jsd:jed,nz,cs%ntr)) ; cs%tr(:,:,:,:) = 0.0
104 
105  do m=1,cs%ntr
106  write(name,'("dye_",I2.2)') m
107  write(longname,'("Concentration of dyed_obc Tracer ",I2.2)') m
108  cs%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mdl)
109  if (gv%Boussinesq) then ; flux_units = "kg kg-1 m3 s-1"
110  else ; flux_units = "kg s-1" ; endif
111 
112  ! This is needed to force the compiler not to do a copy in the registration
113  ! calls. Curses on the designers and implementers of Fortran90.
114  tr_ptr => cs%tr(:,:,:,m)
115  ! Register the tracer for horizontal advection, diffusion, and restarts.
116  call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, &
117  name=name, longname=longname, units="kg kg-1", &
118  registry_diags=.true., flux_units=flux_units, &
119  restart_cs=restart_cs)
120 
121  ! Set coupled_tracers to be true (hard-coded above) to provide the surface
122  ! values to the coupler (if any). This is meta-code and its arguments will
123  ! currently (deliberately) give fatal errors if it is used.
124  if (cs%coupled_tracers) &
125  cs%ind_tr(m) = aof_set_coupler_flux(trim(name)//'_flux', &
126  flux_type=' ', implementation=' ', caller="register_dyed_obc_tracer")
127  enddo
128 
129  cs%tr_Reg => tr_reg
130  cs%restart_CSp => restart_cs
131  register_dyed_obc_tracer = .true.
132 end function register_dyed_obc_tracer
133 
134 !> Initializes the CS%ntr tracer fields in tr(:,:,:,:) and sets up the tracer output.
135 subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS)
136  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
137  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
138  logical, intent(in) :: restart !< .true. if the fields have already
139  !! been read from a restart file.
140  type(time_type), target, intent(in) :: day !< Time of the start of the run.
141  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
142  type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output.
143  type(ocean_obc_type), pointer :: obc !< Structure specifying open boundary options.
144  type(dyed_obc_tracer_cs), pointer :: cs !< The control structure returned by a previous
145  !! call to dyed_obc_register_tracer.
146 
147 ! Local variables
148  real, allocatable :: temp(:,:,:)
149  real, pointer, dimension(:,:,:) :: &
150  obc_tr1_u => null(), & ! These arrays should be allocated and set to
151  obc_tr1_v => null() ! specify the values of tracer 1 that should come
152  ! in through u- and v- points through the open
153  ! boundary conditions, in the same units as tr.
154  character(len=24) :: name ! A variable's name in a NetCDF file.
155  character(len=72) :: longname ! The long name of that variable.
156  character(len=48) :: units ! The dimensions of the variable.
157  character(len=48) :: flux_units ! The units for tracer fluxes, usually
158  ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1.
159  real, pointer :: tr_ptr(:,:,:) => null()
160  real :: h_neglect ! A thickness that is so small it is usually lost
161  ! in roundoff and can be neglected [H ~> m or kg m-2].
162  real :: e(szk_(g)+1), e_top, e_bot, d_tr
163  integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
164  integer :: isdb, iedb, jsdb, jedb
165 
166  if (.not.associated(cs)) return
167  if (cs%ntr < 1) return
168  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
169  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
170  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
171  h_neglect = gv%H_subroundoff
172 
173  cs%Time => day
174  cs%diag => diag
175 
176  if (.not.restart) then
177  if (len_trim(cs%tracer_IC_file) >= 1) then
178  ! Read the tracer concentrations from a netcdf file.
179  if (.not.file_exists(cs%tracer_IC_file, g%Domain)) &
180  call mom_error(fatal, "dyed_obc_initialize_tracer: Unable to open "// &
181  cs%tracer_IC_file)
182  do m=1,cs%ntr
183  call query_vardesc(cs%tr_desc(m), name, caller="initialize_dyed_obc_tracer")
184  call mom_read_data(cs%tracer_IC_file, trim(name), cs%tr(:,:,:,m), g%Domain)
185  enddo
186  else
187  do m=1,cs%ntr
188  do k=1,nz ; do j=js,je ; do i=is,ie
189  cs%tr(i,j,k,m) = 0.0
190  enddo ; enddo ; enddo
191  enddo
192  endif
193  endif ! restart
194 
195 end subroutine initialize_dyed_obc_tracer
196 
197 !> This subroutine applies diapycnal diffusion and any other column
198 !! tracer physics or chemistry to the tracers from this file.
199 !! This is a simple example of a set of advected passive tracers.
200 !!
201 !! The arguments to this subroutine are redundant in that
202 !! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1)
203 subroutine dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, &
204  evap_CFL_limit, minimum_forcing_depth)
205  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
206  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
207  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
208  intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2].
209  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
210  intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2].
211  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
212  intent(in) :: ea !< an array to which the amount of fluid entrained
213  !! from the layer above during this call will be
214  !! added [H ~> m or kg m-2].
215  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
216  intent(in) :: eb !< an array to which the amount of fluid entrained
217  !! from the layer below during this call will be
218  !! added [H ~> m or kg m-2].
219  type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic
220  !! and tracer forcing fields. Unused fields have NULL ptrs.
221  real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]
222  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
223  type(dyed_obc_tracer_cs), pointer :: cs !< The control structure returned by a previous
224  !! call to dyed_obc_register_tracer.
225  real, optional, intent(in) :: evap_cfl_limit !< Limit on the fraction of the water that can
226  !! be fluxed out of the top layer in a timestep [nondim]
227  real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which
228  !! fluxes can be applied [H ~> m or kg m-2]
229 
230 ! Local variables
231  real :: b1(szi_(g)) ! b1 and c1 are variables used by the
232  real :: c1(szi_(g),szk_(g)) ! tridiagonal solver.
233  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
234  integer :: i, j, k, is, ie, js, je, nz, m
235  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
236 
237  if (.not.associated(cs)) return
238  if (cs%ntr < 1) return
239 
240  if (present(evap_cfl_limit) .and. present(minimum_forcing_depth)) then
241  do m=1,cs%ntr
242  do k=1,nz ;do j=js,je ; do i=is,ie
243  h_work(i,j,k) = h_old(i,j,k)
244  enddo ; enddo ; enddo
245  call applytracerboundaryfluxesinout(g, gv, cs%tr(:,:,:,m), dt, fluxes, h_work, &
246  evap_cfl_limit, minimum_forcing_depth)
247  if (nz > 1) call tracer_vertdiff(h_work, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
248  enddo
249  else
250  do m=1,cs%ntr
251  if (nz > 1) call tracer_vertdiff(h_old, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
252  enddo
253  endif
254 
255 end subroutine dyed_obc_tracer_column_physics
256 
257 !> Clean up memory allocations, if any.
258 subroutine dyed_obc_tracer_end(CS)
259  type(dyed_obc_tracer_cs), pointer :: cs !< The control structure returned by a previous
260  !! call to dyed_obc_register_tracer.
261  integer :: m
262 
263  if (associated(cs)) then
264  if (associated(cs%tr)) deallocate(cs%tr)
265 
266  deallocate(cs)
267  endif
268 end subroutine dyed_obc_tracer_end
269 
270 !> \namespace dyed_obc_tracer
271 !!
272 !! By Kate Hedstrom, 2017, copied from DOME tracers and also
273 !! dye_example.
274 !!
275 !! This file contains an example of the code that is needed to set
276 !! up and use a set of dynamically passive tracers. These tracers
277 !! dye the inflowing water, one per open boundary segment.
278 !!
279 !! A single subroutine is called from within each file to register
280 !! each of the tracers for reinitialization and advection and to
281 !! register the subroutine that initializes the tracers and set up
282 !! their output and the subroutine that does any tracer physics or
283 !! chemistry along with diapycnal mixing (included here because some
284 !! tracers may float or swim vertically or dye diapycnal processes).
285 
286 end module dyed_obc_tracer
dyed_obc_tracer::initialize_dyed_obc_tracer
subroutine, public initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS)
Initializes the CSntr tracer fields in tr(:,:,:,:) and sets up the tracer output.
Definition: dyed_obc_tracer.F90:136
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
dyed_obc_tracer
This tracer package dyes flow through open boundaries.
Definition: dyed_obc_tracer.F90:2
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
dyed_obc_tracer::dyed_obc_tracer_cs
The control structure for the dyed_obc tracer package.
Definition: dyed_obc_tracer.F90:33
mom_tracer_registry
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
Definition: MOM_tracer_registry.F90:5
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_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
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
dyed_obc_tracer::dyed_obc_tracer_column_physics
subroutine, public dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, evap_CFL_limit, minimum_forcing_depth)
This subroutine applies diapycnal diffusion and any other column tracer physics or chemistry to the t...
Definition: dyed_obc_tracer.F90:205
mom_variables
Provides transparent structures with groups of MOM6 variables and supporting routines.
Definition: MOM_variables.F90:2
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
dyed_obc_tracer::register_dyed_obc_tracer
logical function, public register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
Register tracer fields and subroutines to be used with MOM.
Definition: dyed_obc_tracer.F90:55
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_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
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
dyed_obc_tracer::dyed_obc_tracer_end
subroutine, public dyed_obc_tracer_end(CS)
Clean up memory allocations, if any.
Definition: dyed_obc_tracer.F90:259
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