79 implicit none ;
private 81 #include <MOM_memory.h> 91 real,
dimension(:,:,:),
pointer :: p => null()
96 logical :: coupled_tracers = .false.
98 type(time_type),
pointer :: time
100 real,
pointer :: tr(:,:,:,:) => null()
102 real,
pointer :: diff(:,:,:,:) => null()
104 type(
p3d),
dimension(NTR_MAX) :: &
111 logical :: mask_tracers
112 logical :: pseudo_salt_may_reinit = .true.
113 integer,
dimension(NTR_MAX) :: &
116 id_tracer = -1, id_tr_adx = -1, id_tr_ady = -1, &
117 id_tr_dfx = -1, id_tr_dfy = -1
118 real,
dimension(NTR_MAX) :: land_val = -1.0
149 #include "version_variable.h" 150 character(len=40) :: mdl =
"pseudo_salt_tracer" 151 character(len=200) :: inputdir
152 character(len=48) :: var_name
153 character(len=3) :: name_tag
154 real,
pointer :: tr_ptr(:,:,:) => null()
155 logical :: register_pseudo_salt_tracer
156 integer :: isd, ied, jsd, jed, nz, m, i, j
157 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
159 if (
associated(cs))
then 160 call mom_error(warning,
"register_pseudo_salt_tracer called with an "// &
161 "associated control structure.")
170 allocate(cs%tr(isd:ied,jsd:jed,nz,cs%ntr)) ; cs%tr(:,:,:,:) = 0.0
171 allocate(cs%diff(isd:ied,jsd:jed,nz,cs%ntr)) ; cs%diff(:,:,:,:) = 0.0
176 cs%tr_desc(m) =
var_desc(trim(
"pseudo_salt_diff"),
"kg", &
177 "Difference between pseudo salt passive tracer and salt tracer", caller=mdl)
178 tr_ptr => cs%tr(:,:,:,m)
179 call query_vardesc(cs%tr_desc(m), name=var_name, caller=
"register_pseudo_salt_tracer")
182 .not. cs%pseudo_salt_may_reinit, restart_cs)
184 call register_tracer(tr_ptr, cs%tr_desc(m), param_file, hi, gv, tr_reg, &
185 tr_desc_ptr=cs%tr_desc(m))
190 if (cs%coupled_tracers) &
192 flux_type=
' ', implementation=
' ', caller=
"register_pseudo_salt_tracer")
196 cs%restart_CSp => restart_cs
197 register_pseudo_salt_tracer = .true.
202 sponge_CSp, diag_to_Z_CSp, tv)
203 logical,
intent(in) :: restart
204 type(time_type),
target,
intent(in) :: day
207 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
208 type(
diag_ctrl),
target,
intent(in) :: diag
232 character(len=16) :: name
233 character(len=72) :: longname
234 character(len=48) :: units
235 character(len=48) :: flux_units
238 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
239 integer :: IsdB, IedB, JsdB, JedB
241 if (.not.
associated(cs))
return 242 if (cs%ntr < 1)
return 243 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
244 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
245 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
252 call query_vardesc(cs%tr_desc(m), name=name, caller=
"initialize_pseudo_salt_tracer")
253 if ((.not.restart) .or. (.not. &
255 do k=1,nz ;
do j=jsd,jed ;
do i=isd,ied
256 cs%tr(i,j,k,m) = tv%S(i,j,k)
257 enddo ;
enddo ;
enddo 261 if (
associated(obc))
then 270 if (gv%Boussinesq)
then ; flux_units =
"g salt/(m^2 s)" 271 else ; flux_units =
"g salt/(m^2 s)" ;
endif 275 call query_vardesc(cs%tr_desc(m), name, units=units, longname=longname, &
276 caller=
"initialize_pseudo_salt_tracer")
277 cs%id_tracer(m) = register_diag_field(
"ocean_model", trim(name), cs%diag%axesTL, &
278 day, trim(longname) , trim(units))
279 cs%id_tr_adx(m) = register_diag_field(
"ocean_model", trim(name)//
"_adx", &
280 cs%diag%axesCuL, day, trim(longname)//
" advective zonal flux" , &
282 cs%id_tr_ady(m) = register_diag_field(
"ocean_model", trim(name)//
"_ady", &
283 cs%diag%axesCvL, day, trim(longname)//
" advective meridional flux" , &
285 cs%id_tr_dfx(m) = register_diag_field(
"ocean_model", trim(name)//
"_dfx", &
286 cs%diag%axesCuL, day, trim(longname)//
" diffusive zonal flux" , &
288 cs%id_tr_dfy(m) = register_diag_field(
"ocean_model", trim(name)//
"_dfy", &
289 cs%diag%axesCvL, day, trim(longname)//
" diffusive zonal flux" , &
291 if (cs%id_tr_adx(m) > 0)
call safe_alloc_ptr(cs%tr_adx(m)%p,isdb,iedb,jsd,jed,nz)
292 if (cs%id_tr_ady(m) > 0)
call safe_alloc_ptr(cs%tr_ady(m)%p,isd,ied,jsdb,jedb,nz)
293 if (cs%id_tr_dfx(m) > 0)
call safe_alloc_ptr(cs%tr_dfx(m)%p,isdb,iedb,jsd,jed,nz)
294 if (cs%id_tr_dfy(m) > 0)
call safe_alloc_ptr(cs%tr_dfy(m)%p,isd,ied,jsdb,jedb,nz)
297 if ((cs%id_tr_adx(m) > 0) .or. (cs%id_tr_ady(m) > 0) .or. &
298 (cs%id_tr_dfx(m) > 0) .or. (cs%id_tr_dfy(m) > 0)) &
300 cs%tr_ady(m)%p,cs%tr_dfx(m)%p,cs%tr_dfy(m)%p)
303 day, g, diag_to_z_csp)
308 subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, &
309 evap_CFL_limit, minimum_forcing_depth)
312 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h_old, h_new, ea, eb
313 type(
forcing),
intent(in) :: fluxes
314 real,
intent(in) :: dt
317 logical,
intent(in) :: debug
318 real,
optional,
intent(in) :: evap_CFL_limit
319 real,
optional,
intent(in) :: minimum_forcing_depth
350 real :: Isecs_per_year = 1.0 / (365.0*86400.0)
351 real :: year, h_total, scale, htot, Ih_limit
352 integer :: secs, days
353 integer :: i, j, k, is, ie, js, je, nz, m, k_max
354 real,
allocatable :: local_tr(:,:,:)
355 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
356 real,
dimension(:,:),
pointer :: net_salt
358 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
359 net_salt=>fluxes%netSalt
361 if (.not.
associated(cs))
return 362 if (cs%ntr < 1)
return 365 call hchksum(tv%S,
"salt pre pseudo-salt vertdiff", g%HI)
366 call hchksum(cs%tr(:,:,:,1),
"pseudo_salt pre pseudo-salt vertdiff", g%HI)
370 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then 371 do k=1,nz ;
do j=js,je ;
do i=is,ie
372 h_work(i,j,k) = h_old(i,j,k)
373 enddo ;
enddo ; enddo;
375 evap_cfl_limit, minimum_forcing_depth, out_flux_optional=net_salt)
381 do k=1,nz ;
do j=js,je ;
do i=is,ie
382 cs%diff(i,j,k,1) = cs%tr(i,j,k,1)-tv%S(i,j,k)
383 enddo ;
enddo ;
enddo 386 call hchksum(tv%S,
"salt post pseudo-salt vertdiff", g%HI)
387 call hchksum(cs%tr(:,:,:,1),
"pseudo_salt post pseudo-salt vertdiff", g%HI)
390 allocate(local_tr(g%isd:g%ied,g%jsd:g%jed,nz))
392 if (cs%id_tracer(m)>0)
then 393 if (cs%mask_tracers)
then 394 do k=1,nz ;
do j=js,je ;
do i=is,ie
395 if (h_new(i,j,k) < 1.1*gv%Angstrom)
then 396 local_tr(i,j,k) = cs%land_val(m)
398 local_tr(i,j,k) = cs%diff(i,j,k,m)
400 enddo ;
enddo ;
enddo 402 do k=1,nz ;
do j=js,je ;
do i=is,ie
403 local_tr(i,j,k) = cs%tr(i,j,k,m)-tv%S(i,j,k)
404 enddo ;
enddo ;
enddo 406 call post_data(cs%id_tracer(m),local_tr,cs%diag)
408 if (cs%id_tr_adx(m)>0) &
409 call post_data(cs%id_tr_adx(m),cs%tr_adx(m)%p(:,:,:),cs%diag)
410 if (cs%id_tr_ady(m)>0) &
411 call post_data(cs%id_tr_ady(m),cs%tr_ady(m)%p(:,:,:),cs%diag)
412 if (cs%id_tr_dfx(m)>0) &
413 call post_data(cs%id_tr_dfx(m),cs%tr_dfx(m)%p(:,:,:),cs%diag)
414 if (cs%id_tr_dfy(m)>0) &
415 call post_data(cs%id_tr_dfy(m),cs%tr_dfy(m)%p(:,:,:),cs%diag)
424 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
425 real,
dimension(:),
intent(out) :: stocks
427 character(len=*),
dimension(:),
intent(out) :: names
428 character(len=*),
dimension(:),
intent(out) :: units
429 integer,
optional,
intent(in) :: stock_index
430 integer :: pseudo_salt_stock
447 integer :: i, j, k, is, ie, js, je, nz, m
448 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
450 pseudo_salt_stock = 0
451 if (.not.
associated(cs))
return 452 if (cs%ntr < 1)
return 454 if (
present(stock_index))
then ;
if (stock_index > 0)
then 462 call query_vardesc(cs%tr_desc(m), name=names(m), units=units(m), caller=
"pseudo_salt_stock")
463 units(m) = trim(units(m))//
" kg" 465 do k=1,nz ;
do j=js,je ;
do i=is,ie
466 stocks(m) = stocks(m) + cs%diff(i,j,k,m) * &
467 (g%mask2dT(i,j) * g%areaT(i,j) * h(i,j,k))
468 enddo ;
enddo ;
enddo 469 stocks(m) = gv%H_to_kg_m2 * stocks(m)
472 pseudo_salt_stock = cs%ntr
478 type(
surface),
intent(inout) :: state
479 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
489 integer :: m, is, ie, js, je
490 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
492 if (.not.
associated(cs))
return 494 if (cs%coupled_tracers)
then 499 ind_csurf, is, ie, js, je)
509 if (
associated(cs))
then 510 if (
associated(cs%tr))
deallocate(cs%tr)
511 if (
associated(cs%tr))
deallocate(cs%diff)
513 if (
associated(cs%tr_adx(m)%p))
deallocate(cs%tr_adx(m)%p)
514 if (
associated(cs%tr_ady(m)%p))
deallocate(cs%tr_ady(m)%p)
515 if (
associated(cs%tr_dfx(m)%p))
deallocate(cs%tr_dfx(m)%p)
516 if (
associated(cs%tr_dfy(m)%p))
deallocate(cs%tr_dfy(m)%p)
integer function, public pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index)
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...
subroutine, public pseudo_salt_tracer_end(CS)
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.
Provides the ocean grid type.
subroutine, public pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, evap_CFL_limit, minimum_forcing_depth)
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 initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, diag_to_Z_CSp, tv)
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 pseudo_salt_tracer_surface_state(state, h, G, CS)
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.
integer, parameter ntr_max
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...
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 mom_error(level, message, all_print)
logical function, public register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)