Data Types
type	ideal_age_tracer_cs

type	p3d

Functions/Subroutines
logical function, public	register_ideal_age_tracer (HI, GV, param_file, CS, tr_Reg, restart_CS)

subroutine, public	initialize_ideal_age_tracer (restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, diag_to_Z_CSp)

subroutine, public	ideal_age_tracer_column_physics (h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, evap_CFL_limit, minimum_forcing_depth)

integer function, public	ideal_age_stock (h, stocks, G, GV, CS, names, units, stock_index)

subroutine, public	ideal_age_tracer_surface_state (state, h, G, CS)

subroutine, public	ideal_age_example_end (CS)

Variables
integer, parameter	ntr_max = 3

Function/Subroutine Documentation

◆ ideal_age_example_end()

subroutine, public ideal_age_example::ideal_age_example_end ( type(ideal_age_tracer_cs), pointer CS )

Definition at line 624 of file ideal_age_example.F90.

Referenced by mom_tracer_flow_control::tracer_flow_control_end().

   type(ideal_age_tracer_cs), pointer :: cs
   integer :: m
 
   if (associated(cs)) then
     if (associated(cs%tr)) deallocate(cs%tr)
     if (associated(cs%tr_aux)) deallocate(cs%tr_aux)
     do m=1,cs%ntr
       if (associated(cs%tr_adx(m)%p)) deallocate(cs%tr_adx(m)%p)
       if (associated(cs%tr_ady(m)%p)) deallocate(cs%tr_ady(m)%p)
       if (associated(cs%tr_dfx(m)%p)) deallocate(cs%tr_dfx(m)%p)
       if (associated(cs%tr_dfy(m)%p)) deallocate(cs%tr_dfy(m)%p)
     enddo
 
     deallocate(cs)
   endif

Here is the caller graph for this function:

◆ ideal_age_stock()

integer function, public ideal_age_example::ideal_age_stock	(	real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in)	h,
		real, dimension(:), intent(out)	stocks,
		type(ocean_grid_type), intent(in)	G,
		type(verticalgrid_type), intent(in)	GV,
		type(ideal_age_tracer_cs), pointer	CS,
		character(len=*), dimension(:), intent(out)	names,
		character(len=*), dimension(:), intent(out)	units,
		integer, intent(in), optional	stock_index
	)

Parameters

[in]	g	The ocean's grid structure
[in]	h	Layer thicknesses, in H (usually m or kg m-2)
[in]	gv	The ocean's vertical grid structure

Definition at line 541 of file ideal_age_example.F90.

References mom_io::query_vardesc().

Referenced by mom_tracer_flow_control::call_tracer_stocks().

   type(ocean_grid_type),              intent(in)    :: g    !< The ocean's grid structure
   real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in)    :: h    !< Layer thicknesses, in H (usually m or kg m-2)
   real, dimension(:),                 intent(out)   :: stocks
   type(verticalgrid_type),            intent(in)    :: gv   !< The ocean's vertical grid structure
   type(ideal_age_tracer_cs),          pointer       :: cs
   character(len=*), dimension(:),     intent(out)   :: names
   character(len=*), dimension(:),     intent(out)   :: units
   integer, optional,                  intent(in)    :: stock_index
   integer                                           :: ideal_age_stock
 ! This function calculates the mass-weighted integral of all tracer stocks,
 ! returning the number of stocks it has calculated.  If the stock_index
 ! is present, only the stock corresponding to that coded index is returned.
 
 ! Arguments: h - Layer thickness, in m or kg m-2.
 !  (out)     stocks - the mass-weighted integrated amount of each tracer,
 !                     in kg times concentration units.
 !  (in)      G - The ocean's grid structure.
 !  (in)      GV - The ocean's vertical grid structure.
 !  (in)      CS - The control structure returned by a previous call to
 !                 register_ideal_age_tracer.
 !  (out)     names - the names of the stocks calculated.
 !  (out)     units - the units of the stocks calculated.
 !  (in,opt)  stock_index - the coded index of a specific stock being sought.
 ! Return value: the number of stocks calculated here.
 
   integer :: i, j, k, is, ie, js, je, nz, m
   is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
 
   ideal_age_stock = 0
   if (.not.associated(cs)) return
   if (cs%ntr < 1) return
 
   if (present(stock_index)) then ; if (stock_index > 0) then
     ! Check whether this stock is available from this routine.
 
     ! No stocks from this routine are being checked yet.  Return 0.
     return
   endif ; endif
 
   do m=1,cs%ntr
     call query_vardesc(cs%tr_desc(m), name=names(m), units=units(m), caller="ideal_age_stock")
     units(m) = trim(units(m))//" kg"
     stocks(m) = 0.0
     do k=1,nz ; do j=js,je ; do i=is,ie
       stocks(m) = stocks(m) + cs%tr(i,j,k,m) * &
                              (g%mask2dT(i,j) * g%areaT(i,j) * h(i,j,k))
     enddo ; enddo ; enddo
     stocks(m) = gv%H_to_kg_m2 * stocks(m)
   enddo
   ideal_age_stock = cs%ntr
 

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ideal_age_tracer_column_physics()

