Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 3 additions & 2 deletions src/tracer/MOM_tracer_flow_control.F90
Original file line number Diff line number Diff line change
Expand Up @@ -468,7 +468,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV,
call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
G, GV, US, CS%ideal_age_tracer_CSp, &
evap_CFL_limit=evap_CFL_limit, &
minimum_forcing_depth=minimum_forcing_depth)
minimum_forcing_depth=minimum_forcing_depth, &
Hbl=Hml)
if (CS%use_regional_dyes) &
call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
G, GV, US, CS%dye_tracer_CSp, &
Expand Down Expand Up @@ -544,7 +545,7 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV,
G, GV, US, CS%RGC_tracer_CSp)
if (CS%use_ideal_age) &
call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
G, GV, US, CS%ideal_age_tracer_CSp)
G, GV, US, CS%ideal_age_tracer_CSp, Hbl=Hml)
if (CS%use_regional_dyes) &
call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
G, GV, US, CS%dye_tracer_CSp)
Expand Down
233 changes: 196 additions & 37 deletions src/tracer/ideal_age_example.F90
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ module ideal_age_example
use MOM_coms, only : EFP_type
use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux
use MOM_diag_mediator, only : diag_ctrl
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_forcing_type, only : forcing
use MOM_grid, only : ocean_grid_type
Expand All @@ -31,15 +31,16 @@ module ideal_age_example
public register_ideal_age_tracer, initialize_ideal_age_tracer
public ideal_age_tracer_column_physics, ideal_age_tracer_surface_state
public ideal_age_stock, ideal_age_example_end
public count_BL_layers

integer, parameter :: NTR_MAX = 3 !< the maximum number of tracers in this module.
integer, parameter :: NTR_MAX = 4 !< the maximum number of tracers in this module.

!> The control structure for the ideal_age_tracer package
type, public :: ideal_age_tracer_CS ; private
integer :: ntr !< The number of tracers that are actually used.
logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler.
integer :: nkml !< The number of layers in the mixed layer. The ideal
!1 age tracers are reset in the top nkml layers.
integer :: nkbl !< The number of layers in the boundary layer. The ideal
!1 age tracers are reset in the top nkbl layers.
character(len=200) :: IC_file !< The file in which the age-tracer initial values
!! can be found, or an empty string for internal initialization.
logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false.
Expand All @@ -49,9 +50,12 @@ module ideal_age_example
real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value.
real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface.
real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out.
real, dimension(NTR_MAX) :: sfc_growth_rate !< The exponential growth rate for the surface value [year-1].
real, dimension(NTR_MAX) :: growth_rate !< The exponential growth rate for the young value [year-1].
real, dimension(NTR_MAX) :: tracer_start_year !< The year in which tracers start aging, or at which the
!! surface value equals young_val, in years.
logical :: use_real_BL_depth !< If true, uses the BL scheme to determine the number of
!! layers above the BL depth instead of the fixed nkbl value.
integer :: BL_residence_num !< The tracer number assigned to the BL residence tracer in this module
logical :: tracers_may_reinit !< If true, these tracers be set up via the initialization code if
!! they are not found in the restart files.
logical :: tracer_ages(NTR_MAX) !< Indicates whether each tracer ages.
Expand All @@ -64,6 +68,7 @@ module ideal_age_example
type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart controls structure

type(vardesc) :: tr_desc(NTR_MAX) !< Descriptions and metadata for the tracers

end type ideal_age_tracer_CS

contains
Expand All @@ -87,7 +92,7 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
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
logical :: do_ideal_age, do_vintage, do_ideal_age_dated, do_BL_residence
integer :: isd, ied, jsd, jed, nz, m
isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke

