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, &
180 flux_scale=gv%H_to_m)
185 if (cs%coupled_tracers) &
186 cs%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//
'_flux', &
187 flux_type=
' ', implementation=
' ', caller=
"register_ideal_age_tracer")
191 cs%restart_CSp => restart_cs
192 register_ideal_age_tracer = .true.
193 end function register_ideal_age_tracer
196 subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, 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)
240 call query_vardesc(cs%tr_desc(m), name=name, &
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 252 ok = tracer_z_init(cs%tr(:,:,:,m), h, cs%IC_file, name,&
255 ok = tracer_z_init(cs%tr(:,:,:,m), h, cs%IC_file, &
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 281 end subroutine initialize_ideal_age_tracer
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 332 call applytracerboundaryfluxesinout(g, gv, cs%tr(:,:,:,m), dt, fluxes, h_work, &
333 evap_cfl_limit, minimum_forcing_depth)
334 call tracer_vertdiff(h_work, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
338 call tracer_vertdiff(h_old, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
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 370 end subroutine ideal_age_tracer_column_physics
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
387 integer :: ideal_age_stock
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)
416 ideal_age_stock = cs%ntr
418 end function ideal_age_stock
423 subroutine ideal_age_tracer_surface_state(sfc_state, h, G, CS)
425 type(
surface),
intent(inout) :: sfc_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 sfc_state%tr_fields, idim=(/isd, is, ie, ied/), &
447 jdim=(/jsd, js, je, jed/) )
451 end subroutine ideal_age_tracer_surface_state
454 subroutine ideal_age_example_end(CS)
460 if (
associated(cs))
then 461 if (
associated(cs%tr))
deallocate(cs%tr)
464 end subroutine ideal_age_example_end
A tracer package of ideal age tracers.
Pointers to various fields which may be used describe the surface state of MOM, and which will be ret...
Wraps the FMS time manager functions.
This module implements boundary forcing for MOM6.
Used to initialize tracers from a depth- (or z*-) space file.
Ocean grid type. See mom_grid for details.
A structure that can be parsed to read and document run-time parameters.
Provides the ocean grid type.
This module contains I/O framework code.
The MOM6 facility to parse input files for runtime parameters.
Defines the horizontal index type (hor_index_type) used for providing index ranges.
An overloaded interface to log the values of various types of parameters.
A dummy version of atmos_ocean_fluxes_mod module for use when the vastly larger FMS package is not ne...
Container for horizontal index ranges for data, computational and global domains. ...
A restart registry and the control structure for restarts.
Describes various unit conversion factors.
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Type to carry basic tracer information.
Routines for error handling and I/O management.
This module contains routines that implement physical fluxes of tracers (e.g. due to surface fluxes o...
This control structure holds memory and parameters for the MOM_sponge module.
The MOM6 facility for reading and writing restart files, and querying what has been read...
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
Implements sponge regions in isopycnal mode.
Type for describing a variable, typically a tracer.
An overloaded interface to log version information about modules.
Describes the vertical ocean grid, including unit conversion factors.
Indicate whether a file exists, perhaps with domain decomposition.
Indicate whether a field has been read from a restart file.
Controls where open boundary conditions are applied.
Provides a transparent vertical ocean grid type and supporting routines.
The control structure for the ideal_age_tracer package.
Provides transparent structures with groups of MOM6 variables and supporting routines.
Read a data field from a file.
An overloaded interface to read and log the values of various types of parameters.