subroutine, public ideal_age_example::ideal_age_tracer_column_physics	(	real, dimension(szi_(g),szj_(g),szk_(g)), intent(in)	h_old,
		real, dimension(szi_(g),szj_(g),szk_(g)), intent(in)	h_new,
		real, dimension(szi_(g),szj_(g),szk_(g)), intent(in)	ea,
		real, dimension(szi_(g),szj_(g),szk_(g)), intent(in)	eb,
		type(forcing), intent(in)	fluxes,
		real, intent(in)	dt,
		type(ocean_grid_type), intent(in)	G,
		type(verticalgrid_type), intent(in)	GV,
		type(ideal_age_tracer_cs), pointer	CS,
		real, intent(in), optional	evap_CFL_limit,
		real, intent(in), optional	minimum_forcing_depth
	)

Parameters

[in]	g	The ocean's grid structure
[in]	gv	The ocean's vertical grid structure
[in]	dt	The amount of time covered by this call, in s

Definition at line 423 of file ideal_age_example.F90.

References mom_tracer_diabatic::applytracerboundaryfluxesinout(), and mom_tracer_diabatic::tracer_vertdiff().

   type(ocean_grid_type),              intent(in) :: g    !< The ocean's grid structure
   type(verticalgrid_type),            intent(in) :: gv   !< The ocean's vertical grid structure
   real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb
   type(forcing),                      intent(in) :: fluxes
   real,                               intent(in) :: dt   !< The amount of time covered by this call, in s
   type(ideal_age_tracer_cs),          pointer    :: cs
   real,                             optional,intent(in)  :: evap_cfl_limit
   real,                             optional,intent(in)  :: minimum_forcing_depth
 !   This subroutine applies diapycnal diffusion and any other column
 ! tracer physics or chemistry to the tracers from this file.
 ! This is a simple example of a set of advected passive tracers.
 
 ! Arguments: h_old -  Layer thickness before entrainment, in m or kg m-2.
 !  (in)      h_new -  Layer thickness after entrainment, in m or kg m-2.
 !  (in)      ea - an array to which the amount of fluid entrained
 !                 from the layer above during this call will be
 !                 added, in m or kg m-2.
 !  (in)      eb - an array to which the amount of fluid entrained
 !                 from the layer below during this call will be
 !                 added, in m or kg m-2.
 !  (in)      fluxes - A structure containing pointers to any possible
 !                     forcing fields.  Unused fields have NULL ptrs.
 !  (in)      dt - The amount of time covered by this call, in s.
 !  (in)      G - The ocean's grid structure.
 !  (in)      GV - The ocean's vertical grid structure.
 !  (in)      CS - The control structure returned by a previous call to
 !                 register_ideal_age_tracer.
 !
 ! The arguments to this subroutine are redundant in that
 !     h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1]
   real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
   real :: sfc_val  ! The surface value for the tracers.
   real :: isecs_per_year  ! The number of seconds in a year.
   real :: year            ! The time in years.
   integer :: secs, days   ! Integer components of the time type.
   integer :: i, j, k, is, ie, js, je, nz, m
   is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
 
   if (.not.associated(cs)) return
   if (cs%ntr < 1) return
 
   if (present(evap_cfl_limit) .and. present(minimum_forcing_depth)) then
     do m=1,cs%ntr
       do k=1,nz ;do j=js,je ; do i=is,ie
         h_work(i,j,k) = h_old(i,j,k)
       enddo ; enddo ; enddo;
       call applytracerboundaryfluxesinout(g, gv, cs%tr(:,:,:,m) , dt, fluxes, h_work, &
           evap_cfl_limit, minimum_forcing_depth)
       call tracer_vertdiff(h_work, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
     enddo
   else
     do m=1,cs%ntr
       call tracer_vertdiff(h_old, ea, eb, dt, cs%tr(:,:,:,m), g, gv)
     enddo
   endif
 
   isecs_per_year = 1.0 / (365.0*86400.0)
   !   Set the surface value of tracer 1 to increase exponentially
   ! with a 30 year time scale.
   call get_time(cs%Time, secs, days)
   year = (86400.0*days + real(secs)) * isecs_per_year
 
   do m=1,cs%ntr
     if (cs%sfc_growth_rate(m) == 0.0) then
       sfc_val = cs%young_val(m)
     else
       sfc_val = cs%young_val(m) * &
           exp((year-cs%tracer_start_year(m)) * cs%sfc_growth_rate(m))
     endif
     do k=1,cs%nkml ; do j=js,je ; do i=is,ie
       if (g%mask2dT(i,j) > 0.5) then
         cs%tr(i,j,k,m) = sfc_val
       else
         cs%tr(i,j,k,m) = cs%land_val(m)
       endif
     enddo ; enddo ; enddo
   enddo
   do m=1,cs%ntr ; if (cs%tracer_ages(m) .and. &
                       (year>=cs%tracer_start_year(m))) then
 !$OMP parallel do default(none) shared(is,ie,js,je,CS,nz,G,dt,Isecs_per_year,m)
     do k=cs%nkml+1,nz ; do j=js,je ; do i=is,ie
       cs%tr(i,j,k,m) = cs%tr(i,j,k,m) + g%mask2dT(i,j)*dt*isecs_per_year
     enddo ; enddo ; enddo
   endif ; enddo
 
   if (cs%mask_tracers) then
     do m=1,cs%ntr ; if (cs%id_tracer(m) > 0) then
       do k=1,nz ; do j=js,je ; do i=is,ie
         if (h_new(i,j,k) < 1.1*gv%Angstrom) then
           cs%tr_aux(i,j,k,m) = cs%land_val(m)
         else
           cs%tr_aux(i,j,k,m) = cs%tr(i,j,k,m)
         endif
       enddo ; enddo ; enddo
     endif ; enddo
   endif
 
   do m=1,cs%ntr
     if (cs%mask_tracers) then
       if (cs%id_tracer(m)>0) &
         call post_data(cs%id_tracer(m),cs%tr_aux(:,:,:,m),cs%diag)
     else
       if (cs%id_tracer(m)>0) &
         call post_data(cs%id_tracer(m),cs%tr(:,:,:,m),cs%diag)
     endif
     if (cs%id_tr_adx(m)>0) &
       call post_data(cs%id_tr_adx(m),cs%tr_adx(m)%p(:,:,:),cs%diag)
     if (cs%id_tr_ady(m)>0) &
       call post_data(cs%id_tr_ady(m),cs%tr_ady(m)%p(:,:,:),cs%diag)
     if (cs%id_tr_dfx(m)>0) &
       call post_data(cs%id_tr_dfx(m),cs%tr_dfx(m)%p(:,:,:),cs%diag)
     if (cs%id_tr_dfy(m)>0) &
       call post_data(cs%id_tr_dfy(m),cs%tr_dfy(m)%p(:,:,:),cs%diag)
   enddo
 

Here is the call graph for this function:

◆ ideal_age_tracer_surface_state()

subroutine, public ideal_age_example::ideal_age_tracer_surface_state	(	type(surface), intent(inout)	state,
		real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in)	h,
		type(ocean_grid_type), intent(in)	G,
		type(ideal_age_tracer_cs), pointer	CS
	)