Expand All @@ -102,20 +107,26 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
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 "//&
"in the mixed layer and ages at unit rate in the interior.", &
"in the boundary 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 "//&
"exponentially increasing value in the mixed layer and "//&
"exponentially increasing value in the boundary layer and "//&
"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 "//&
"before IDEAL_AGE_DATED_START_YEAR, but the behaves like "//&
"the standard ideal age tracer - i.e. is set to 0 age in "//&
"the mixed layer and ages at unit rate in the interior.", &
"the boundary layer and ages at unit rate in the interior.", &
default=.false.)
call get_param(param_file, mdl, "DO_BL_RESIDENCE", do_BL_residence, &
"If true, use a residence tracer that is set to 0 age "//&
"in the interior and ages at unit rate in the boundary layer.", &
default=.false.)
call get_param(param_file, mdl, "USE_REAL_BL_DEPTH", CS%use_real_BL_depth, &
"If true, the ideal age tracers will use the boundary layer "//&
"depth diagnosed from the BL or bulkmixedlayer scheme.", &
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 "//&
"found, or an empty string for internal initialization.", &
Expand All @@ -139,15 +150,15 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
if (do_ideal_age) then
CS%ntr = CS%ntr + 1 ; m = CS%ntr
CS%tr_desc(m) = var_desc("age", "yr", "Ideal Age Tracer", cmor_field_name="agessc", caller=mdl)
CS%tracer_ages(m) = .true. ; CS%sfc_growth_rate(m) = 0.0
CS%tracer_ages(m) = .true. ; CS%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", "yr", "Exponential Vintage Tracer", &
caller=mdl)
CS%tracer_ages(m) = .false. ; CS%sfc_growth_rate(m) = 1.0/30.0
CS%tracer_ages(m) = .false. ; CS%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.", &
Expand All @@ -158,13 +169,21 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
CS%ntr = CS%ntr + 1 ; m = CS%ntr
CS%tr_desc(m) = var_desc("age_dated","yr","Ideal Age Tracer with a Start Date",&
caller=mdl)
CS%tracer_ages(m) = .true. ; CS%sfc_growth_rate(m) = 0.0
CS%tracer_ages(m) = .true. ; CS%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

CS%BL_residence_num = 0
if (do_BL_residence) then
CS%ntr = CS%ntr + 1 ; m = CS%ntr; CS%BL_residence_num = CS%ntr
CS%tr_desc(m) = var_desc("BL_age", "yr", "BL Residence Time Tracer", caller=mdl)
CS%tracer_ages(m) = .true. ; CS%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

allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0)

do m=1,CS%ntr
Expand Down Expand Up @@ -220,6 +239,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS
logical :: OK
integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
integer :: IsdB, IedB, JsdB, JedB
logical :: use_real_BL_depth

if (.not.associated(CS)) return
if (CS%ntr < 1) return
Expand All @@ -229,7 +249,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS

CS%Time => day
CS%diag => diag
CS%nkml = max(GV%nkml,1)
CS%nkbl = max(GV%nkml,1)

do m=1,CS%ntr
call query_vardesc(CS%tr_desc(m), name=name, &
Expand Down Expand Up @@ -277,7 +297,7 @@ end subroutine initialize_ideal_age_tracer

!> Applies diapycnal diffusion, aging and regeneration at the surface to the ideal age tracers
subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, &
evap_CFL_limit, minimum_forcing_depth)
evap_CFL_limit, minimum_forcing_depth, Hbl)
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_(GV)), &
Expand All @@ -302,20 +322,34 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G,
!! be fluxed out of the top layer in a timestep [nondim]
real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which
!! fluxes can be applied [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: Hbl !< Boundary layer depth [Z ~> m]

! 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.

! 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)
! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: BL_layers ! Stores number of layers in boundary layer
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified
real :: sfc_val ! The surface value for the tracers.
real :: young_val ! The "young" value for the tracers.
real :: Isecs_per_year ! The inverse of the amount of time in a year [T-1 ~> s-1]
real :: year ! The time in years.
integer :: i, j, k, is, ie, js, je, nz, m
real :: layer_frac
integer :: i, j, k, is, ie, js, je, nz, m, nk
character(len=255) :: msg
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke

if (CS%use_real_BL_depth .and. .not. present(Hbl)) then
call MOM_error(FATAL,"Attempting to use real boundary layer depth for ideal age tracers, &
but no valid boundary layer scheme was found")
endif

if (CS%use_real_BL_depth .and. present(Hbl)) then
call count_BL_layers(G, GV, h_old, Hbl, BL_layers)
endif

if (.not.associated(CS)) return
if (CS%ntr < 1) return

Expand All @@ -340,27 +374,122 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G,
year = US%s_to_T*time_type_to_real(CS%Time) * Isecs_per_year

do m=1,CS%ntr
if (CS%sfc_growth_rate(m) == 0.0) then
sfc_val = CS%young_val(m)

if (CS%growth_rate(m) == 0.0) then
young_val = CS%young_val(m)
else
sfc_val = CS%young_val(m) * &
exp((year-CS%tracer_start_year(m)) * CS%sfc_growth_rate(m))
young_val = CS%young_val(m) * &
exp((year-CS%tracer_start_year(m)) * CS%growth_rate(m))
endif
do k=1,CS%nkml ; do j=js,je ; do i=is,ie
if (G%mask2dT(i,j) > 0.0) 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 (m == CS%BL_residence_num) then

if (CS%use_real_BL_depth) then
do j=js,je ; do i=is,ie
nk = floor(BL_layers(i,j))

do k=1,nk
if (G%mask2dT(i,j) > 0.0) then
CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt*Isecs_per_year
else
CS%tr(i,j,k,m) = CS%land_val(m)
endif
enddo

k = MIN(nk+1,nz)

if (G%mask2dT(i,j) > 0.0) then
layer_frac = BL_layers(i,j)-nk
layer_frac = 0.9
CS%tr(i,j,k,m) = layer_frac * (CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt &
*Isecs_per_year) + (1.-layer_frac) * young_val
else
CS%tr(i,j,k,m) = CS%land_val(m)
endif


do k=nk+2,nz
if (G%mask2dT(i,j) > 0.0) then
CS%tr(i,j,k,m) = young_val
else
CS%tr(i,j,k,m) = CS%land_val(m)
endif
enddo
enddo ; enddo

else ! use real BL depth
do j=js,je ; do i=is,ie
do k=1,CS%nkbl
if (G%mask2dT(i,j) > 0.0) then
CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt*Isecs_per_year
else
CS%tr(i,j,k,m) = CS%land_val(m)
endif
enddo

do k=CS%nkbl+1,nz
if (G%mask2dT(i,j) > 0.0) then
CS%tr(i,j,k,m) = young_val
else
CS%tr(i,j,k,m) = CS%land_val(m)
endif
enddo
enddo ; enddo

endif ! use real BL depth

else ! if BL residence tracer

if (CS%use_real_BL_depth) then
do j=js,je ; do i=is,ie
nk = floor(BL_layers(i,j))
do k=1,nk
if (G%mask2dT(i,j) > 0.0) then
CS%tr(i,j,k,m) = young_val
else
CS%tr(i,j,k,m) = CS%land_val(m)
endif
enddo

k = MIN(nk+1,nz)
if (G%mask2dT(i,j) > 0.0) then
layer_frac = BL_layers(i,j)-nk
CS%tr(i,j,k,m) = (1.-layer_frac) * (CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt &
*Isecs_per_year) + layer_frac * young_val
else
CS%tr(i,j,k,m) = CS%land_val(m)
endif

do k=nk+2,nz
if (G%mask2dT(i,j) > 0.0) then
CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt*Isecs_per_year
else
CS%tr(i,j,k,m) = CS%land_val(m)
endif
enddo
enddo ; enddo

else ! use real BL depth
do k=1,CS%nkbl ; do j=js,je ; do i=is,ie
if (G%mask2dT(i,j) > 0.0) then
CS%tr(i,j,k,m) = young_val
else
CS%tr(i,j,k,m) = CS%land_val(m)
endif
enddo ; enddo ; enddo

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%nkbl+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


endif ! if use real BL depth
endif ! if BL residence tracer

enddo ! loop over all tracers

end subroutine ideal_age_tracer_column_physics

Expand Down Expand Up @@ -448,6 +577,36 @@ subroutine ideal_age_example_end(CS)
endif
end subroutine ideal_age_example_end

subroutine count_BL_layers(G, GV, h, Hbl, BL_layers)
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_(GV)), &
intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hbl !< Boundary layer depth [Z ~> m]
real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BL_layers !< Number of model layers in the boundary layer

real :: current_depth
integer :: i, j, k, is, ie, js, je, nz, m, nk
character(len=255) :: msg
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke

BL_layers(:,:) = 0.
do j=js,je ; do i=is,ie

current_depth = 0.
do k=1,nz
current_depth = current_depth + h(i,j,k)*GV%H_to_Z
if (Hbl(i,j) <= current_depth) then
BL_layers(i,j) = BL_layers(i,j) + (1.0 - (current_depth - Hbl(i,j)) / (h(i,j,k)*GV%H_to_Z))
exit
else
BL_layers(i,j) = BL_layers(i,j) + 1.0
endif
enddo
enddo ; enddo

end subroutine count_BL_layers

!> \namespace ideal_age_example
!!
!! Originally by Robert Hallberg, 2002
Expand Down