24 use coupler_types_mod,
only : coupler_type_set_data, ind_csurf
27 implicit none ;
private
29 #include <MOM_memory.h>
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.
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()
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)
165 caller=
"register_dye_tracer")
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) &
176 flux_type=
' ', implementation=
' ', caller=
"register_dye_tracer")
180 cs%restart_CSp => restart_cs
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
246 subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, 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
268 real,
optional,
intent(in) :: evap_cfl_limit
270 real,
optional,
intent(in) :: minimum_forcing_depth
274 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
276 real :: isecs_per_year
278 integer :: secs, days
279 integer :: i, j, k, is, ie, js, je, nz, m
280 real :: z_bot, z_center
282 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
284 if (.not.
associated(cs))
return
285 if (cs%ntr < 1)
return
287 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then
289 do k=1,nz ;
do j=js,je ;
do i=is,ie
290 h_work(i,j,k) = h_old(i,j,k)
291 enddo ;
enddo ;
enddo
293 evap_cfl_limit, minimum_forcing_depth)
303 do j=g%jsd,g%jed ;
do i=g%isd,g%ied
305 if (cs%dye_source_minlon(m)<g%geoLonT(i,j) .and. &
306 cs%dye_source_maxlon(m)>=g%geoLonT(i,j) .and. &
307 cs%dye_source_minlat(m)<g%geoLatT(i,j) .and. &
308 cs%dye_source_maxlat(m)>=g%geoLatT(i,j) .and. &
309 g%mask2dT(i,j) > 0.0 )
then
310 z_bot = -g%bathyT(i,j)
312 z_center = z_bot + 0.5*h_new(i,j,k)*gv%H_to_Z
313 if ( z_center > -cs%dye_source_maxdepth(m) .and. &
314 z_center < -cs%dye_source_mindepth(m) )
then
317 z_bot = z_bot + h_new(i,j,k)*gv%H_to_Z
328 function dye_stock(h, stocks, G, GV, CS, names, units, stock_index)
329 real,
dimension(NIMEM_,NJMEM_,NKMEM_),
intent(in) :: h
330 real,
dimension(:),
intent(out) :: stocks
336 character(len=*),
dimension(:),
intent(out) :: names
337 character(len=*),
dimension(:),
intent(out) :: units
338 integer,
optional,
intent(in) :: stock_index
344 integer :: i, j, k, is, ie, js, je, nz, m
345 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
348 if (.not.
associated(cs))
return
349 if (cs%ntr < 1)
return
351 if (
present(stock_index))
then ;
if (stock_index > 0)
then
359 call query_vardesc(cs%tr_desc(m), name=names(m), units=units(m), caller=
"dye_stock")
360 units(m) = trim(units(m))//
" kg"
362 do k=1,nz ;
do j=js,je ;
do i=is,ie
363 stocks(m) = stocks(m) + cs%tr(i,j,k,m) * &
364 (g%mask2dT(i,j) * g%US%L_to_m**2*g%areaT(i,j) * h(i,j,k))
365 enddo ;
enddo ;
enddo
366 stocks(m) = gv%H_to_kg_m2 * stocks(m)
377 type(
surface),
intent(inout) :: state
379 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
387 integer :: m, is, ie, js, je, isd, ied, jsd, jed
388 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
389 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
391 if (.not.
associated(cs))
return
393 if (cs%coupled_tracers)
then
397 call coupler_type_set_data(cs%tr(:,:,1,m), cs%ind_tr(m), ind_csurf, &
398 state%tr_fields, idim=(/isd, is, ie, ied/), &
399 jdim=(/jsd, js, je, jed/) )
411 if (
associated(cs))
then
412 if (
associated(cs%tr))
deallocate(cs%tr)