Parameters

[in]	g	The ocean's grid structure
[in]	h	Layer thicknesses, in H (usually m or kg m-2)

Definition at line 595 of file ideal_age_example.F90.

References coupler_util::set_coupler_values().

   type(ocean_grid_type),                    intent(in)    :: g    !< The ocean's grid structure
   type(surface),                            intent(inout) :: state
   real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in)    :: h    !< Layer thicknesses, in H (usually m or kg m-2)
   type(ideal_age_tracer_cs),                pointer       :: cs
 !   This particular tracer package does not report anything back to the coupler.
 ! The code that is here is just a rough guide for packages that would.
 ! Arguments: state - A structure containing fields that describe the
 !                    surface state of the ocean.
 !  (in)      h - Layer thickness, in m or kg m-2.
 !  (in)      G - The ocean's grid structure.
 !  (in)      CS - The control structure returned by a previous call to
 !                 register_ideal_age_tracer.
   integer :: i, j, m, is, ie, js, je
   is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
 
   if (.not.associated(cs)) return
 
   if (cs%coupled_tracers) then
     do m=1,cs%ntr
       !   This call loads the surface vlues into the appropriate array in the
       ! coupler-type structure.
       call set_coupler_values(cs%tr(:,:,1,m), state%tr_fields, cs%ind_tr(m), &
                               ind_csurf, is, ie, js, je)
     enddo
   endif
 

