24 use coupler_types_mod,
only : coupler_type_set_data, ind_csurf
27 implicit none ;
private
29 #include <MOM_memory.h>
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
59 integer,
dimension(NTR_MAX) :: ind_tr
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()
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)
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, &
180 flux_scale=gv%H_to_m)
185 if (cs%coupled_tracers) &
187 flux_type=
' ', implementation=
' ', caller=
"register_ideal_age_tracer")
191 cs%restart_CSp => restart_cs
198 logical,
intent(in) :: restart
200 type(time_type),
target,
intent(in) :: day
204 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
206 type(
diag_ctrl),
target,
intent(in) :: diag
219 character(len=24) :: name
220 character(len=72) :: longname
221 character(len=48) :: units
222 character(len=48) :: flux_units
224 character(len=72) :: cmorname
226 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
227 integer :: isdb, iedb, jsdb, jedb
229 if (.not.
associated(cs))
return
230 if (cs%ntr < 1)
return
231 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
232 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
233 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
237 cs%nkml = max(gv%nkml,1)
241 caller=
"initialize_ideal_age_tracer")
242 if ((.not.restart) .or. (cs%tracers_may_reinit .and. .not. &
245 if (len_trim(cs%IC_file) > 0)
then
248 call mom_error(fatal,
"initialize_ideal_age_tracer: "// &
249 "Unable to open "//cs%IC_file)
251 if (cs%Z_IC_file)
then
256 trim(name), g, us, -1e34, 0.0)
257 if (.not.ok)
call mom_error(fatal,
"initialize_ideal_age_tracer: "//&
258 "Unable to read "//trim(name)//
" from "//&
259 trim(cs%IC_file)//
".")
262 call mom_read_data(cs%IC_file, trim(name), cs%tr(:,:,:,m), g%Domain)
265 do k=1,nz ;
do j=js,je ;
do i=is,ie
266 if (g%mask2dT(i,j) < 0.5)
then
267 cs%tr(i,j,k,m) = cs%land_val(m)
269 cs%tr(i,j,k,m) = cs%IC_val(m)
271 enddo ;
enddo ;
enddo
277 if (
associated(obc))
then
284 subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, &
285 evap_CFL_limit, minimum_forcing_depth)
288 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
290 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
292 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
296 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
300 type(
forcing),
intent(in) :: fluxes
302 real,
intent(in) :: dt
306 real,
optional,
intent(in) :: evap_cfl_limit
308 real,
optional,
intent(in) :: minimum_forcing_depth
317 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
319 real :: isecs_per_year
321 integer :: i, j, k, is, ie, js, je, nz, m
322 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
324 if (.not.
associated(cs))
return
325 if (cs%ntr < 1)
return
327 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then
329 do k=1,nz ;
do j=js,je ;
do i=is,ie
330 h_work(i,j,k) = h_old(i,j,k)
331 enddo ;
enddo ;
enddo
333 evap_cfl_limit, minimum_forcing_depth)
342 isecs_per_year = 1.0 / (365.0*86400.0*us%s_to_T)
345 year = us%s_to_T*time_type_to_real(cs%Time) * isecs_per_year
348 if (cs%sfc_growth_rate(m) == 0.0)
then
349 sfc_val = cs%young_val(m)
351 sfc_val = cs%young_val(m) * &
352 exp((year-cs%tracer_start_year(m)) * cs%sfc_growth_rate(m))
354 do k=1,cs%nkml ;
do j=js,je ;
do i=is,ie
355 if (g%mask2dT(i,j) > 0.5)
then
356 cs%tr(i,j,k,m) = sfc_val
358 cs%tr(i,j,k,m) = cs%land_val(m)
360 enddo ;
enddo ;
enddo
362 do m=1,cs%ntr ;
if (cs%tracer_ages(m) .and. &
363 (year>=cs%tracer_start_year(m)))
then
365 do k=cs%nkml+1,nz ;
do j=js,je ;
do i=is,ie
366 cs%tr(i,j,k,m) = cs%tr(i,j,k,m) + g%mask2dT(i,j)*dt*isecs_per_year
367 enddo ;
enddo ;
enddo
374 function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index)
376 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
378 real,
dimension(:),
intent(out) :: stocks
383 character(len=*),
dimension(:),
intent(out) :: names
384 character(len=*),
dimension(:),
intent(out) :: units
385 integer,
optional,
intent(in) :: stock_index
392 integer :: i, j, k, is, ie, js, je, nz, m
393 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
396 if (.not.
associated(cs))
return
397 if (cs%ntr < 1)
return
399 if (
present(stock_index))
then ;
if (stock_index > 0)
then
407 call query_vardesc(cs%tr_desc(m), name=names(m), units=units(m), caller=
"ideal_age_stock")
408 units(m) = trim(units(m))//
" kg"
410 do k=1,nz ;
do j=js,je ;
do i=is,ie
411 stocks(m) = stocks(m) + cs%tr(i,j,k,m) * &
412 (g%mask2dT(i,j) * g%US%L_to_m**2*g%areaT(i,j) * h(i,j,k))
413 enddo ;
enddo ;
enddo
414 stocks(m) = gv%H_to_kg_m2 * stocks(m)
425 type(
surface),
intent(inout) :: state
427 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
435 integer :: m, is, ie, js, je, isd, ied, jsd, jed
436 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
437 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
439 if (.not.
associated(cs))
return
441 if (cs%coupled_tracers)
then
445 call coupler_type_set_data(cs%tr(:,:,1,m), cs%ind_tr(m), ind_csurf, &
446 state%tr_fields, idim=(/isd, is, ie, ied/), &
447 jdim=(/jsd, js, je, jed/) )
460 if (
associated(cs))
then
461 if (
associated(cs%tr))
deallocate(cs%tr)