22 use coupler_types_mod,
only : coupler_type_set_data, ind_csurf
25 implicit none ;
private
27 #include <MOM_memory.h>
32 integer,
parameter ::
ntr = 1
36 logical :: coupled_tracers = .false.
37 character(len=200) :: tracer_ic_file
39 type(time_type),
pointer :: time => null()
41 real,
pointer :: tr(:,:,:,:) => null()
42 real :: land_val(
ntr) = -1.0
45 integer,
dimension(NTR) :: ind_tr
68 character(len=80) :: name, longname
70 #include "version_variable.h"
71 character(len=40) :: mdl =
"tracer_example"
72 character(len=200) :: inputdir
73 character(len=48) :: flux_units
75 real,
pointer :: tr_ptr(:,:,:) => null()
77 integer :: isd, ied, jsd, jed, nz, m
78 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
80 if (
associated(cs))
then
81 call mom_error(warning,
"USER_register_tracer_example called with an "// &
82 "associated control structure.")
89 call get_param(param_file, mdl,
"TRACER_EXAMPLE_IC_FILE", cs%tracer_IC_file, &
90 "The name of a file from which to read the initial "//&
91 "conditions for the DOME tracers, or blank to initialize "//&
92 "them internally.", default=
" ")
93 if (len_trim(cs%tracer_IC_file) >= 1)
then
94 call get_param(param_file, mdl,
"INPUTDIR", inputdir, default=
".")
95 cs%tracer_IC_file = trim(slasher(inputdir))//trim(cs%tracer_IC_file)
96 call log_param(param_file, mdl,
"INPUTDIR/TRACER_EXAMPLE_IC_FILE", &
99 call get_param(param_file, mdl,
"SPONGE", cs%use_sponge, &
100 "If true, sponges may be applied anywhere in the domain. "//&
101 "The exact location and properties of those sponges are "//&
102 "specified from MOM_initialization.F90.", default=.false.)
104 allocate(cs%tr(isd:ied,jsd:jed,nz,
ntr)) ; cs%tr(:,:,:,:) = 0.0
107 if (m < 10)
then ;
write(name,
'("tr",I1.1)') m
108 else ;
write(name,
'("tr",I2.2)') m ;
endif
109 write(longname,
'("Concentration of Tracer ",I2.2)') m
110 cs%tr_desc(m) =
var_desc(name, units=
"kg kg-1", longname=longname, caller=mdl)
113 if (gv%Boussinesq)
then ; flux_units =
"kg kg-1 m3 s-1"
114 else ; flux_units =
"kg s-1" ;
endif
118 tr_ptr => cs%tr(:,:,:,m)
121 name=name, longname=longname, units=
"kg kg-1", &
122 registry_diags=.true., flux_units=flux_units, &
123 restart_cs=restart_cs)
128 if (cs%coupled_tracers) &
130 flux_type=
' ', implementation=
' ', caller=
"USER_register_tracer_example")
141 logical,
intent(in) :: restart
143 type(time_type),
target,
intent(in) :: day
146 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
148 type(
diag_ctrl),
target,
intent(in) :: diag
159 real,
allocatable :: temp(:,:,:)
160 character(len=32) :: name
161 character(len=72) :: longname
162 character(len=48) :: units
163 character(len=48) :: flux_units
165 real,
pointer :: tr_ptr(:,:,:) => null()
169 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
170 integer :: isdb, iedb, jsdb, jedb, lntr
172 if (.not.
associated(cs))
return
173 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
174 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
175 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
181 if (.not.restart)
then
182 if (len_trim(cs%tracer_IC_file) >= 1)
then
184 if (.not.
file_exists(cs%tracer_IC_file, g%Domain)) &
185 call mom_error(fatal,
"USER_initialize_tracer: Unable to open "// &
188 call query_vardesc(cs%tr_desc(m), name, caller=
"USER_initialize_tracer")
189 call mom_read_data(cs%tracer_IC_file, trim(name), cs%tr(:,:,:,m), g%Domain)
193 do k=1,nz ;
do j=js,je ;
do i=is,ie
194 cs%tr(i,j,k,m) = 1.0e-20
195 enddo ;
enddo ;
enddo
201 dist2 = (g%Rad_Earth * pi / 180.0)**2 * &
202 (g%geoLatT(i,j) - 40.0) * (g%geoLatT(i,j) - 40.0)
203 tr_y = 0.5*exp(-dist2/(1.0e5*1.0e5))
205 do k=1,nz ;
do i=is,ie
207 cs%tr(i,j,k,1) = cs%tr(i,j,k,1) + tr_y
213 if ( cs%use_sponge )
then
218 if (.not.
associated(sponge_csp)) &
219 call mom_error(fatal,
"USER_initialize_tracer: "// &
220 "The pointer to sponge_CSp must be associated if SPONGE is defined.")
222 allocate(temp(g%isd:g%ied,g%jsd:g%jed,nz))
223 do k=1,nz ;
do j=js,je ;
do i=is,ie
224 if (g%geoLatT(i,j) > 700.0 .and. (k > nz/2))
then
229 enddo ;
enddo ;
enddo
235 tr_ptr => cs%tr(:,:,:,m)
241 if (
associated(obc))
then
242 call query_vardesc(cs%tr_desc(1), name, caller=
"USER_initialize_tracer")
243 if (obc%specified_v_BCs_exist_globally)
then
251 call query_vardesc(cs%tr_desc(m), name, caller=
"USER_initialize_tracer")
266 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
268 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
270 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
274 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
278 type(
forcing),
intent(in) :: fluxes
280 real,
intent(in) :: dt
286 real :: hold0(szi_(g))
289 real :: c1(szi_(g),szk_(g))
294 integer :: i, j, k, is, ie, js, je, nz, m
314 data trdc / 1.0,0.0,0.0 /
315 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
317 if (.not.
associated(cs))
return
318 h_neglect = gv%H_subroundoff
325 hold0(i) = h_old(i,j,1)
332 b_denom_1 = h_old(i,j,1) + ea(i,j,1) + h_neglect
333 b1(i) = 1.0 / (b_denom_1 + eb(i,j,1))
335 d1(i) = trdc(1) * (b_denom_1 * b1(i)) + (1.0 - trdc(1))
337 cs%tr(i,j,1,m) = b1(i)*(hold0(i)*cs%tr(i,j,1,m) + trdc(3)*eb(i,j,1))
341 do k=2,nz ;
do i=is,ie
342 c1(i,k) = trdc(1) * eb(i,j,k-1) * b1(i)
343 b_denom_1 = h_old(i,j,k) + d1(i)*ea(i,j,k) + h_neglect
344 b1(i) = 1.0 / (b_denom_1 + eb(i,j,k))
345 d1(i) = trdc(1) * (b_denom_1 * b1(i)) + (1.0 - trdc(1))
347 cs%tr(i,j,k,m) = b1(i) * (h_old(i,j,k)*cs%tr(i,j,k,m) + &
348 ea(i,j,k)*(trdc(1)*cs%tr(i,j,k-1,m)+trdc(2)) + &
352 do m=1,
ntr ;
do k=nz-1,1,-1 ;
do i=is,ie
353 cs%tr(i,j,k,m) = cs%tr(i,j,k,m) + c1(i,k+1)*cs%tr(i,j,k+1,m)
354 enddo ;
enddo ;
enddo
365 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
367 real,
dimension(:),
intent(out) :: stocks
371 character(len=*),
dimension(:),
intent(out) :: names
372 character(len=*),
dimension(:),
intent(out) :: units
373 integer,
optional,
intent(in) :: stock_index
379 integer :: i, j, k, is, ie, js, je, nz, m
380 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
383 if (.not.
associated(cs))
return
385 if (
present(stock_index))
then ;
if (stock_index > 0)
then
393 call query_vardesc(cs%tr_desc(m), name=names(m), units=units(m), caller=
"USER_tracer_stock")
394 units(m) = trim(units(m))//
" kg"
396 do k=1,nz ;
do j=js,je ;
do i=is,ie
397 stocks(m) = stocks(m) + cs%tr(i,j,k,m) * &
398 (g%mask2dT(i,j) * g%US%L_to_m**2*g%areaT(i,j) * h(i,j,k))
399 enddo ;
enddo ;
enddo
400 stocks(m) = gv%H_to_kg_m2 * stocks(m)
410 type(
surface),
intent(inout) :: state
412 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
420 integer :: m, is, ie, js, je, isd, ied, jsd, jed
421 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
422 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
424 if (.not.
associated(cs))
return
426 if (cs%coupled_tracers)
then
430 call coupler_type_set_data(cs%tr(:,:,1,m), cs%ind_tr(m), ind_csurf, &
431 state%tr_fields, idim=(/isd, is, ie, ied/), &
432 jdim=(/jsd, js, je, jed/) )
444 if (
associated(cs))
then
445 if (
associated(cs%tr))
deallocate(cs%tr)