24 use coupler_types_mod,
only : coupler_type_set_data, ind_csurf
27 implicit none ;
private
29 #include <MOM_memory.h>
31 public register_dome_tracer, initialize_dome_tracer
32 public dome_tracer_column_physics, dome_tracer_surface_state, dome_tracer_end
39 integer,
parameter :: ntr = 11
43 logical :: coupled_tracers = .false.
44 character(len=200) :: tracer_ic_file
45 type(time_type),
pointer :: time => null()
47 real,
pointer :: tr(:,:,:,:) => null()
48 real :: land_val(ntr) = -1.0
51 integer,
dimension(NTR) :: ind_tr
63 function register_dome_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
73 character(len=80) :: name, longname
75 #include "version_variable.h"
76 character(len=40) :: mdl =
"DOME_tracer"
77 character(len=48) :: flux_units
79 character(len=200) :: inputdir
80 real,
pointer :: tr_ptr(:,:,:) => null()
81 logical :: register_dome_tracer
82 integer :: isd, ied, jsd, jed, nz, m
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,
"DOME_register_tracer called with an "// &
87 "associated control structure.")
94 call get_param(param_file, mdl,
"DOME_TRACER_IC_FILE", cs%tracer_IC_file, &
95 "The name of a file from which to read the initial "//&
96 "conditions for the DOME tracers, or blank to initialize "//&
97 "them internally.", default=
" ")
98 if (len_trim(cs%tracer_IC_file) >= 1)
then
99 call get_param(param_file, mdl,
"INPUTDIR", inputdir, default=
".")
100 inputdir = slasher(inputdir)
101 cs%tracer_IC_file = trim(inputdir)//trim(cs%tracer_IC_file)
102 call log_param(param_file, mdl,
"INPUTDIR/DOME_TRACER_IC_FILE", &
105 call get_param(param_file, mdl,
"SPONGE", cs%use_sponge, &
106 "If true, sponges may be applied anywhere in the domain. "//&
107 "The exact location and properties of those sponges are "//&
108 "specified from MOM_initialization.F90.", default=.false.)
110 allocate(cs%tr(isd:ied,jsd:jed,nz,ntr)) ; cs%tr(:,:,:,:) = 0.0
113 if (m < 10)
then ;
write(name,
'("tr_D",I1.1)') m
114 else ;
write(name,
'("tr_D",I2.2)') m ;
endif
115 write(longname,
'("Concentration of DOME Tracer ",I2.2)') m
116 cs%tr_desc(m) = var_desc(name, units=
"kg kg-1", longname=longname, caller=mdl)
117 if (gv%Boussinesq)
then ; flux_units =
"kg kg-1 m3 s-1"
118 else ; flux_units =
"kg s-1" ;
endif
122 tr_ptr => cs%tr(:,:,:,m)
124 call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, &
125 name=name, longname=longname, units=
"kg kg-1", &
126 registry_diags=.true., flux_units=flux_units, &
127 restart_cs=restart_cs)
132 if (cs%coupled_tracers) &
133 cs%ind_tr(m) = aof_set_coupler_flux(trim(name)//
'_flux', &
134 flux_type=
' ', implementation=
' ', caller=
"register_DOME_tracer")
138 register_dome_tracer = .true.
139 end function register_dome_tracer
142 subroutine initialize_dome_tracer(restart, day, G, GV, US, h, diag, OBC, CS, &
143 sponge_CSp, param_file)
147 logical,
intent(in) :: restart
149 type(time_type),
target,
intent(in) :: day
150 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
151 type(
diag_ctrl),
target,
intent(in) :: diag
160 real,
allocatable :: temp(:,:,:)
161 real,
pointer,
dimension(:,:,:) :: &
162 obc_tr1_u => null(), &
166 character(len=16) :: name
167 character(len=72) :: longname
168 character(len=48) :: units
169 character(len=48) :: flux_units
171 real,
pointer :: tr_ptr(:,:,:) => null()
177 real :: e(szk_(g)+1), e_top, e_bot
179 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
180 integer :: isdb, iedb, jsdb, jedb
182 if (.not.
associated(cs))
return
183 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
184 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
185 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
186 h_neglect = gv%H_subroundoff
191 if (.not.restart)
then
192 if (len_trim(cs%tracer_IC_file) >= 1)
then
194 if (.not.
file_exists(cs%tracer_IC_file, g%Domain)) &
195 call mom_error(fatal,
"DOME_initialize_tracer: Unable to open "// &
198 call query_vardesc(cs%tr_desc(m), name, caller=
"initialize_DOME_tracer")
199 call mom_read_data(cs%tracer_IC_file, trim(name), cs%tr(:,:,:,m), g%Domain)
203 do k=1,nz ;
do j=js,je ;
do i=is,ie
204 cs%tr(i,j,k,m) = 1.0e-20
205 enddo ;
enddo ;
enddo
209 do m=2,ntr ;
do j=js,je ;
do i=is,ie
211 if ((m <= 6) .and. (g%geoLatT(i,j) > (300.0+50.0*real(m-1))) .and. &
212 (g%geoLatT(i,j) < (350.0+50.0*real(m-1)))) tr_y = 1.0
215 cs%tr(i,j,k,m) = cs%tr(i,j,k,m) + tr_y
217 enddo ;
enddo ;
enddo
220 do j=js,je ;
do i=is,ie
221 e(nz+1) = -g%bathyT(i,j)
223 e(k) = e(k+1) + h(i,j,k)*gv%H_to_Z
225 e_top = (-600.0*real(m-1) + 3000.0) * us%m_to_Z
226 e_bot = (-600.0*real(m-1) + 2700.0) * us%m_to_Z
227 if (e_top < e(k))
then
228 if (e_top < e(k+1))
then ; d_tr = 0.0
229 elseif (e_bot < e(k+1))
then
230 d_tr = 1.0 * (e_top-e(k+1)) / ((h(i,j,k)+h_neglect)*gv%H_to_Z)
231 else ; d_tr = 1.0 * (e_top-e_bot) / ((h(i,j,k)+h_neglect)*gv%H_to_Z)
233 elseif (e_bot < e(k))
then
234 if (e_bot < e(k+1))
then ; d_tr = 1.0
235 else ; d_tr = 1.0 * (e(k)-e_bot) / ((h(i,j,k)+h_neglect)*gv%H_to_Z)
240 if (h(i,j,k) < 2.0*gv%Angstrom_H) d_tr=0.0
241 cs%tr(i,j,k,m) = cs%tr(i,j,k,m) + d_tr
250 if ( cs%use_sponge )
then
255 if (.not.
associated(sponge_csp)) &
256 call mom_error(fatal,
"DOME_initialize_tracer: "// &
257 "The pointer to sponge_CSp must be associated if SPONGE is defined.")
259 allocate(temp(g%isd:g%ied,g%jsd:g%jed,nz))
260 do k=1,nz ;
do j=js,je ;
do i=is,ie
261 if (g%geoLatT(i,j) > 700.0 .and. (k > nz/2))
then
266 enddo ;
enddo ;
enddo
272 tr_ptr => cs%tr(:,:,:,m)
273 call set_up_sponge_field(temp, tr_ptr, g, nz, sponge_csp)
278 end subroutine initialize_dome_tracer
286 subroutine dome_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, &
287 evap_CFL_limit, minimum_forcing_depth)
290 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
292 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
294 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
298 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
302 type(
forcing),
intent(in) :: fluxes
304 real,
intent(in) :: dt
307 real,
optional,
intent(in) :: evap_cfl_limit
309 real,
optional,
intent(in) :: minimum_forcing_depth
314 real :: c1(szi_(g),szk_(g))
315 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
316 integer :: i, j, k, is, ie, js, je, nz, m
317 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
319 if (.not.
associated(cs))
return
321 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then
323 do k=1,nz ;
do j=js,je ;
do i=is,ie
324 h_work(i,j,k) = h_old(i,j,k)
325 enddo ;
enddo ;
enddo
326 call applytracerboundaryfluxesinout(g, gv, cs%tr(:,:,:,m) , dt, fluxes, h_work, &
327 evap_cfl_limit, minimum_forcing_depth)
328 call tracer_vertdiff(h_work, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
332 call tracer_vertdiff(h_old, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
336 end subroutine dome_tracer_column_physics
341 subroutine dome_tracer_surface_state(state, h, G, CS)
343 type(
surface),
intent(inout) :: state
345 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
353 integer :: m, is, ie, js, je, isd, ied, jsd, jed
354 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
355 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
357 if (.not.
associated(cs))
return
359 if (cs%coupled_tracers)
then
363 call coupler_type_set_data(cs%tr(:,:,1,m), cs%ind_tr(m), ind_csurf, &
364 state%tr_fields, idim=(/isd, is, ie, ied/), &
365 jdim=(/jsd, js, je, jed/) )
369 end subroutine dome_tracer_surface_state
372 subroutine dome_tracer_end(CS)
377 if (
associated(cs))
then
378 if (
associated(cs%tr))
deallocate(cs%tr)
381 end subroutine dome_tracer_end