28 implicit none ;
private 30 #include <MOM_memory.h> 40 real,
dimension(:,:,:),
pointer :: p => null()
45 logical :: coupled_tracers = .false.
47 type(time_type),
pointer :: time
49 real,
pointer :: tr(:,:,:,:) => null()
51 type(
p3d),
dimension(NTR_MAX) :: &
58 logical :: mask_tracers
59 logical :: tracers_may_reinit
61 integer,
dimension(NTR_MAX) :: &
64 id_tracer = -1, id_tr_adx = -1, id_tr_ady = -1, &
65 id_tr_dfx = -1, id_tr_dfy = -1
68 real,
dimension(NTR_MAX) :: land_val = -1.0
70 real :: remaining_source_time
103 #include "version_variable.h" 104 character(len=40) :: mdl =
"boundary_impulse_tracer" 105 character(len=200) :: inputdir
106 character(len=48) :: var_name
107 character(len=3) :: name_tag
108 real,
pointer :: tr_ptr(:,:,:) => null()
109 real,
pointer :: rem_time_ptr => null()
110 logical :: register_boundary_impulse_tracer
111 integer :: isd, ied, jsd, jed, nz, m, i, j
112 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
114 if (
associated(cs))
then 115 call mom_error(warning,
"register_boundary_impulse_tracer called with an "// &
116 "associated control structure.")
123 call get_param(param_file, mdl,
"IMPULSE_SOURCE_TIME", cs%remaining_source_time, &
124 "Length of time for the boundary tracer to be injected\n"//&
125 "into the mixed layer. After this time has elapsed, the\n"//&
126 "surface becomes a sink for the boundary impulse tracer.", &
128 call get_param(param_file, mdl,
"TRACERS_MAY_REINIT", cs%tracers_may_reinit, &
129 "If true, tracers may go through the initialization code \n"//&
130 "if they are not found in the restart files. Otherwise \n"//&
131 "it is a fatal error if the tracers are not found in the \n"//&
132 "restart files of a restarted run.", default=.false.)
134 allocate(cs%tr(isd:ied,jsd:jed,nz,cs%ntr)) ; cs%tr(:,:,:,:) = 0.0
136 cs%nkml = max(gv%nkml,1)
141 cs%tr_desc(m) =
var_desc(trim(
"boundary_impulse"),
"kg", &
142 "Boundary impulse tracer", caller=mdl)
143 tr_ptr => cs%tr(:,:,:,m)
144 call query_vardesc(cs%tr_desc(m), name=var_name, caller=
"register_boundary_impulse_tracer")
147 .not. cs%tracers_may_reinit, restart_cs)
149 call register_tracer(tr_ptr, cs%tr_desc(m), param_file, hi, gv, tr_reg, &
150 tr_desc_ptr=cs%tr_desc(m))
155 if (cs%coupled_tracers) &
157 flux_type=
' ', implementation=
' ', caller=
"register_boundary_impulse_tracer")
160 rem_time_ptr => cs%remaining_source_time
162 var_desc(trim(
"bir_remain_time"),
"s",
"Remaining time to apply BIR source", &
163 hor_grid =
"1", z_grid =
"1", caller=mdl), &
164 .not. cs%tracers_may_reinit, restart_cs)
167 cs%restart_CSp => restart_cs
168 register_boundary_impulse_tracer = .true.
174 sponge_CSp, diag_to_Z_CSp, tv)
175 logical,
intent(in ) :: restart
176 type(time_type),
target,
intent(in ) :: day
179 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in ) :: h
180 type(
diag_ctrl),
target,
intent(in ) :: diag
183 type(
sponge_cs),
pointer,
intent(inout) :: sponge_CSp
184 type(
diag_to_z_cs),
pointer,
intent(inout) :: diag_to_Z_CSp
204 character(len=16) :: name
205 character(len=72) :: longname
206 character(len=48) :: units
207 character(len=48) :: flux_units
210 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
211 integer :: IsdB, IedB, JsdB, JedB
213 if (.not.
associated(cs))
return 214 if (cs%ntr < 1)
return 215 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
216 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
217 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
221 name =
"boundary_impulse" 224 call query_vardesc(cs%tr_desc(m), name=name, caller=
"initialize_boundary_impulse_tracer")
225 if ((.not.restart) .or. (.not. &
227 do k=1,cs%nkml ;
do j=jsd,jed ;
do i=isd,ied
229 enddo ;
enddo ;
enddo 233 if (
associated(obc))
then 242 if (gv%Boussinesq)
then ; flux_units =
"g salt/(m^2 s)" 243 else ; flux_units =
"g salt/(m^2 s)" ;
endif 247 call query_vardesc(cs%tr_desc(m), name, units=units, longname=longname, &
248 caller=
"initialize_boundary_impulse_tracer")
249 cs%id_tracer(m) = register_diag_field(
"ocean_model", trim(name), cs%diag%axesTL, &
250 day, trim(longname) , trim(units))
251 cs%id_tr_adx(m) = register_diag_field(
"ocean_model", trim(name)//
"_adx", &
252 cs%diag%axesCuL, day, trim(longname)//
" advective zonal flux" , &
254 cs%id_tr_ady(m) = register_diag_field(
"ocean_model", trim(name)//
"_ady", &
255 cs%diag%axesCvL, day, trim(longname)//
" advective meridional flux" , &
257 cs%id_tr_dfx(m) = register_diag_field(
"ocean_model", trim(name)//
"_dfx", &
258 cs%diag%axesCuL, day, trim(longname)//
" diffusive zonal flux" , &
260 cs%id_tr_dfy(m) = register_diag_field(
"ocean_model", trim(name)//
"_dfy", &
261 cs%diag%axesCvL, day, trim(longname)//
" diffusive zonal flux" , &
263 if (cs%id_tr_adx(m) > 0)
call safe_alloc_ptr(cs%tr_adx(m)%p,isdb,iedb,jsd,jed,nz)
264 if (cs%id_tr_ady(m) > 0)
call safe_alloc_ptr(cs%tr_ady(m)%p,isd,ied,jsdb,jedb,nz)
265 if (cs%id_tr_dfx(m) > 0)
call safe_alloc_ptr(cs%tr_dfx(m)%p,isdb,iedb,jsd,jed,nz)
266 if (cs%id_tr_dfy(m) > 0)
call safe_alloc_ptr(cs%tr_dfy(m)%p,isd,ied,jsdb,jedb,nz)
269 if ((cs%id_tr_adx(m) > 0) .or. (cs%id_tr_ady(m) > 0) .or. &
270 (cs%id_tr_dfx(m) > 0) .or. (cs%id_tr_dfy(m) > 0)) &
272 cs%tr_ady(m)%p,cs%tr_dfx(m)%p,cs%tr_dfy(m)%p)
275 day, g, diag_to_z_csp)
281 subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, &
282 evap_CFL_limit, minimum_forcing_depth)
285 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in ) :: h_old, h_new, ea, eb
286 type(
forcing),
intent(in ) :: fluxes
287 real,
intent(in ) :: dt
290 logical,
intent(in ) :: debug
291 real,
optional,
intent(in ) :: evap_CFL_limit
292 real,
optional,
intent(in ) :: minimum_forcing_depth
323 real :: Isecs_per_year = 1.0 / (365.0*86400.0)
324 real :: year, h_total, scale, htot, Ih_limit
325 integer :: secs, days
326 integer :: i, j, k, is, ie, js, je, nz, m, k_max
327 real,
allocatable :: local_tr(:,:,:)
328 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
330 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
332 if (.not.
associated(cs))
return 333 if (cs%ntr < 1)
return 336 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then 337 do k=1,nz ;
do j=js,je ;
do i=is,ie
338 h_work(i,j,k) = h_old(i,j,k)
339 enddo ;
enddo ; enddo;
341 evap_cfl_limit, minimum_forcing_depth)
349 if(cs%remaining_source_time>0.0)
then 350 do k=1,cs%nkml ;
do j=js,je ;
do i=is,ie
352 enddo ;
enddo ;
enddo 353 cs%remaining_source_time = cs%remaining_source_time-dt
355 do k=1,cs%nkml ;
do j=js,je ;
do i=is,ie
357 enddo ;
enddo ;
enddo 362 allocate(local_tr(g%isd:g%ied,g%jsd:g%jed,nz))
364 if (cs%id_tracer(m)>0)
then 365 if (cs%mask_tracers)
then 366 do k=1,nz ;
do j=js,je ;
do i=is,ie
367 if (h_new(i,j,k) < 1.1*gv%Angstrom)
then 368 local_tr(i,j,k) = cs%land_val(m)
370 local_tr(i,j,k) = cs%tr(i,j,k,m)
372 enddo ;
enddo ;
enddo 374 do k=1,nz ;
do j=js,je ;
do i=is,ie
375 local_tr(i,j,k) = cs%tr(i,j,k,m)
376 enddo ;
enddo ;
enddo 378 call post_data(cs%id_tracer(m),local_tr,cs%diag)
380 if (cs%id_tr_adx(m)>0) &
381 call post_data(cs%id_tr_adx(m),cs%tr_adx(m)%p(:,:,:),cs%diag)
382 if (cs%id_tr_ady(m)>0) &
383 call post_data(cs%id_tr_ady(m),cs%tr_ady(m)%p(:,:,:),cs%diag)
384 if (cs%id_tr_dfx(m)>0) &
385 call post_data(cs%id_tr_dfx(m),cs%tr_dfx(m)%p(:,:,:),cs%diag)
386 if (cs%id_tr_dfy(m)>0) &
387 call post_data(cs%id_tr_dfy(m),cs%tr_dfy(m)%p(:,:,:),cs%diag)
397 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in ) :: h
398 real,
dimension(:),
intent( out) :: stocks
400 character(len=*),
dimension(:),
intent( out) :: names
401 character(len=*),
dimension(:),
intent( out) :: units
402 integer,
optional,
intent(in ) :: stock_index
418 integer :: boundary_impulse_stock
419 integer :: i, j, k, is, ie, js, je, nz, m
420 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
422 boundary_impulse_stock = 0
423 if (.not.
associated(cs))
return 424 if (cs%ntr < 1)
return 426 if (
present(stock_index))
then ;
if (stock_index > 0)
then 434 call query_vardesc(cs%tr_desc(m), name=names(m), units=units(m), caller=
"boundary_impulse_stock")
435 units(m) = trim(units(m))//
" kg" 437 do k=1,nz ;
do j=js,je ;
do i=is,ie
438 stocks(m) = stocks(m) + cs%tr(i,j,k,m) * &
439 (g%mask2dT(i,j) * g%areaT(i,j) * h(i,j,k))
440 enddo ;
enddo ;
enddo 441 stocks(m) = gv%H_to_kg_m2 * stocks(m)
444 boundary_impulse_stock = cs%ntr
451 type(
surface),
intent(inout) :: state
452 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in ) :: h
462 integer :: m, is, ie, js, je
463 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
465 if (.not.
associated(cs))
return 467 if (cs%coupled_tracers)
then 472 ind_csurf, is, ie, js, je)
483 if (
associated(cs))
then 484 if (
associated(cs%tr))
deallocate(cs%tr)
486 if (
associated(cs%tr_adx(m)%p))
deallocate(cs%tr_adx(m)%p)
487 if (
associated(cs%tr_ady(m)%p))
deallocate(cs%tr_ady(m)%p)
488 if (
associated(cs%tr_dfx(m)%p))
deallocate(cs%tr_dfx(m)%p)
489 if (
associated(cs%tr_dfy(m)%p))
deallocate(cs%tr_dfy(m)%p)
logical function, public register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
Read in runtime options and add boundary impulse tracer to tracer registry.
The following structure contains pointers to various fields which may be used describe the surface st...
type(vardesc) function, public var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, cmor_units, conversion, caller)
Returns a vardesc type whose elements have been filled with the provided fields. The argument name is...
This module implements boundary forcing for MOM6.
integer function, public aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, param, flag, ice_restart_file, ocean_restart_file, units, caller)
logical function, public tracer_z_init(tr, h, filename, tr_name, G, missing_val, land_val)
Ocean grid type. See mom_grid for details.
subroutine, public boundary_impulse_tracer_end(CS)
Provides the ocean grid type.
This module contains I/O framework code.
Defines the horizontal index type (hor_index_type) used for providing index ranges.
Container for horizontal index ranges for data, computational and global domains. ...
integer, parameter ntr_max
subroutine, public register_tracer(tr1, tr_desc, param_file, HI, GV, Reg, tr_desc_ptr, ad_x, ad_y, df_x, df_y, OBC_inflow, OBC_in_u, OBC_in_v, ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy)
This subroutine registers a tracer to be advected and laterally diffused.
integer function, public boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index)
Calculate total inventory of tracer.
Implements a boundary impulse response tracer to calculate Green's functions.
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
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)
Type to carry basic tracer information.
This module contains routines that implement physical fluxes of tracers (e.g. due to surface fluxes o...
subroutine, public boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, evap_CFL_limit, minimum_forcing_depth)
subroutine, public register_z_tracer(tr_ptr, name, long_name, units, Time, G, CS, standard_name, cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name)
This subroutine registers a tracer to be output in depth space.
subroutine, public add_tracer_obc_values(name, Reg, OBC_inflow, OBC_in_u, OBC_in_v)
This subroutine adds open boundary condition concentrations for a tracer that has previously been reg...
subroutine, public add_tracer_diagnostics(name, Reg, ad_x, ad_y, df_x, df_y, ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy)
This subroutine adds diagnostic arrays for a tracer that has previously been registered by a call to ...
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
subroutine, public set_coupler_values(array_in, BC_struc, BC_index, BC_element, is, ie, js, je, conversion)
subroutine, public initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, diag_to_Z_CSp, tv)
Initialize tracer from restart or set to 1 at surface to initialize.
Type for describing a variable, typically a tracer.
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...
The thermo_var_ptrs structure contains pointers to an assortment of thermodynamic fields that may be ...
subroutine, public query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, cmor_units, conversion, caller)
This routine queries vardesc.
Controls where open boundary conditions are applied.
subroutine, public boundary_impulse_tracer_surface_state(state, h, G, CS)
Called if returned if coupler needs to know about tracer, currently unused.
subroutine, public mom_error(level, message, all_print)