Go to the documentation of this file.
27 use coupler_types_mod,
only : coupler_type_set_data, ind_csurf
30 implicit none ;
private
32 #include <MOM_memory.h>
40 type(time_type),
pointer :: time => null()
42 real,
pointer :: ps(:,:,:) => null()
44 real,
pointer :: diff(:,:,:) => null()
46 logical :: pseudo_salt_may_reinit = .true.
48 integer :: id_psd = -1
74 character(len=40) :: mdl =
"pseudo_salt_tracer"
75 character(len=200) :: inputdir
76 character(len=48) :: var_name
77 character(len=3) :: name_tag
79 #include "version_variable.h"
80 real,
pointer :: tr_ptr(:,:,:) => null()
82 integer :: isd, ied, jsd, jed, nz, i, j
83 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
85 if (
associated(cs))
then
86 call mom_error(warning,
"register_pseudo_salt_tracer called with an "// &
87 "associated control structure.")
95 allocate(cs%ps(isd:ied,jsd:jed,nz)) ; cs%ps(:,:,:) = 0.0
96 allocate(cs%diff(isd:ied,jsd:jed,nz)) ; cs%diff(:,:,:) = 0.0
98 cs%tr_desc =
var_desc(trim(
"pseudo_salt"),
"psu", &
99 "Pseudo salt passive tracer", caller=mdl)
101 tr_ptr => cs%ps(:,:,:)
102 call query_vardesc(cs%tr_desc, name=var_name, caller=
"register_pseudo_salt_tracer")
104 call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, name=
"pseudo_salt", &
105 longname=
"Pseudo salt passive tracer", units=
"psu", &
106 registry_diags=.true., restart_cs=restart_cs, &
107 mandatory=.not.cs%pseudo_salt_may_reinit)
110 cs%restart_CSp => restart_cs
118 logical,
intent(in) :: restart
120 type(time_type),
target,
intent(in) :: day
123 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
125 type(
diag_ctrl),
target,
intent(in) :: diag
137 character(len=16) :: name
138 character(len=72) :: longname
139 character(len=48) :: units
140 character(len=48) :: flux_units
143 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
144 integer :: isdb, iedb, jsdb, jedb
146 if (.not.
associated(cs))
return
147 if (.not.
associated(cs%diff))
return
149 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
150 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
151 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
157 call query_vardesc(cs%tr_desc, name=name, caller=
"initialize_pseudo_salt_tracer")
158 if ((.not.restart) .or. (.not.
query_initialized(cs%ps, name, cs%restart_CSp)))
then
159 do k=1,nz ;
do j=jsd,jed ;
do i=isd,ied
160 cs%ps(i,j,k) = tv%S(i,j,k)
161 enddo ;
enddo ;
enddo
164 if (
associated(obc))
then
168 cs%id_psd = register_diag_field(
"ocean_model",
"pseudo_salt_diff", cs%diag%axesTL, &
169 day,
"Difference between pseudo salt passive tracer and salt tracer",
"psu")
174 subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, debug, &
175 evap_CFL_limit, minimum_forcing_depth)
178 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
180 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
182 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
186 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
190 type(
forcing),
intent(in) :: fluxes
192 real,
intent(in) :: dt
197 logical,
intent(in) :: debug
198 real,
optional,
intent(in) :: evap_cfl_limit
200 real,
optional,
intent(in) :: minimum_forcing_depth
210 real :: year, h_total, scale, htot, ih_limit
211 integer :: secs, days
212 integer :: i, j, k, is, ie, js, je, nz, k_max
213 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
215 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
217 if (.not.
associated(cs))
return
218 if (.not.
associated(cs%diff))
return
221 call hchksum(tv%S,
"salt pre pseudo-salt vertdiff", g%HI)
222 call hchksum(cs%ps,
"pseudo_salt pre pseudo-salt vertdiff", g%HI)
226 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then
227 do k=1,nz ;
do j=js,je ;
do i=is,ie
228 h_work(i,j,k) = h_old(i,j,k)
229 enddo ;
enddo ;
enddo
231 evap_cfl_limit, minimum_forcing_depth, out_flux_optional=fluxes%netSalt)
237 do k=1,nz ;
do j=js,je ;
do i=is,ie
238 cs%diff(i,j,k) = cs%ps(i,j,k)-tv%S(i,j,k)
239 enddo ;
enddo ;
enddo
242 call hchksum(tv%S,
"salt post pseudo-salt vertdiff", g%HI)
243 call hchksum(cs%ps,
"pseudo_salt post pseudo-salt vertdiff", g%HI)
246 if (cs%id_psd>0)
call post_data(cs%id_psd, cs%diff, cs%diag)
256 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
257 real,
dimension(:),
intent(out) :: stocks
261 character(len=*),
dimension(:),
intent(out) :: names
262 character(len=*),
dimension(:),
intent(out) :: units
263 integer,
optional,
intent(in) :: stock_index
272 integer :: i, j, k, is, ie, js, je, nz
273 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
276 if (.not.
associated(cs))
return
277 if (.not.
associated(cs%diff))
return
279 if (
present(stock_index))
then ;
if (stock_index > 0)
then
286 call query_vardesc(cs%tr_desc, name=names(1), units=units(1), caller=
"pseudo_salt_stock")
287 units(1) = trim(units(1))//
" kg"
289 do k=1,nz ;
do j=js,je ;
do i=is,ie
290 stocks(1) = stocks(1) + cs%diff(i,j,k) * &
291 (g%mask2dT(i,j) * g%US%L_to_m**2*g%areaT(i,j) * h(i,j,k))
292 enddo ;
enddo ;
enddo
293 stocks(1) = gv%H_to_kg_m2 * stocks(1)
304 type(
surface),
intent(inout) :: state
306 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
314 integer :: m, is, ie, js, je, isd, ied, jsd, jed
315 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
316 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
318 if (.not.
associated(cs))
return
330 if (
associated(cs))
then
331 if (
associated(cs%ps))
deallocate(cs%ps)
332 if (
associated(cs%diff))
deallocate(cs%diff)
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...
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...
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....
An overloaded interface to log version information about modules.
subroutine, public pseudo_salt_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...
A dummy version of atmos_ocean_fluxes_mod module for use when the vastly larger FMS package is not ne...
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
integer function, public pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index)
Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has cal...
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.
A tracer package that mimics salinity.
This module contains I/O framework code.
A restart registry and the control structure for restarts.
subroutine, public pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, debug, evap_CFL_limit, minimum_forcing_depth)
Apply sources, sinks and diapycnal diffusion to the tracers in this package.
Used to initialize tracers from a depth- (or z*-) space file.
Describes various unit conversion factors.
This module contains routines that implement physical fluxes of tracers (e.g. due to surface fluxes o...
Make a diagnostic available for averaging or output.
subroutine, public initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, tv)
Initialize the pseudo-salt tracer.
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.
logical function, public register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
Register the pseudo-salt tracer with MOM6.
The MOM6 facility for reading and writing restart files, and querying what has been read.
Provides transparent structures with groups of MOM6 variables and supporting routines.
Controls where open boundary conditions are applied.
The MOM6 facility to parse input files for runtime parameters.
Implements sponge regions in isopycnal mode.
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...
Type to carry basic tracer information.
Container for horizontal index ranges for data, computational and global domains.
Provides the ocean grid type.
This control structure holds memory and parameters for the MOM_sponge module.
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 ...
Provides checksumming functions for debugging.
Type for describing a variable, typically a tracer.
Indicate whether a file exists, perhaps with domain decomposition.
subroutine, public pseudo_salt_tracer_end(CS)
Deallocate memory associated with this tracer package.
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...
The control structure for the pseudo-salt tracer.
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.
Indicate whether a field has been read from a restart file.
Routines for error handling and I/O management.
Ocean grid type. See mom_grid for details.