24 use coupler_types_mod,
only : coupler_type_set_data, ind_csurf
27 implicit none ;
private
29 #include <MOM_memory.h>
31 public register_dye_tracer, initialize_dye_tracer
32 public dye_tracer_column_physics, dye_tracer_surface_state
33 public dye_stock, regional_dyes_end
43 logical :: coupled_tracers = .false.
44 real,
allocatable,
dimension(:) :: dye_source_minlon
45 real,
allocatable,
dimension(:) :: dye_source_maxlon
46 real,
allocatable,
dimension(:) :: dye_source_minlat
47 real,
allocatable,
dimension(:) :: dye_source_maxlat
48 real,
allocatable,
dimension(:) :: dye_source_mindepth
49 real,
allocatable,
dimension(:) :: dye_source_maxdepth
51 real,
pointer :: tr(:,:,:,:) => null()
53 integer,
allocatable,
dimension(:) :: ind_tr
61 logical :: tracers_may_reinit = .false.
68 function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS)
81 #include "version_variable.h"
82 character(len=40) :: mdl =
"regional_dyes"
83 character(len=200) :: inputdir
84 character(len=48) :: var_name
85 character(len=48) :: desc_name
86 real,
pointer :: tr_ptr(:,:,:) => null()
87 logical :: register_dye_tracer
88 integer :: isd, ied, jsd, jed, nz, m
89 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
91 if (
associated(cs))
then
92 call mom_error(warning,
"register_dye_tracer called with an "// &
93 "associated control structure.")
100 call get_param(param_file, mdl,
"NUM_DYE_TRACERS", cs%ntr, &
101 "The number of dye tracers in this run. Each tracer "//&
102 "should have a separate region.", default=0)
103 allocate(cs%dye_source_minlon(cs%ntr), &
104 cs%dye_source_maxlon(cs%ntr), &
105 cs%dye_source_minlat(cs%ntr), &
106 cs%dye_source_maxlat(cs%ntr), &
107 cs%dye_source_mindepth(cs%ntr), &
108 cs%dye_source_maxdepth(cs%ntr))
109 allocate(cs%ind_tr(cs%ntr))
110 allocate(cs%tr_desc(cs%ntr))
112 cs%dye_source_minlon(:) = -1.e30
113 call get_param(param_file, mdl,
"DYE_SOURCE_MINLON", cs%dye_source_minlon, &
114 "This is the starting longitude at which we start injecting dyes.", &
115 fail_if_missing=.true.)
116 if (minval(cs%dye_source_minlon(:)) < -1.e29) &
117 call mom_error(fatal,
"register_dye_tracer: Not enough values provided for DYE_SOURCE_MINLON ")
119 cs%dye_source_maxlon(:) = -1.e30
120 call get_param(param_file, mdl,
"DYE_SOURCE_MAXLON", cs%dye_source_maxlon, &
121 "This is the ending longitude at which we finish injecting dyes.", &
122 fail_if_missing=.true.)
123 if (minval(cs%dye_source_maxlon(:)) < -1.e29) &
124 call mom_error(fatal,
"register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXLON ")
126 cs%dye_source_minlat(:) = -1.e30
127 call get_param(param_file, mdl,
"DYE_SOURCE_MINLAT", cs%dye_source_minlat, &
128 "This is the starting latitude at which we start injecting dyes.", &
129 fail_if_missing=.true.)
130 if (minval(cs%dye_source_minlat(:)) < -1.e29) &
131 call mom_error(fatal,
"register_dye_tracer: Not enough values provided for DYE_SOURCE_MINLAT ")
133 cs%dye_source_maxlat(:) = -1.e30
134 call get_param(param_file, mdl,
"DYE_SOURCE_MAXLAT", cs%dye_source_maxlat, &
135 "This is the ending latitude at which we finish injecting dyes.", &
136 fail_if_missing=.true.)
137 if (minval(cs%dye_source_maxlat(:)) < -1.e29) &
138 call mom_error(fatal,
"register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXLAT ")
140 cs%dye_source_mindepth(:) = -1.e30
141 call get_param(param_file, mdl,
"DYE_SOURCE_MINDEPTH", cs%dye_source_mindepth, &
142 "This is the minimum depth at which we inject dyes.", &
143 units=
"m", scale=us%m_to_Z, fail_if_missing=.true.)
144 if (minval(cs%dye_source_mindepth(:)) < -1.e29*us%m_to_Z) &
145 call mom_error(fatal,
"register_dye_tracer: Not enough values provided for DYE_SOURCE_MINDEPTH")
147 cs%dye_source_maxdepth(:) = -1.e30
148 call get_param(param_file, mdl,
"DYE_SOURCE_MAXDEPTH", cs%dye_source_maxdepth, &
149 "This is the maximum depth at which we inject dyes.", &
150 units=
"m", scale=us%m_to_Z, fail_if_missing=.true.)
151 if (minval(cs%dye_source_maxdepth(:)) < -1.e29*us%m_to_Z) &
152 call mom_error(fatal,
"register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXDEPTH ")
154 allocate(cs%tr(isd:ied,jsd:jed,nz,cs%ntr)) ; cs%tr(:,:,:,:) = 0.0
157 write(var_name(:),
'(A,I3.3)')
"dye",m
158 write(desc_name(:),
'(A,I3.3)')
"Dye Tracer ",m
159 cs%tr_desc(m) = var_desc(trim(var_name),
"conc", trim(desc_name), caller=mdl)
163 tr_ptr => cs%tr(:,:,:,m)
164 call query_vardesc(cs%tr_desc(m), name=var_name, &
165 caller=
"register_dye_tracer")
167 call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, &
168 tr_desc=cs%tr_desc(m), registry_diags=.true., &
169 restart_cs=restart_cs, mandatory=.not.cs%tracers_may_reinit)
174 if (cs%coupled_tracers) &
175 cs%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//
'_flux', &
176 flux_type=
' ', implementation=
' ', caller=
"register_dye_tracer")
180 cs%restart_CSp => restart_cs
181 register_dye_tracer = .true.
182 end function register_dye_tracer
186 subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp)
187 logical,
intent(in) :: restart
189 type(time_type),
target,
intent(in) :: day
192 real,
dimension(NIMEM_,NJMEM_,NKMEM_),
intent(in) :: h
193 type(
diag_ctrl),
target,
intent(in) :: diag
203 character(len=24) :: name
204 character(len=72) :: longname
205 character(len=48) :: units
206 character(len=48) :: flux_units
209 integer :: i, j, k, m
210 real :: z_bot, z_center
212 if (.not.
associated(cs))
return
213 if (cs%ntr < 1)
return
219 do j=g%jsd,g%jed ;
do i=g%isd,g%ied
221 if (cs%dye_source_minlon(m)<g%geoLonT(i,j) .and. &
222 cs%dye_source_maxlon(m)>=g%geoLonT(i,j) .and. &
223 cs%dye_source_minlat(m)<g%geoLatT(i,j) .and. &
224 cs%dye_source_maxlat(m)>=g%geoLatT(i,j) .and. &
225 g%mask2dT(i,j) > 0.0 )
then
226 z_bot = -g%bathyT(i,j)
228 z_center = z_bot + 0.5*h(i,j,k)*gv%H_to_Z
229 if ( z_center > -cs%dye_source_maxdepth(m) .and. &
230 z_center < -cs%dye_source_mindepth(m) )
then
233 z_bot = z_bot + h(i,j,k)*gv%H_to_Z
239 end subroutine initialize_dye_tracer
246 subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, &
247 evap_CFL_limit, minimum_forcing_depth)
250 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
252 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
254 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
258 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
262 type(
forcing),
intent(in) :: fluxes
264 real,
intent(in) :: dt
267 real,
optional,
intent(in) :: evap_cfl_limit
269 real,
optional,
intent(in) :: minimum_forcing_depth
273 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
275 real :: isecs_per_year
277 integer :: secs, days
278 integer :: i, j, k, is, ie, js, je, nz, m
279 real :: z_bot, z_center
281 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
283 if (.not.
associated(cs))
return
284 if (cs%ntr < 1)
return
286 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then
288 do k=1,nz ;
do j=js,je ;
do i=is,ie
289 h_work(i,j,k) = h_old(i,j,k)
290 enddo ;
enddo ;
enddo
291 call applytracerboundaryfluxesinout(g, gv, cs%tr(:,:,:,m) , dt, fluxes, h_work, &
292 evap_cfl_limit, minimum_forcing_depth)
293 call tracer_vertdiff(h_work, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
297 call tracer_vertdiff(h_old, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
302 do j=g%jsd,g%jed ;
do i=g%isd,g%ied
304 if (cs%dye_source_minlon(m)<g%geoLonT(i,j) .and. &
305 cs%dye_source_maxlon(m)>=g%geoLonT(i,j) .and. &
306 cs%dye_source_minlat(m)<g%geoLatT(i,j) .and. &
307 cs%dye_source_maxlat(m)>=g%geoLatT(i,j) .and. &
308 g%mask2dT(i,j) > 0.0 )
then
309 z_bot = -g%bathyT(i,j)
311 z_center = z_bot + 0.5*h_new(i,j,k)*gv%H_to_Z
312 if ( z_center > -cs%dye_source_maxdepth(m) .and. &
313 z_center < -cs%dye_source_mindepth(m) )
then
316 z_bot = z_bot + h_new(i,j,k)*gv%H_to_Z
322 end subroutine dye_tracer_column_physics
327 function dye_stock(h, stocks, G, GV, CS, names, units, stock_index)
328 real,
dimension(NIMEM_,NJMEM_,NKMEM_),
intent(in) :: h
329 real,
dimension(:),
intent(out) :: stocks
335 character(len=*),
dimension(:),
intent(out) :: names
336 character(len=*),
dimension(:),
intent(out) :: units
337 integer,
optional,
intent(in) :: stock_index
343 integer :: i, j, k, is, ie, js, je, nz, m
344 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
347 if (.not.
associated(cs))
return
348 if (cs%ntr < 1)
return
350 if (
present(stock_index))
then ;
if (stock_index > 0)
then
358 call query_vardesc(cs%tr_desc(m), name=names(m), units=units(m), caller=
"dye_stock")
359 units(m) = trim(units(m))//
" kg"
361 do k=1,nz ;
do j=js,je ;
do i=is,ie
362 stocks(m) = stocks(m) + cs%tr(i,j,k,m) * &
363 (g%mask2dT(i,j) * g%areaT(i,j) * h(i,j,k))
364 enddo ;
enddo ;
enddo
365 stocks(m) = gv%H_to_kg_m2 * stocks(m)
369 end function dye_stock
374 subroutine dye_tracer_surface_state(state, h, G, CS)
376 type(
surface),
intent(inout) :: state
378 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
386 integer :: m, is, ie, js, je, isd, ied, jsd, jed
387 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
388 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
390 if (.not.
associated(cs))
return
392 if (cs%coupled_tracers)
then
396 call coupler_type_set_data(cs%tr(:,:,1,m), cs%ind_tr(m), ind_csurf, &
397 state%tr_fields, idim=(/isd, is, ie, ied/), &
398 jdim=(/jsd, js, je, jed/) )
402 end subroutine dye_tracer_surface_state
405 subroutine regional_dyes_end(CS)
410 if (
associated(cs))
then
411 if (
associated(cs%tr))
deallocate(cs%tr)
414 end subroutine regional_dyes_end