Go to the documentation of this file.
22 use coupler_types_mod,
only : coupler_type_set_data, ind_csurf
25 implicit none ;
private
27 #include <MOM_memory.h>
35 logical :: coupled_tracers = .false.
36 character(len=200) :: tracer_ic_file
37 type(time_type),
pointer :: time => null()
39 real,
pointer :: tr(:,:,:,:) => null()
41 integer,
allocatable,
dimension(:) :: ind_tr
64 character(len=80) :: name, longname
66 #include "version_variable.h"
67 character(len=40) :: mdl =
"dyed_obc_tracer"
68 character(len=200) :: inputdir
69 character(len=48) :: flux_units
71 real,
pointer :: tr_ptr(:,:,:) => null()
73 integer :: isd, ied, jsd, jed, nz, m
74 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
76 if (
associated(cs))
then
77 call mom_error(warning,
"dyed_obc_register_tracer called with an "// &
78 "associated control structure.")
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))
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", &
103 allocate(cs%tr(isd:ied,jsd:jed,nz,cs%ntr)) ; cs%tr(:,:,:,:) = 0.0
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
114 tr_ptr => cs%tr(:,:,:,m)
117 name=name, longname=longname, units=
"kg kg-1", &
118 registry_diags=.true., flux_units=flux_units, &
119 restart_cs=restart_cs)
124 if (cs%coupled_tracers) &
126 flux_type=
' ', implementation=
' ', caller=
"register_dyed_obc_tracer")
130 cs%restart_CSp => restart_cs
138 logical,
intent(in) :: restart
140 type(time_type),
target,
intent(in) :: day
141 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
142 type(
diag_ctrl),
target,
intent(in) :: diag
148 real,
allocatable :: temp(:,:,:)
149 real,
pointer,
dimension(:,:,:) :: &
150 obc_tr1_u => null(), &
154 character(len=24) :: name
155 character(len=72) :: longname
156 character(len=48) :: units
157 character(len=48) :: flux_units
159 real,
pointer :: tr_ptr(:,:,:) => null()
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
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
176 if (.not.restart)
then
177 if (len_trim(cs%tracer_IC_file) >= 1)
then
179 if (.not.
file_exists(cs%tracer_IC_file, g%Domain)) &
180 call mom_error(fatal,
"dyed_obc_initialize_tracer: Unable to open "// &
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)
188 do k=1,nz ;
do j=js,je ;
do i=is,ie
190 enddo ;
enddo ;
enddo
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)
207 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
209 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
211 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
215 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
219 type(
forcing),
intent(in) :: fluxes
221 real,
intent(in) :: dt
225 real,
optional,
intent(in) :: evap_cfl_limit
227 real,
optional,
intent(in) :: minimum_forcing_depth
232 real :: c1(szi_(g),szk_(g))
233 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
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
237 if (.not.
associated(cs))
return
238 if (cs%ntr < 1)
return
240 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then
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
246 evap_cfl_limit, minimum_forcing_depth)
247 if (nz > 1)
call tracer_vertdiff(h_work, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
251 if (nz > 1)
call tracer_vertdiff(h_old, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
263 if (
associated(cs))
then
264 if (
associated(cs%tr))
deallocate(cs%tr)
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.
Wraps the FMS time manager functions.
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.
Pointers to various fields which may be used describe the surface state of MOM, and which will be ret...
This tracer package dyes flow through open boundaries.
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...
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.
Provides a transparent vertical ocean grid type and supporting routines.
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...
An overloaded interface to log version information about modules.
A dummy version of atmos_ocean_fluxes_mod module for use when the vastly larger FMS package is not ne...
The control structure for the dyed_obc tracer package.
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
A structure that can be parsed to read and document run-time parameters.
An overloaded interface to read and log the values of various types of parameters.
Defines the horizontal index type (hor_index_type) used for providing index ranges.
This module contains I/O framework code.
A restart registry and the control structure for restarts.
Describes various unit conversion factors.
This module contains routines that implement physical fluxes of tracers (e.g. due to surface fluxes o...
This module implements boundary forcing for MOM6.
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...
Describes the vertical ocean grid, including unit conversion factors.
The MOM6 facility for reading and writing restart files, and querying what has been read.
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...
Provides transparent structures with groups of MOM6 variables and supporting routines.
Read a data field from a file.
Controls where open boundary conditions are applied.
The MOM6 facility to parse input files for runtime parameters.
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.
Type to carry basic tracer information.
Container for horizontal index ranges for data, computational and global domains.
Provides the ocean grid type.
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
Type for describing a variable, typically a tracer.
Indicate whether a file exists, perhaps with domain decomposition.
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...
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....
An overloaded interface to log the values of various types of parameters.
subroutine, public dyed_obc_tracer_end(CS)
Clean up memory allocations, if any.
Routines for error handling and I/O management.
Ocean grid type. See mom_grid for details.