24 use coupler_types_mod,
only : coupler_type_set_data, ind_csurf
27 implicit none ;
private
29 #include <MOM_memory.h>
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
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()
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)
125 name=name, longname=longname, units=
"kg kg-1", &
126 registry_diags=.true., restart_cs=restart_cs, &
127 flux_units=trim(flux_units), flux_scale=gv%H_to_MKS)
132 if (cs%coupled_tracers) &
134 flux_type=
' ', implementation=
' ', caller=
"register_DOME_tracer")
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()
176 real :: e(szk_(g)+1), e_top, e_bot
178 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
179 integer :: isdb, iedb, jsdb, jedb
181 if (.not.
associated(cs))
return
182 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
183 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
184 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
185 h_neglect = gv%H_subroundoff
190 if (.not.restart)
then
191 if (len_trim(cs%tracer_IC_file) >= 1)
then
193 if (.not.
file_exists(cs%tracer_IC_file, g%Domain)) &
194 call mom_error(fatal,
"DOME_initialize_tracer: Unable to open "// &
197 call query_vardesc(cs%tr_desc(m), name, caller=
"initialize_DOME_tracer")
198 call mom_read_data(cs%tracer_IC_file, trim(name), cs%tr(:,:,:,m), g%Domain)
202 do k=1,nz ;
do j=js,je ;
do i=is,ie
203 cs%tr(i,j,k,m) = 1.0e-20
204 enddo ;
enddo ;
enddo
208 do m=2,
ntr ;
do j=js,je ;
do i=is,ie
210 if ((m <= 6) .and. (g%geoLatT(i,j) > (300.0+50.0*real(m-1))) .and. &
211 (g%geoLatT(i,j) < (350.0+50.0*real(m-1)))) tr_y = 1.0
214 cs%tr(i,j,k,m) = cs%tr(i,j,k,m) + tr_y
216 enddo ;
enddo ;
enddo
219 do j=js,je ;
do i=is,ie
220 e(nz+1) = -g%bathyT(i,j)
222 e(k) = e(k+1) + h(i,j,k)*gv%H_to_Z
224 e_top = (-600.0*real(m-1) + 3000.0) * us%m_to_Z
225 e_bot = (-600.0*real(m-1) + 2700.0) * us%m_to_Z
226 if (e_top < e(k))
then
227 if (e_top < e(k+1))
then ; d_tr = 0.0
228 elseif (e_bot < e(k+1))
then
229 d_tr = 1.0 * (e_top-e(k+1)) / ((h(i,j,k)+h_neglect)*gv%H_to_Z)
230 else ; d_tr = 1.0 * (e_top-e_bot) / ((h(i,j,k)+h_neglect)*gv%H_to_Z)
232 elseif (e_bot < e(k))
then
233 if (e_bot < e(k+1))
then ; d_tr = 1.0
234 else ; d_tr = 1.0 * (e(k)-e_bot) / ((h(i,j,k)+h_neglect)*gv%H_to_Z)
239 if (h(i,j,k) < 2.0*gv%Angstrom_H) d_tr=0.0
240 cs%tr(i,j,k,m) = cs%tr(i,j,k,m) + d_tr
249 if ( cs%use_sponge )
then
254 if (.not.
associated(sponge_csp)) &
255 call mom_error(fatal,
"DOME_initialize_tracer: "// &
256 "The pointer to sponge_CSp must be associated if SPONGE is defined.")
258 allocate(temp(g%isd:g%ied,g%jsd:g%jed,nz))
259 do k=1,nz ;
do j=js,je ;
do i=is,ie
260 if (g%geoLatT(i,j) > 700.0 .and. (k > nz/2))
then
265 enddo ;
enddo ;
enddo
271 tr_ptr => cs%tr(:,:,:,m)
285 subroutine dome_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, &
286 evap_CFL_limit, minimum_forcing_depth)
289 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
291 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
293 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
297 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
301 type(
forcing),
intent(in) :: fluxes
303 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
327 evap_cfl_limit, minimum_forcing_depth)
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/) )
377 if (
associated(cs))
then
378 if (
associated(cs%tr))
deallocate(cs%tr)