Here is the call graph for this function:

◆ initialize_ideal_age_tracer()

subroutine, public ideal_age_example::initialize_ideal_age_tracer	(	logical, intent(in)	restart,
		type(time_type), intent(in), target	day,
		type(ocean_grid_type), intent(in)	G,
		type(verticalgrid_type), intent(in)	GV,
		real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in)	h,
		type(diag_ctrl), intent(in), target	diag,
		type(ocean_obc_type), pointer	OBC,
		type(ideal_age_tracer_cs), pointer	CS,
		type(sponge_cs), pointer	sponge_CSp,
		type(diag_to_z_cs), pointer	diag_to_Z_CSp
	)

Parameters

[in]	g	The ocean's grid structure
[in]	gv	The ocean's vertical grid structure
[in]	h	Layer thicknesses, in H (usually m or kg m-2)

Definition at line 283 of file ideal_age_example.F90.

References mom_tracer_registry::add_tracer_diagnostics(), mom_error_handler::mom_error(), mom_io::query_vardesc(), mom_diag_to_z::register_z_tracer(), and mom_tracer_z_init::tracer_z_init().

   logical,                            intent(in) :: restart
   type(time_type), target,            intent(in) :: day
   type(ocean_grid_type),              intent(in) :: g    !< The ocean's grid structure
   type(verticalgrid_type),            intent(in) :: gv   !< The ocean's vertical grid structure
   real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h    !< Layer thicknesses, in H (usually m or kg m-2)
   type(diag_ctrl), target,            intent(in) :: diag
   type(ocean_obc_type),               pointer    :: obc
   type(ideal_age_tracer_cs),          pointer    :: cs
   type(sponge_cs),                    pointer    :: sponge_csp
   type(diag_to_z_cs),                 pointer    :: diag_to_z_csp
 !   This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:)
 ! and it sets up the tracer output.
 
 ! Arguments: restart - .true. if the fields have already been read from
 !                     a restart file.
 !  (in)      day - Time of the start of the run.
 !  (in)      G - The ocean's grid structure.
 !  (in)      GV - The ocean's vertical grid structure.
 !  (in)      h - Layer thickness, in m or kg m-2.
 !  (in)      diag - A structure that is used to regulate diagnostic output.
 !  (in)      OBC - This open boundary condition type specifies whether, where,
 !                  and what open boundary conditions are used.
 !  (in/out)  CS - The control structure returned by a previous call to
 !                 register_ideal_age_tracer.
 !  (in/out)  sponge_CSp - A pointer to the control structure for the sponges, if
 !                         they are in use.  Otherwise this may be unassociated.
 !  (in/out)  diag_to_Z_Csp - A pointer to the control structure for diagnostics
 !                            in depth space.
   character(len=24) :: name     ! A variable's name in a NetCDF file.
   character(len=72) :: longname ! The long name of that variable.
   character(len=48) :: units    ! The dimensions of the variable.
   character(len=48) :: flux_units ! The units for age tracer fluxes, either
                                 ! years m3 s-1 or years kg s-1.
   character(len=72) :: cmorname ! The CMOR name of that variable.
   logical :: ok
   integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
   integer :: isdb, iedb, jsdb, jedb
 
   if (.not.associated(cs)) return
   if (cs%ntr < 1) return
   is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
   isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
   isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
 
   cs%Time => day
   cs%diag => diag
   cs%nkml = max(gv%nkml,1)
 
   do m=1,cs%ntr
     call query_vardesc(cs%tr_desc(m), name=name, &
                        caller="initialize_ideal_age_tracer")
     if ((.not.restart) .or. (cs%tracers_may_reinit .and. .not. &
         query_initialized(cs%tr(:,:,:,m), name, cs%restart_CSp))) then
 
       if (len_trim(cs%IC_file) > 0) then
   !  Read the tracer concentrations from a netcdf file.
         if (.not.file_exists(cs%IC_file, g%Domain)) &
           call mom_error(fatal, "initialize_ideal_age_tracer: "// &
                                  "Unable to open "//cs%IC_file)
 
         if (cs%Z_IC_file) then
           ok = tracer_z_init(cs%tr(:,:,:,m), h, cs%IC_file, name,&
                              g, -1e34, 0.0) ! CS%land_val(m))
           if (.not.ok) then
             ok = tracer_z_init(cs%tr(:,:,:,m), h, cs%IC_file, &
                      trim(name), g, -1e34, 0.0) ! CS%land_val(m))
             if (.not.ok) call mom_error(fatal,"initialize_ideal_age_tracer: "//&
                     "Unable to read "//trim(name)//" from "//&
                     trim(cs%IC_file)//".")
           endif
         else
           call read_data(cs%IC_file, trim(name), cs%tr(:,:,:,m), &
                          domain=g%Domain%mpp_domain)
         endif
       else
         do k=1,nz ; do j=js,je ; do i=is,ie
           if (g%mask2dT(i,j) < 0.5) then
             cs%tr(i,j,k,m) = cs%land_val(m)
           else
             cs%tr(i,j,k,m) = cs%IC_val(m)
           endif
         enddo ; enddo ; enddo
       endif
 
     endif ! restart
   enddo ! Tracer loop
 
   if (associated(obc)) then
   ! All tracers but the first have 0 concentration in their inflows. As this
   ! is the default value, the following calls are unnecessary.
   ! do m=1,CS%ntr
   !  call add_tracer_OBC_values(trim(CS%tr_desc(m)%name), CS%tr_Reg, 0.0)
   ! enddo
   endif
 
   ! This needs to be changed if the units of tracer are changed above.
   if (gv%Boussinesq) then ; flux_units = "years m3 s-1"
   else ; flux_units = "years kg s-1" ; endif
 
   do m=1,cs%ntr
     call query_vardesc(cs%tr_desc(m), name, units=units, longname=longname, &
                        cmor_field_name=cmorname, caller="initialize_ideal_age_tracer")
     if (len_trim(cmorname)==0) then
       cs%id_tracer(m) = register_diag_field("ocean_model", trim(name), cs%diag%axesTL, &
         day, trim(longname) , trim(units))
     else
       cs%id_tracer(m) = register_diag_field("ocean_model", trim(name), cs%diag%axesTL, &
         day, trim(longname) , trim(units), cmor_field_name=cmorname)
     endif
     cs%id_tr_adx(m) = register_diag_field("ocean_model", trim(name)//"_adx", &
         cs%diag%axesCuL, day, trim(longname)//" advective zonal flux" , &
         trim(flux_units))
     cs%id_tr_ady(m) = register_diag_field("ocean_model", trim(name)//"_ady", &
         cs%diag%axesCvL, day, trim(longname)//" advective meridional flux" , &
         trim(flux_units))
     cs%id_tr_dfx(m) = register_diag_field("ocean_model", trim(name)//"_dfx", &
         cs%diag%axesCuL, day, trim(longname)//" diffusive zonal flux" , &
         trim(flux_units))
     cs%id_tr_dfy(m) = register_diag_field("ocean_model", trim(name)//"_dfy", &
         cs%diag%axesCvL, day, trim(longname)//" diffusive zonal flux" , &
         trim(flux_units))
     if (cs%id_tr_adx(m) > 0) call safe_alloc_ptr(cs%tr_adx(m)%p,isdb,iedb,jsd,jed,nz)
     if (cs%id_tr_ady(m) > 0) call safe_alloc_ptr(cs%tr_ady(m)%p,isd,ied,jsdb,jedb,nz)
     if (cs%id_tr_dfx(m) > 0) call safe_alloc_ptr(cs%tr_dfx(m)%p,isdb,iedb,jsd,jed,nz)
     if (cs%id_tr_dfy(m) > 0) call safe_alloc_ptr(cs%tr_dfy(m)%p,isd,ied,jsdb,jedb,nz)
 
 !    Register the tracer for horizontal advection & diffusion.
     if ((cs%id_tr_adx(m) > 0) .or. (cs%id_tr_ady(m) > 0) .or. &
         (cs%id_tr_dfx(m) > 0) .or. (cs%id_tr_dfy(m) > 0)) &
       call add_tracer_diagnostics(name, cs%tr_Reg, cs%tr_adx(m)%p, &
                                   cs%tr_ady(m)%p,cs%tr_dfx(m)%p,cs%tr_dfy(m)%p)
 
     call register_z_tracer(cs%tr(:,:,:,m), trim(name), longname, units, &
                            day, g, diag_to_z_csp)
   enddo
 

Here is the call graph for this function:

◆ register_ideal_age_tracer()

logical function, public ideal_age_example::register_ideal_age_tracer	(	type(hor_index_type), intent(in)	HI,
		type(verticalgrid_type), intent(in)	GV,
		type(param_file_type), intent(in)	param_file,
		type(ideal_age_tracer_cs), pointer	CS,
		type(tracer_registry_type), pointer	tr_Reg,
		type(mom_restart_cs), pointer	restart_CS
	)

Parameters

[in]	gv	The ocean's vertical grid structure
[in]	param_file	A structure to parse for run-time parameters

Definition at line 145 of file ideal_age_example.F90.

References atmos_ocean_fluxes_mod::aof_set_coupler_flux(), mom_error_handler::mom_error(), mom_io::query_vardesc(), and mom_io::var_desc().

   type(hor_index_type),       intent(in) :: hi
   type(verticalgrid_type),    intent(in) :: gv   !< The ocean's vertical grid structure
   type(param_file_type),      intent(in) :: param_file !< A structure to parse for run-time parameters
   type(ideal_age_tracer_cs),  pointer    :: cs
   type(tracer_registry_type), pointer    :: tr_reg
   type(mom_restart_cs),       pointer    :: restart_cs
 ! This subroutine is used to register tracer fields and subroutines
 ! to be used with MOM.
 ! Arguments: HI - A horizontal index type structure.
 !  (in)      param_file - A structure indicating the open file to parse for
 !                         model parameter values.
 !  (in/out)  CS - A pointer that is set to point to the control structure
 !                 for this module
 !  (in/out)  tr_Reg - A pointer that is set to point to the control structure
 !                  for the tracer advection and diffusion module.
 !  (in)      restart_CS - A pointer to the restart control structure.
 
 ! This include declares and sets the variable "version".
 #include "version_variable.h"
   character(len=40)  :: mdl = "ideal_age_example" ! This module's name.
   character(len=200) :: inputdir ! The directory where the input files are.
   character(len=48)  :: var_name ! The variable's name.
   real, pointer :: tr_ptr(:,:,:) => null()
   logical :: register_ideal_age_tracer
   logical :: do_ideal_age, do_vintage, do_ideal_age_dated
   integer :: isd, ied, jsd, jed, nz, m
   isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
 
   if (associated(cs)) then
     call mom_error(warning, "register_ideal_age_tracer called with an "// &
                              "associated control structure.")
     return
   endif
   allocate(cs)
 
   ! Read all relevant parameters and write them to the model log.
   call log_version(param_file, mdl, version, "")
   call get_param(param_file, mdl, "DO_IDEAL_AGE", do_ideal_age, &
                  "If true, use an ideal age tracer that is set to 0 age \n"//&
                  "in the mixed layer and ages at unit rate in the interior.", &
                  default=.true.)
   call get_param(param_file, mdl, "DO_IDEAL_VINTAGE", do_vintage, &
                  "If true, use an ideal vintage tracer that is set to an \n"//&
                  "exponentially increasing value in the mixed layer and \n"//&
                  "is conserved thereafter.", default=.false.)
   call get_param(param_file, mdl, "DO_IDEAL_AGE_DATED", do_ideal_age_dated, &
                  "If true, use an ideal age tracer that is everywhere 0 \n"//&
                  "before IDEAL_AGE_DATED_START_YEAR, but the behaves like \n"//&
                  "the standard ideal age tracer - i.e. is set to 0 age in \n"//&
                  "the mixed layer and ages at unit rate in the interior.", &
                  default=.false.)
 
 
   call get_param(param_file, mdl, "AGE_IC_FILE", cs%IC_file, &
                  "The file in which the age-tracer initial values can be \n"//&
                  "found, or an empty string for internal initialization.", &
                  default=" ")
   if ((len_trim(cs%IC_file) > 0) .and. (scan(cs%IC_file,'/') == 0)) then
     ! Add the directory if CS%IC_file is not already a complete path.
     call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
     cs%IC_file = trim(slasher(inputdir))//trim(cs%IC_file)
     call log_param(param_file, mdl, "INPUTDIR/AGE_IC_FILE", cs%IC_file)
   endif
   call get_param(param_file, mdl, "AGE_IC_FILE_IS_Z", cs%Z_IC_file, &
                  "If true, AGE_IC_FILE is in depth space, not layer space", &
                  default=.false.)
   call get_param(param_file, mdl, "MASK_MASSLESS_TRACERS", cs%mask_tracers, &
                  "If true, the tracers are masked out in massless layer. \n"//&
                  "This can be a problem with time-averages.", default=.false.)
   call get_param(param_file, mdl, "TRACERS_MAY_REINIT", cs%tracers_may_reinit, &
                  "If true, tracers may go through the initialization code \n"//&
                  "if they are not found in the restart files.  Otherwise \n"//&
                  "it is a fatal error if the tracers are not found in the \n"//&
                  "restart files of a restarted run.", default=.false.)
 
   cs%ntr = 0
   if (do_ideal_age) then
     cs%ntr = cs%ntr + 1 ; m = cs%ntr
     cs%tr_desc(m) = var_desc("age", "years", "Ideal Age Tracer", cmor_field_name="agessc", caller=mdl)
     cs%tracer_ages(m) = .true. ; cs%sfc_growth_rate(m) = 0.0
     cs%IC_val(m) = 0.0 ; cs%young_val(m) = 0.0 ; cs%tracer_start_year(m) = 0.0
   endif
 
   if (do_vintage) then
     cs%ntr = cs%ntr + 1 ; m = cs%ntr
     cs%tr_desc(m) = var_desc("vintage", "years", "Exponential Vintage Tracer", &
                             caller=mdl)
     cs%tracer_ages(m) = .false. ; cs%sfc_growth_rate(m) = 1.0/30.0
     cs%IC_val(m) = 0.0 ; cs%young_val(m) = 1e-20 ; cs%tracer_start_year(m) = 0.0
     call get_param(param_file, mdl, "IDEAL_VINTAGE_START_YEAR", cs%tracer_start_year(m), &
                  "The date at which the ideal vintage tracer starts.", &
                  units="years", default=0.0)
   endif
 
   if (do_ideal_age_dated) then
     cs%ntr = cs%ntr + 1 ; m = cs%ntr
     cs%tr_desc(m) = var_desc("age_dated","years","Ideal Age Tracer with a Start Date",&
                             caller=mdl)
     cs%tracer_ages(m) = .true. ; cs%sfc_growth_rate(m) = 0.0
     cs%IC_val(m) = 0.0 ; cs%young_val(m) = 0.0 ; cs%tracer_start_year(m) = 0.0
     call get_param(param_file, mdl, "IDEAL_AGE_DATED_START_YEAR", cs%tracer_start_year(m), &
                  "The date at which the dated ideal age tracer starts.", &
                  units="years", default=0.0)
   endif
 
   allocate(cs%tr(isd:ied,jsd:jed,nz,cs%ntr)) ; cs%tr(:,:,:,:) = 0.0
   if (cs%mask_tracers) then
     allocate(cs%tr_aux(isd:ied,jsd:jed,nz,cs%ntr)) ; cs%tr_aux(:,:,:,:) = 0.0
   endif
 
   do m=1,cs%ntr
     ! This is needed to force the compiler not to do a copy in the registration
     ! calls.  Curses on the designers and implementers of Fortran90.
     tr_ptr => cs%tr(:,:,:,m)
     call query_vardesc(cs%tr_desc(m), name=var_name, &
                        caller="register_ideal_age_tracer")
     ! Register the tracer for the restart file.
     call register_restart_field(tr_ptr, cs%tr_desc(m), &
                                 .not.cs%tracers_may_reinit, restart_cs)
     ! Register the tracer for horizontal advection & diffusion.
     call register_tracer(tr_ptr, cs%tr_desc(m), param_file, hi, gv, tr_reg, &
                          tr_desc_ptr=cs%tr_desc(m))
 
     !   Set coupled_tracers to be true (hard-coded above) to provide the surface
     ! values to the coupler (if any).  This is meta-code and its arguments will
     ! currently (deliberately) give fatal errors if it is used.
     if (cs%coupled_tracers) &
       cs%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//'_flux', &
           flux_type=' ', implementation=' ', caller="register_ideal_age_tracer")
   enddo
 
   cs%tr_Reg => tr_reg
   cs%restart_CSp => restart_cs
   register_ideal_age_tracer = .true.

Here is the call graph for this function:

Variable Documentation

◆ ntr_max

integer, parameter ideal_age_example::ntr_max = 3

private

Definition at line 89 of file ideal_age_example.F90.

89 integer, parameter :: ntr_max = 3

Data Types

Functions/Subroutines

Variables

Function/Subroutine Documentation

◆ ideal_age_example_end()

◆ ideal_age_stock()

◆ ideal_age_tracer_column_physics()

◆ ideal_age_tracer_surface_state()

◆ initialize_ideal_age_tracer()

◆ register_ideal_age_tracer()

Variable Documentation

◆ ntr_max