24 use coupler_types_mod,
only : coupler_type_set_data, ind_csurf
27 implicit none ;
private
29 #include <MOM_memory.h>
31 public register_ideal_age_tracer, initialize_ideal_age_tracer
32 public ideal_age_tracer_column_physics, ideal_age_tracer_surface_state
33 public ideal_age_stock, ideal_age_example_end
35 integer,
parameter :: ntr_max = 3
40 logical :: coupled_tracers = .false.
43 character(len=200) :: ic_file
46 type(time_type),
pointer :: time => null()
48 real,
pointer :: tr(:,:,:,:) => null()
49 real,
dimension(NTR_MAX) :: ic_val = 0.0
50 real,
dimension(NTR_MAX) :: young_val = 0.0
51 real,
dimension(NTR_MAX) :: land_val = -1.0
52 real,
dimension(NTR_MAX) :: sfc_growth_rate
53 real,
dimension(NTR_MAX) :: tracer_start_year
55 logical :: tracers_may_reinit
57 logical :: tracer_ages(ntr_max)
59 integer,
dimension(NTR_MAX) :: ind_tr
72 function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
84 #include "version_variable.h"
85 character(len=40) :: mdl =
"ideal_age_example"
86 character(len=200) :: inputdir
87 character(len=48) :: var_name
88 real,
pointer :: tr_ptr(:,:,:) => null()
89 logical :: register_ideal_age_tracer
90 logical :: do_ideal_age, do_vintage, do_ideal_age_dated
91 integer :: isd, ied, jsd, jed, nz, m
92 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
94 if (
associated(cs))
then
95 call mom_error(warning,
"register_ideal_age_tracer called with an "// &
96 "associated control structure.")
103 call get_param(param_file, mdl,
"DO_IDEAL_AGE", do_ideal_age, &
104 "If true, use an ideal age tracer that is set to 0 age "//&
105 "in the mixed layer and ages at unit rate in the interior.", &
107 call get_param(param_file, mdl,
"DO_IDEAL_VINTAGE", do_vintage, &
108 "If true, use an ideal vintage tracer that is set to an "//&
109 "exponentially increasing value in the mixed layer and "//&
110 "is conserved thereafter.", default=.false.)
111 call get_param(param_file, mdl,
"DO_IDEAL_AGE_DATED", do_ideal_age_dated, &
112 "If true, use an ideal age tracer that is everywhere 0 "//&
113 "before IDEAL_AGE_DATED_START_YEAR, but the behaves like "//&
114 "the standard ideal age tracer - i.e. is set to 0 age in "//&
115 "the mixed layer and ages at unit rate in the interior.", &
119 call get_param(param_file, mdl,
"AGE_IC_FILE", cs%IC_file, &
120 "The file in which the age-tracer initial values can be "//&
121 "found, or an empty string for internal initialization.", &
123 if ((len_trim(cs%IC_file) > 0) .and. (scan(cs%IC_file,
'/') == 0))
then
125 call get_param(param_file, mdl,
"INPUTDIR", inputdir, default=
".")
126 cs%IC_file = trim(slasher(inputdir))//trim(cs%IC_file)
127 call log_param(param_file, mdl,
"INPUTDIR/AGE_IC_FILE", cs%IC_file)
129 call get_param(param_file, mdl,
"AGE_IC_FILE_IS_Z", cs%Z_IC_file, &
130 "If true, AGE_IC_FILE is in depth space, not layer space", &
132 call get_param(param_file, mdl,
"TRACERS_MAY_REINIT", cs%tracers_may_reinit, &
133 "If true, tracers may go through the initialization code "//&
134 "if they are not found in the restart files. Otherwise "//&
135 "it is a fatal error if the tracers are not found in the "//&
136 "restart files of a restarted run.", default=.false.)
139 if (do_ideal_age)
then
140 cs%ntr = cs%ntr + 1 ; m = cs%ntr
141 cs%tr_desc(m) = var_desc(
"age",
"yr",
"Ideal Age Tracer", cmor_field_name=
"agessc", caller=mdl)
142 cs%tracer_ages(m) = .true. ; cs%sfc_growth_rate(m) = 0.0
143 cs%IC_val(m) = 0.0 ; cs%young_val(m) = 0.0 ; cs%tracer_start_year(m) = 0.0
147 cs%ntr = cs%ntr + 1 ; m = cs%ntr
148 cs%tr_desc(m) = var_desc(
"vintage",
"yr",
"Exponential Vintage Tracer", &
150 cs%tracer_ages(m) = .false. ; cs%sfc_growth_rate(m) = 1.0/30.0
151 cs%IC_val(m) = 0.0 ; cs%young_val(m) = 1e-20 ; cs%tracer_start_year(m) = 0.0
152 call get_param(param_file, mdl,
"IDEAL_VINTAGE_START_YEAR", cs%tracer_start_year(m), &
153 "The date at which the ideal vintage tracer starts.", &
154 units=
"years", default=0.0)
157 if (do_ideal_age_dated)
then
158 cs%ntr = cs%ntr + 1 ; m = cs%ntr
159 cs%tr_desc(m) = var_desc(
"age_dated",
"yr",
"Ideal Age Tracer with a Start Date",&
161 cs%tracer_ages(m) = .true. ; cs%sfc_growth_rate(m) = 0.0
162 cs%IC_val(m) = 0.0 ; cs%young_val(m) = 0.0 ; cs%tracer_start_year(m) = 0.0
163 call get_param(param_file, mdl,
"IDEAL_AGE_DATED_START_YEAR", cs%tracer_start_year(m), &
164 "The date at which the dated ideal age tracer starts.", &
165 units=
"years", default=0.0)
168 allocate(cs%tr(isd:ied,jsd:jed,nz,cs%ntr)) ; cs%tr(:,:,:,:) = 0.0
173 tr_ptr => cs%tr(:,:,:,m)
174 call query_vardesc(cs%tr_desc(m), name=var_name, &
175 caller=
"register_ideal_age_tracer")
177 call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, tr_desc=cs%tr_desc(m), &
178 registry_diags=.true., restart_cs=restart_cs, &
179 mandatory=.not.cs%tracers_may_reinit)
184 if (cs%coupled_tracers) &
185 cs%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//
'_flux', &
186 flux_type=
' ', implementation=
' ', caller=
"register_ideal_age_tracer")
190 cs%restart_CSp => restart_cs
191 register_ideal_age_tracer = .true.
192 end function register_ideal_age_tracer
195 subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS, &
197 logical,
intent(in) :: restart
199 type(time_type),
target,
intent(in) :: day
203 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
205 type(
diag_ctrl),
target,
intent(in) :: diag
218 character(len=24) :: name
219 character(len=72) :: longname
220 character(len=48) :: units
221 character(len=48) :: flux_units
223 character(len=72) :: cmorname
225 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
226 integer :: isdb, iedb, jsdb, jedb
228 if (.not.
associated(cs))
return
229 if (cs%ntr < 1)
return
230 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
231 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
232 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
236 cs%nkml = max(gv%nkml,1)
239 call query_vardesc(cs%tr_desc(m), name=name, &
240 caller=
"initialize_ideal_age_tracer")
241 if ((.not.restart) .or. (cs%tracers_may_reinit .and. .not. &
244 if (len_trim(cs%IC_file) > 0)
then
247 call mom_error(fatal,
"initialize_ideal_age_tracer: "// &
248 "Unable to open "//cs%IC_file)
250 if (cs%Z_IC_file)
then
251 ok = tracer_z_init(cs%tr(:,:,:,m), h, cs%IC_file, name,&
254 ok = tracer_z_init(cs%tr(:,:,:,m), h, cs%IC_file, &
255 trim(name), g, us, -1e34, 0.0)
256 if (.not.ok)
call mom_error(fatal,
"initialize_ideal_age_tracer: "//&
257 "Unable to read "//trim(name)//
" from "//&
258 trim(cs%IC_file)//
".")
261 call mom_read_data(cs%IC_file, trim(name), cs%tr(:,:,:,m), g%Domain)
264 do k=1,nz ;
do j=js,je ;
do i=is,ie
265 if (g%mask2dT(i,j) < 0.5)
then
266 cs%tr(i,j,k,m) = cs%land_val(m)
268 cs%tr(i,j,k,m) = cs%IC_val(m)
270 enddo ;
enddo ;
enddo
276 if (
associated(obc))
then
280 end subroutine initialize_ideal_age_tracer
283 subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, &
284 evap_CFL_limit, minimum_forcing_depth)
287 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
289 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
291 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
295 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
299 type(
forcing),
intent(in) :: fluxes
301 real,
intent(in) :: dt
304 real,
optional,
intent(in) :: evap_cfl_limit
306 real,
optional,
intent(in) :: minimum_forcing_depth
315 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
317 real :: isecs_per_year
319 integer :: i, j, k, is, ie, js, je, nz, m
320 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
322 if (.not.
associated(cs))
return
323 if (cs%ntr < 1)
return
325 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then
327 do k=1,nz ;
do j=js,je ;
do i=is,ie
328 h_work(i,j,k) = h_old(i,j,k)
329 enddo ;
enddo ;
enddo
330 call applytracerboundaryfluxesinout(g, gv, cs%tr(:,:,:,m) , dt, fluxes, h_work, &
331 evap_cfl_limit, minimum_forcing_depth)
332 call tracer_vertdiff(h_work, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
336 call tracer_vertdiff(h_old, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
340 isecs_per_year = 1.0 / (365.0*86400.0)
343 year = time_type_to_real(cs%Time) * isecs_per_year
346 if (cs%sfc_growth_rate(m) == 0.0)
then
347 sfc_val = cs%young_val(m)
349 sfc_val = cs%young_val(m) * &
350 exp((year-cs%tracer_start_year(m)) * cs%sfc_growth_rate(m))
352 do k=1,cs%nkml ;
do j=js,je ;
do i=is,ie
353 if (g%mask2dT(i,j) > 0.5)
then
354 cs%tr(i,j,k,m) = sfc_val
356 cs%tr(i,j,k,m) = cs%land_val(m)
358 enddo ;
enddo ;
enddo
360 do m=1,cs%ntr ;
if (cs%tracer_ages(m) .and. &
361 (year>=cs%tracer_start_year(m)))
then
363 do k=cs%nkml+1,nz ;
do j=js,je ;
do i=is,ie
364 cs%tr(i,j,k,m) = cs%tr(i,j,k,m) + g%mask2dT(i,j)*dt*isecs_per_year
365 enddo ;
enddo ;
enddo
368 end subroutine ideal_age_tracer_column_physics
372 function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index)
374 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
376 real,
dimension(:),
intent(out) :: stocks
381 character(len=*),
dimension(:),
intent(out) :: names
382 character(len=*),
dimension(:),
intent(out) :: units
383 integer,
optional,
intent(in) :: stock_index
385 integer :: ideal_age_stock
390 integer :: i, j, k, is, ie, js, je, nz, m
391 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
394 if (.not.
associated(cs))
return
395 if (cs%ntr < 1)
return
397 if (
present(stock_index))
then ;
if (stock_index > 0)
then
405 call query_vardesc(cs%tr_desc(m), name=names(m), units=units(m), caller=
"ideal_age_stock")
406 units(m) = trim(units(m))//
" kg"
408 do k=1,nz ;
do j=js,je ;
do i=is,ie
409 stocks(m) = stocks(m) + cs%tr(i,j,k,m) * &
410 (g%mask2dT(i,j) * g%areaT(i,j) * h(i,j,k))
411 enddo ;
enddo ;
enddo
412 stocks(m) = gv%H_to_kg_m2 * stocks(m)
414 ideal_age_stock = cs%ntr
416 end function ideal_age_stock
421 subroutine ideal_age_tracer_surface_state(state, h, G, CS)
423 type(
surface),
intent(inout) :: state
425 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
433 integer :: m, is, ie, js, je, isd, ied, jsd, jed
434 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
435 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
437 if (.not.
associated(cs))
return
439 if (cs%coupled_tracers)
then
443 call coupler_type_set_data(cs%tr(:,:,1,m), cs%ind_tr(m), ind_csurf, &
444 state%tr_fields, idim=(/isd, is, ie, ied/), &
445 jdim=(/jsd, js, je, jed/) )
449 end subroutine ideal_age_tracer_surface_state
452 subroutine ideal_age_example_end(CS)
458 if (
associated(cs))
then
459 if (
associated(cs%tr))
deallocate(cs%tr)
462 end subroutine ideal_age_example_end