78 implicit none ;
private 80 #include <MOM_memory.h> 86 integer,
parameter ::
ntr = 11
89 real,
dimension(:,:,:),
pointer :: p => null()
93 logical :: coupled_tracers = .false.
95 character(len=200) :: tracer_ic_file
97 type(time_type),
pointer :: time
99 real,
pointer :: tr(:,:,:,:) => null()
101 real,
pointer :: tr_aux(:,:,:,:) => null()
103 type(
p3d),
dimension(NTR) :: &
108 real :: land_val(
ntr) = -1.0
109 logical :: mask_tracers
110 logical :: use_sponge
112 integer,
dimension(NTR) :: ind_tr
118 integer,
dimension(NTR) :: id_tracer = -1, id_tr_adx = -1, id_tr_ady = -1
119 integer,
dimension(NTR) :: id_tr_dfx = -1, id_tr_dfy = -1
142 character(len=80) :: name, longname
144 #include "version_variable.h" 145 character(len=40) :: mdl =
"DOME_tracer" 146 character(len=200) :: inputdir
147 real,
pointer :: tr_ptr(:,:,:) => null()
148 logical :: register_DOME_tracer
149 integer :: isd, ied, jsd, jed, nz, m
150 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
152 if (
associated(cs))
then 153 call mom_error(warning,
"DOME_register_tracer called with an "// &
154 "associated control structure.")
161 call get_param(param_file, mdl,
"DOME_TRACER_IC_FILE", cs%tracer_IC_file, &
162 "The name of a file from which to read the initial \n"//&
163 "conditions for the DOME tracers, or blank to initialize \n"//&
164 "them internally.", default=
" ")
165 if (len_trim(cs%tracer_IC_file) >= 1)
then 166 call get_param(param_file, mdl,
"INPUTDIR", inputdir, default=
".")
167 inputdir = slasher(inputdir)
168 cs%tracer_IC_file = trim(inputdir)//trim(cs%tracer_IC_file)
169 call log_param(param_file, mdl,
"INPUTDIR/DOME_TRACER_IC_FILE", &
172 call get_param(param_file, mdl,
"SPONGE", cs%use_sponge, &
173 "If true, sponges may be applied anywhere in the domain. \n"//&
174 "The exact location and properties of those sponges are \n"//&
175 "specified from MOM_initialization.F90.", default=.false.)
177 allocate(cs%tr(isd:ied,jsd:jed,nz,
ntr)) ; cs%tr(:,:,:,:) = 0.0
178 if (cs%mask_tracers)
then 179 allocate(cs%tr_aux(isd:ied,jsd:jed,nz,
ntr)) ; cs%tr_aux(:,:,:,:) = 0.0
183 if (m < 10)
then ;
write(name,
'("tr_D",I1.1)') m
184 else ;
write(name,
'("tr_D",I2.2)') m ;
endif 185 write(longname,
'("Concentration of DOME Tracer ",I2.2)') m
186 cs%tr_desc(m) =
var_desc(name, units=
"kg kg-1", longname=longname, caller=mdl)
190 tr_ptr => cs%tr(:,:,:,m)
194 call register_tracer(tr_ptr, cs%tr_desc(m), param_file, hi, gv, tr_reg, &
195 tr_desc_ptr=cs%tr_desc(m))
200 if (cs%coupled_tracers) &
202 flux_type=
' ', implementation=
' ', caller=
"register_DOME_tracer")
206 register_dome_tracer = .true.
210 sponge_CSp, diag_to_Z_CSp)
213 logical,
intent(in) :: restart
214 type(time_type),
target,
intent(in) :: day
215 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
216 type(
diag_ctrl),
target,
intent(in) :: diag
239 real,
allocatable :: temp(:,:,:)
240 real,
pointer,
dimension(:,:,:) :: &
241 OBC_tr1_u => null(), &
245 character(len=16) :: name
246 character(len=72) :: longname
247 character(len=48) :: units
248 character(len=48) :: flux_units
250 real,
pointer :: tr_ptr(:,:,:) => null()
256 real :: e(szk_(g)+1), e_top, e_bot, d_tr
257 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
258 integer :: IsdB, IedB, JsdB, JedB
260 if (.not.
associated(cs))
return 261 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
262 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
263 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
264 h_neglect = gv%H_subroundoff
269 if (.not.restart)
then 270 if (len_trim(cs%tracer_IC_file) >= 1)
then 272 if (.not.
file_exists(cs%tracer_IC_file, g%Domain)) &
273 call mom_error(fatal,
"DOME_initialize_tracer: Unable to open "// &
276 call query_vardesc(cs%tr_desc(m), name, caller=
"initialize_DOME_tracer")
277 call read_data(cs%tracer_IC_file, trim(name), &
278 cs%tr(:,:,:,m), domain=g%Domain%mpp_domain)
282 do k=1,nz ;
do j=js,je ;
do i=is,ie
283 cs%tr(i,j,k,m) = 1.0e-20
284 enddo ;
enddo ;
enddo 288 do m=2,
ntr ;
do j=js,je ;
do i=is,ie
290 if ((m <= 6) .and. (g%geoLatT(i,j) > (300.0+50.0*
real(m-1))) .and. &
291 (g%geolatt(i,j) < (350.0+50.0*
real(m-1)))) tr_y = 1.0
294 cs%tr(i,j,k,m) = cs%tr(i,j,k,m) + tr_y
299 do j=js,je ;
do i=is,ie
300 e(nz+1) = -g%bathyT(i,j)
302 e(k) = e(k+1) + h(i,j,k)*gv%H_to_m
304 e_top = -600.0*
real(m-1) + 3000.0
305 e_bot = -600.0*
real(m-1) + 2700.0
306 if (e_top < e(k))
then 307 if (e_top < e(k+1))
then ; d_tr = 0.0
308 elseif (e_bot < e(k+1))
then 309 d_tr = (e_top-e(k+1)) / ((h(i,j,k)+h_neglect)*gv%H_to_m)
310 else ; d_tr = (e_top-e_bot) / ((h(i,j,k)+h_neglect)*gv%H_to_m)
312 elseif (e_bot < e(k))
then 313 if (e_bot < e(k+1))
then ; d_tr = 1.0
314 else ; d_tr = (e(k)-e_bot) / ((h(i,j,k)+h_neglect)*gv%H_to_m)
319 if (h(i,j,k) < 2.0*gv%Angstrom) d_tr=0.0
320 cs%tr(i,j,k,m) = cs%tr(i,j,k,m) + d_tr
329 if ( cs%use_sponge )
then 334 if (.not.
associated(sponge_csp)) &
335 call mom_error(fatal,
"DOME_initialize_tracer: "// &
336 "The pointer to sponge_CSp must be associated if SPONGE is defined.")
338 allocate(temp(g%isd:g%ied,g%jsd:g%jed,nz))
339 do k=1,nz ;
do j=js,je ;
do i=is,ie
340 if (g%geoLatT(i,j) > 700.0 .and. (k > nz/2))
then 345 enddo ;
enddo ;
enddo 351 tr_ptr => cs%tr(:,:,:,m)
357 if (
associated(obc))
then 358 call query_vardesc(cs%tr_desc(1), name, caller=
"initialize_DOME_tracer")
359 if (obc%specified_v_BCs_exist_globally)
then 360 allocate(obc_tr1_v(g%isd:g%ied,g%jsd:g%jed,nz))
361 do k=1,nz ;
do j=g%jsd,g%jed ;
do i=g%isd,g%ied
362 if (k < nz/2)
then ; obc_tr1_v(i,j,k) = 0.0
363 else ; obc_tr1_v(i,j,k) = 1.0 ;
endif 364 enddo ;
enddo ;
enddo 366 0.0, obc_in_v=obc_tr1_v)
374 call query_vardesc(cs%tr_desc(m), name, caller=
"initialize_DOME_tracer")
380 if (gv%Boussinesq)
then ; flux_units =
"kg kg-1 m3 s-1" 381 else ; flux_units =
"kg s-1" ;
endif 385 call query_vardesc(cs%tr_desc(m), name, units=units, longname=longname, &
386 caller=
"initialize_DOME_tracer")
387 cs%id_tracer(m) = register_diag_field(
"ocean_model", trim(name), cs%diag%axesTL, &
388 day, trim(longname) , trim(units))
389 cs%id_tr_adx(m) = register_diag_field(
"ocean_model", trim(name)//
"_adx", &
390 cs%diag%axesCuL, day, trim(longname)//
" advective zonal flux" , &
392 cs%id_tr_ady(m) = register_diag_field(
"ocean_model", trim(name)//
"_ady", &
393 cs%diag%axesCvL, day, trim(longname)//
" advective meridional flux" , &
395 cs%id_tr_dfx(m) = register_diag_field(
"ocean_model", trim(name)//
"_dfx", &
396 cs%diag%axesCuL, day, trim(longname)//
" diffusive zonal flux" , &
398 cs%id_tr_dfy(m) = register_diag_field(
"ocean_model", trim(name)//
"_dfy", &
399 cs%diag%axesCvL, day, trim(longname)//
" diffusive zonal flux" , &
401 if (cs%id_tr_adx(m) > 0)
call safe_alloc_ptr(cs%tr_adx(m)%p,isdb,iedb,jsd,jed,nz)
402 if (cs%id_tr_ady(m) > 0)
call safe_alloc_ptr(cs%tr_ady(m)%p,isd,ied,jsdb,jedb,nz)
403 if (cs%id_tr_dfx(m) > 0)
call safe_alloc_ptr(cs%tr_dfx(m)%p,isdb,iedb,jsd,jed,nz)
404 if (cs%id_tr_dfy(m) > 0)
call safe_alloc_ptr(cs%tr_dfy(m)%p,isd,ied,jsdb,jedb,nz)
407 if ((cs%id_tr_adx(m) > 0) .or. (cs%id_tr_ady(m) > 0) .or. &
408 (cs%id_tr_dfx(m) > 0) .or. (cs%id_tr_dfy(m) > 0)) &
410 cs%tr_ady(m)%p, cs%tr_dfx(m)%p, cs%tr_dfy(m)%p)
413 day, g, diag_to_z_csp)
419 evap_CFL_limit, minimum_forcing_depth)
420 type(ocean_grid_type),
intent(in) :: G
421 type(verticalgrid_type),
intent(in) :: GV
422 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h_old, h_new, ea, eb
423 type(forcing),
intent(in) :: fluxes
424 real,
intent(in) :: dt
426 real,
optional,
intent(in) :: evap_CFL_limit
427 real,
optional,
intent(in) :: minimum_forcing_depth
452 real :: c1(szi_(g),szk_(g))
453 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
454 integer :: i, j, k, is, ie, js, je, nz, m
455 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
457 if (.not.
associated(cs))
return 459 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then 461 do k=1,nz ;
do j=js,je ;
do i=is,ie
462 h_work(i,j,k) = h_old(i,j,k)
463 enddo ;
enddo ; enddo;
464 call applytracerboundaryfluxesinout(g, gv, cs%tr(:,:,:,m) , dt, fluxes, h_work, &
465 evap_cfl_limit, minimum_forcing_depth)
466 call tracer_vertdiff(h_work, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
470 call tracer_vertdiff(h_old, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
474 if (cs%mask_tracers)
then 475 do m = 1,
ntr ;
if (cs%id_tracer(m) > 0)
then 476 do k=1,nz ;
do j=js,je ;
do i=is,ie
477 if (h_new(i,j,k) < 1.1*gv%Angstrom)
then 478 cs%tr_aux(i,j,k,m) = cs%land_val(m)
480 cs%tr_aux(i,j,k,m) = cs%tr(i,j,k,m)
482 enddo ;
enddo ;
enddo 487 if (cs%mask_tracers)
then 488 if (cs%id_tracer(m)>0) &
489 call post_data(cs%id_tracer(m),cs%tr_aux(:,:,:,m),cs%diag)
491 if (cs%id_tracer(m)>0) &
492 call post_data(cs%id_tracer(m),cs%tr(:,:,:,m),cs%diag)
494 if (cs%id_tr_adx(m)>0) &
495 call post_data(cs%id_tr_adx(m),cs%tr_adx(m)%p(:,:,:),cs%diag)
496 if (cs%id_tr_ady(m)>0) &
497 call post_data(cs%id_tr_ady(m),cs%tr_ady(m)%p(:,:,:),cs%diag)
498 if (cs%id_tr_dfx(m)>0) &
499 call post_data(cs%id_tr_dfx(m),cs%tr_dfx(m)%p(:,:,:),cs%diag)
500 if (cs%id_tr_dfy(m)>0) &
501 call post_data(cs%id_tr_dfy(m),cs%tr_dfy(m)%p(:,:,:),cs%diag)
507 type(ocean_grid_type),
intent(in) :: G
508 type(surface),
intent(inout) :: state
509 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
519 integer :: i, j, m, is, ie, js, je
520 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
522 if (.not.
associated(cs))
return 524 if (cs%coupled_tracers)
then 528 call set_coupler_values(cs%tr(:,:,1,1), state%tr_fields, cs%ind_tr(m), &
529 ind_csurf, is, ie, js, je)
539 if (
associated(cs))
then 540 if (
associated(cs%tr))
deallocate(cs%tr)
541 if (
associated(cs%tr_aux))
deallocate(cs%tr_aux)
543 if (
associated(cs%tr_adx(m)%p))
deallocate(cs%tr_adx(m)%p)
544 if (
associated(cs%tr_ady(m)%p))
deallocate(cs%tr_ady(m)%p)
545 if (
associated(cs%tr_dfx(m)%p))
deallocate(cs%tr_dfx(m)%p)
546 if (
associated(cs%tr_dfy(m)%p))
deallocate(cs%tr_dfy(m)%p)
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)
Ocean grid type. See mom_grid for details.
Provides the ocean grid type.
subroutine, public dome_tracer_surface_state(state, h, G, CS)
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. ...
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.
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
subroutine, public dome_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, evap_CFL_limit, minimum_forcing_depth)
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 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)
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...
subroutine, public initialize_dome_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, diag_to_Z_CSp)
logical function, public register_dome_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
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 dome_tracer_end(CS)
subroutine, public mom_error(level, message, all_print)