module tracer_manager_mod
!
! William Cooke
!
!
! Matt Harrison
!
!
! Bruce Wyman
!
!
! Peter Phillipps
!
!
!
! Code to manage the simple addition of tracers to the FMS code.
! This code keeps track of the numbers and names of tracers included
! in a tracer table.
!
!
! This code is a grouping of calls which will allow the simple
! introduction of tracers into the FMS framework. It is designed to
! allow users of a variety of component models interact easily with
! the dynamical core of the model.
!
! In calling the tracer manager routines the user must provide a
! parameter identifying the model that the user is working with. This
! parameter is defined within field_manager as MODEL_X
! where X is one of [ATMOS, OCEAN, LAND, ICE].
!
! In many of these calls the argument list includes model and tracer_index. These
! are the parameter corresponding to the component model and the tracer_index N is
! the Nth tracer within the component model. Therefore a call with MODEL_ATMOS and 5
! is different from a call with MODEL_OCEAN and 5.
!
!
!----------------------------------------------------------------------
use mpp_mod, only : mpp_error, &
mpp_pe, &
mpp_root_pe, &
FATAL, &
WARNING, &
NOTE, &
stdlog
use mpp_io_mod, only : mpp_open, &
mpp_close, &
MPP_ASCII, &
MPP_APPEND, &
MPP_RDONLY
use fms_mod, only : lowercase, &
write_version_number
use field_manager_mod, only : field_manager_init, &
get_field_info, &
get_field_methods, &
MODEL_ATMOS, &
MODEL_LAND, &
MODEL_OCEAN, &
MODEL_ICE, &
MODEL_COUPLER, &
NUM_MODELS, &
method_type, &
default_method, &
parse, &
fm_copy_list, &
fm_change_list, &
fm_modify_name, &
fm_query_method, &
fm_new_value, &
fm_exists, &
MODEL_NAMES
implicit none
private
!-----------------------------------------------------------------------
public tracer_manager_init, &
tracer_manager_end, &
check_if_prognostic, &
get_tracer_indices, &
get_tracer_index, &
get_tracer_names, &
get_tracer_name, &
query_method, &
set_tracer_atts, &
set_tracer_profile, &
register_tracers, &
get_number_tracers, &
adjust_mass, &
adjust_positive_def, &
NO_TRACER, &
MAX_TRACER_FIELDS
!-----------------------------------------------------------------------
interface get_tracer_index
module procedure get_tracer_index_integer, get_tracer_index_logical
end interface
!-----------------------------------------------------------------------
integer :: num_tracer_fields = 0
integer, parameter :: MAX_TRACER_FIELDS = 150
integer, parameter :: MAX_TRACER_METHOD = 20
integer, parameter :: NO_TRACER = 1-HUGE(1)
integer, parameter :: NOTRACER = -HUGE(1)
integer :: total_tracers(NUM_MODELS), prog_tracers(NUM_MODELS), diag_tracers(NUM_MODELS)
logical :: model_registered(NUM_MODELS) = .FALSE.
type, private :: tracer_type
character(len=32) :: tracer_name, tracer_units
character(len=128) :: tracer_longname
integer :: num_methods, model, instances
logical :: is_prognostic, instances_set
logical :: needs_init
! Does tracer need mass or positive definite adjustment?
! (true by default for both)
logical :: needs_mass_adjust
logical :: needs_positive_adjust
end type tracer_type
type, private :: tracer_name_type
character(len=32) :: model_name, tracer_name, tracer_units
character(len=128) :: tracer_longname
end type tracer_name_type
type, private :: inst_type
character(len=128) :: name
integer :: instances
end type inst_type
type(tracer_type), save :: tracers(MAX_TRACER_FIELDS)
type(inst_type) , save :: instantiations(MAX_TRACER_FIELDS)
character(len=128) :: version = '$Id$'
character(len=128) :: tagname = '$Name$'
logical :: module_is_initialized = .false.
logical :: verbose_local
integer :: TRACER_ARRAY(NUM_MODELS,MAX_TRACER_FIELDS)
contains
!
!#######################################################################
!
!
!
! It is not necessary to call this routine.
! It is included only for backward compatability.
!
!
! This routine writes the version and tagname to the logfile and
! sets the module initialization flag.
!
!
! call tracer_manager_init
!
subroutine tracer_manager_init
integer :: model, num_tracers, num_prog, num_diag
if(module_is_initialized) return
module_is_initialized = .TRUE.
call write_version_number (version, tagname)
call field_manager_init()
TRACER_ARRAY = NOTRACER
do model=1,NUM_MODELS
call get_tracer_meta_data(model, num_tracers, num_prog, num_diag)
enddo
end subroutine tracer_manager_init
!
!#######################################################################
!
!
! read tracer table and store tracer information associated with "model"
! in "tracers" array.
!
subroutine get_tracer_meta_data(model, num_tracers,num_prog,num_diag)
integer, intent(in) :: model ! model being used
integer, intent(out) :: num_tracers, num_prog, num_diag
character(len=256) :: warnmesg
character(len=32) :: name_type, type, name
integer :: n, m, mod, num_tracer_methods, nfields, swop
integer :: j, log_unit, num_methods
logical :: flag_type
type(method_type), dimension(MAX_TRACER_METHOD) :: methods
integer :: instances, siz_inst,i
character(len = 32) :: digit,suffnam
character(len=128) :: list_name , control
integer :: index_list_name
logical :: fm_success
!
! The index for the model type is invalid.
!
if (model .ne. MODEL_ATMOS .and. model .ne. MODEL_LAND .and. &
model .ne. MODEL_OCEAN .and. model .ne. MODEL_ICE .and. &
model .ne. MODEL_COUPLER) call mpp_error(FATAL,'tracer_manager_init : invalid model type')
! One should only call get_tracer_meta_data once for each model type
! Therefore need to set up an array to stop the subroutine being
! unnecssarily called multiple times.
if ( model_registered(model) ) then
! This routine has already been called for the component model.
! Fill in the values from the previous registration and return.
num_tracers = total_tracers(model)
num_prog = prog_tracers(model)
num_diag = diag_tracers(model)
return
endif
! Initialize the number of tracers to zero.
num_tracers = 0; num_prog = 0; num_diag = 0
call field_manager_init(nfields=nfields)
!
! No tracers are available to be registered. This means that the field
! table does not exist or is empty.
!
if (nfields == 0 ) then
if (mpp_pe() == mpp_root_pe()) &
call mpp_error(NOTE,'tracer_manager_init : No tracers are available to be registered.')
return
endif
! search through field entries for model tracers
total_tracers(model) = 0
do n=1,nfields
call get_field_info(n,type,name,mod,num_methods)
if (mod == model .and. type == 'tracer') then
num_tracer_fields = num_tracer_fields + 1
total_tracers(model) = total_tracers(model) + 1
!
! The maximum number of tracer fields has been exceeded.
!
if(num_tracer_fields > MAX_TRACER_FIELDS) call mpp_error(FATAL,'tracer_manager_init: MAX_TRACER_FIELDS exceeded')
TRACER_ARRAY(model,total_tracers(model)) = num_tracer_fields
tracers(num_tracer_fields)%model = model
tracers(num_tracer_fields)%tracer_name = name
tracers(num_tracer_fields)%tracer_units = 'none'
tracers(num_tracer_fields)%tracer_longname = tracers(num_tracer_fields)%tracer_name
tracers(num_tracer_fields)%instances_set = .FALSE.
! By default, tracers need mass and positive definite adjustments.
! We hardwire exceptions for compatibility with existing field_tables
! This should ideally be cleaned up.
tracers(num_tracer_fields)%needs_mass_adjust = .true.
tracers(num_tracer_fields)%needs_positive_adjust = .true.
if (name == 'cld_amt') then
tracers(num_tracer_fields)%needs_mass_adjust = .false.
endif
if (name == 'cld_amt' .or. name == 'liq_wat' .or. name == 'ice_wat') then
tracers(num_tracer_fields)%needs_positive_adjust = .false.
endif
num_tracer_methods = 0
methods = default_method ! initialize methods array
call get_field_methods(n,methods)
do j=1,num_methods
select case (methods(j)%method_type)
case ('units')
tracers(num_tracer_fields)%tracer_units = methods(j)%method_name
case ('longname')
tracers(num_tracer_fields)%tracer_longname = methods(j)%method_name
case ('instances')
! tracers(num_tracer_fields)%instances = methods(j)%method_name
siz_inst = parse(methods(j)%method_name,"",instances)
tracers(num_tracer_fields)%instances = instances
tracers(num_tracer_fields)%instances_set = .TRUE.
case ('adjust_mass')
if (methods(j)%method_name == "false") then
tracers(num_tracer_fields)%needs_mass_adjust = .false.
endif
case ('adjust_positive_def')
if (methods(j)%method_name == "false") then
tracers(num_tracer_fields)%needs_positive_adjust = .false.
endif
case default
num_tracer_methods = num_tracer_methods+1
! tracers(num_tracer_fields)%methods(num_tracer_methods) = methods(j)
end select
enddo
tracers(num_tracer_fields)%num_methods = num_tracer_methods
tracers(num_tracer_fields)%needs_init = .false.
flag_type = query_method ('tracer_type',model,total_tracers(model),name_type)
if (flag_type .and. name_type == 'diagnostic') then
tracers(num_tracer_fields)%is_prognostic = .false.
else
tracers(num_tracer_fields)%is_prognostic = .true.
endif
if (tracers(num_tracer_fields)%is_prognostic) then
num_prog = num_prog+1
else
num_diag = num_diag+1
endif
endif
enddo
! Now cycle through the tracers and add additional instances of the tracers.
do n = 1, num_tracer_fields !{
! call get_field_info(n,type,name,mod,num_methods)
if ( model == tracers(n)%model .and. tracers(n)%instances_set ) then !{ We have multiple instances of this tracer
if ( num_tracer_fields + tracers(n)%instances > MAX_TRACER_FIELDS ) then
write(warnmesg, '("tracer_manager_init: Number of tracers will exceed MAX_TRACER_FIELDS with &
&multiple (",I3," instances) setup of tracer ",A)') tracers(n)%instances,tracers(n)%tracer_name
call mpp_error(FATAL, warnmesg)
endif
do i = 2, tracers(n)%instances !{
num_tracer_fields = num_tracer_fields + 1
total_tracers(model) = total_tracers(model) + 1
TRACER_ARRAY(model,total_tracers(model)) = num_tracer_fields
! Copy the original tracer type to the multiple instances.
tracers(num_tracer_fields) = tracers(n)
if ( query_method ('instances', model,model_tracer_number(model,n),name, control)) then !{
if (i .lt. 10) then !{
write (suffnam,'(''suffix'',i1)') i
siz_inst = parse(control, suffnam,digit)
if (siz_inst == 0 ) then
write (digit,'(''_'',i1)') i
else
digit = "_"//trim(digit)
endif
elseif (i .lt. 100) then !}{
write (suffnam,'(''suffix'',i2)') i
siz_inst = parse(control, suffnam,digit)
if (siz_inst == 0 ) then
write (digit,'(''_'',i2)') i
else
digit = "_"//trim(digit)
endif
else !}{
call mpp_error(FATAL, 'tracer_manager_init: MULTIPLE_TRACER_SET_UP exceeds 100 for '//tracers(n)%tracer_name )
endif !}
select case(model)
case (MODEL_COUPLER)
list_name = "/coupler_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
case (MODEL_ATMOS)
list_name = "/atmos_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
case (MODEL_OCEAN)
list_name = "/ocean_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
case (MODEL_ICE )
list_name = "/ice_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
case (MODEL_LAND )
list_name = "/land_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
case default
list_name = "/default/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
end select
if (mpp_pe() == mpp_root_pe() ) write (*,*) "Creating list name = ",trim(list_name)//trim(digit)
index_list_name = fm_copy_list(trim(list_name),digit, create = .true.)
tracers(num_tracer_fields)%tracer_name = trim(tracers(num_tracer_fields)%tracer_name)//trim(digit)
endif !}
if (tracers(num_tracer_fields)%is_prognostic) then !{
num_prog = num_prog+1
else !}{
num_diag = num_diag+1
endif !}
enddo !}
! Multiple instances of tracers were found so need to rename the original tracer.
digit = "_1"
siz_inst = parse(control, "suffix1",digit)
if (siz_inst > 0 ) then !{
digit = "_"//trim(digit)
endif !}
fm_success = fm_modify_name(trim(list_name), trim(tracers(n)%tracer_name)//trim(digit))
tracers(n)%tracer_name = trim(tracers(n)%tracer_name)//trim(digit)
endif !}
enddo !}
! Find any field entries with the instances keyword.
do n=1,nfields
call get_field_info(n,type,name,mod,num_methods)
if ( mod == model .and. type == 'instances' ) then
call get_field_methods(n,methods)
do j=1,num_methods
if (.not.get_tracer_index(mod,methods(j)%method_type,m)) then
call mpp_error(FATAL,'tracer_manager_init: The instances keyword was found for undefined tracer '&
//trim(methods(j)%method_type))
else
if ( tracers(m)%instances_set ) &
call mpp_error(FATAL,'tracer_manager_init: The instances keyword was found for '&
//trim(methods(j)%method_type)//' but has previously been defined in the tracer entry')
siz_inst = parse(methods(j)%method_name,"",instances)
tracers(m)%instances = instances
call mpp_error(NOTE,'tracer_manager_init: '//trim(instantiations(j)%name)// &
' will have '//trim(methods(j)%method_name)//' instances')
endif
if ( num_tracer_fields + instances > MAX_TRACER_FIELDS ) then
write(warnmesg, '("tracer_manager_init: Number of tracers will exceed MAX_TRACER_FIELDS with &
&multiple (",I3," instances) setup of tracer ",A)') tracers(m)%instances,tracers(m)%tracer_name
call mpp_error(FATAL, warnmesg)
endif
! We have found a valid tracer that has more than one instantiation.
! We need to modify that tracer name to tracer_1 and add extra tracers for the extra instantiations.
if (instances .eq. 1) then
siz_inst = parse(methods(j)%method_control, 'suffix1',digit)
if (siz_inst == 0 ) then
digit = '_1'
else
digit = "_"//trim(digit)
endif
endif
do i = 2, instances
num_tracer_fields = num_tracer_fields + 1
total_tracers(model) = total_tracers(model) + 1
TRACER_ARRAY(model,total_tracers(model)) = num_tracer_fields
tracers(num_tracer_fields) = tracers(m)
if (i .lt. 10) then !{
write (suffnam,'(''suffix'',i1)') i
siz_inst = parse(methods(j)%method_control, suffnam,digit)
if (siz_inst == 0 ) then
write (digit,'(''_'',i1)') i
else
digit = "_"//trim(digit)
endif
elseif (i .lt. 100) then !}{
write (suffnam,'(''suffix'',i2)') i
siz_inst = parse(methods(j)%method_control, suffnam,digit)
if (siz_inst == 0 ) then
write (digit,'(''_'',i2)') i
else
digit = "_"//trim(digit)
endif
else !}{
call mpp_error(FATAL, 'tracer_manager_init: MULTIPLE_TRACER_SET_UP exceeds 100 for '&
//tracers(num_tracer_fields)%tracer_name )
endif !}
select case(model)
case (MODEL_COUPLER)
list_name = "/coupler_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
case (MODEL_ATMOS)
list_name = "/atmos_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
case (MODEL_OCEAN)
list_name = "/ocean_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
case (MODEL_ICE )
list_name = "/ice_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
case (MODEL_LAND )
list_name = "/land_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
case default
list_name = "/default/tracer/"//trim(tracers(num_tracer_fields)%tracer_name)
end select
if (mpp_pe() == mpp_root_pe() ) write (*,*) "Creating list name = ",trim(list_name)
index_list_name = fm_copy_list(trim(list_name),digit, create = .true.)
tracers(num_tracer_fields)%tracer_name = trim(tracers(num_tracer_fields)%tracer_name)//digit
if (tracers(num_tracer_fields)%is_prognostic) then
num_prog = num_prog+1
else
num_diag = num_diag+1
endif
enddo
!Now rename the original tracer to tracer_1 (or if suffix1 present to tracer_'value_of_suffix1')
siz_inst = parse(methods(j)%method_control, 'suffix1',digit)
if (siz_inst == 0 ) then
digit = '_1'
else
digit = "_"//trim(digit)
endif
fm_success = fm_modify_name(trim(list_name), trim(tracers(m)%tracer_name)//trim(digit))
tracers(m)%tracer_name = trim(tracers(m)%tracer_name)//trim(digit)
enddo
endif
enddo
num_tracers = num_prog + num_diag
! Make the number of tracers available publicly.
total_tracers(model) = num_tracers
prog_tracers(model) = num_prog
diag_tracers(model) = num_diag
model_registered(model) = .TRUE.
! Now sort through the tracer fields and sort them so that the
! prognostic tracers are first.
do n=1, num_tracers
if (.not.check_if_prognostic(model,n) .and. n.le.num_prog) then
! This is a diagnostic tracer so find a prognostic tracer to swop with
do m = n, num_tracers
if (check_if_prognostic(model,m) .and. .not.check_if_prognostic(model,n)) then
swop = TRACER_ARRAY(model,n)
TRACER_ARRAY(model,n) = TRACER_ARRAY(model,m)
TRACER_ARRAY(model,m) = swop
cycle
endif
enddo
endif
enddo
do n=1, num_tracer_fields
call print_tracer_info(model,n)
enddo
log_unit = stdlog()
if ( mpp_pe() == mpp_root_pe() ) then
write (log_unit,15) trim(MODEL_NAMES(model)),total_tracers(model)
endif
15 format ('Number of tracers in field table for ',A,' model = ',i4)
end subroutine get_tracer_meta_data
!
function model_tracer_number(model,n)
integer, intent(in) :: model, n
integer model_tracer_number
integer :: i
model_tracer_number = NO_TRACER
do i = 1, MAX_TRACER_FIELDS
if ( TRACER_ARRAY(model,i) == n ) then
model_tracer_number = i
return
endif
enddo
end function model_tracer_number
!#######################################################################
!
!
!
! It is not necessary to call this routine.
! It is included only for backward compatability.
!
!
! This routine returns the total number of valid tracers,
! the number of prognostic and diagnostic tracers.
!
!
! call register_tracers(model, num_tracers,num_prog,num_diag)
!
!
! A parameter to identify which model is being used.
!
!
! The total number of valid tracers within the component model.
!
!
! The number of prognostic tracers within the component model.
!
!
! The number of diagnostic tracers within the component model.
!
subroutine register_tracers(model, num_tracers, num_prog, num_diag, num_family)
integer, intent(in) :: model
integer, intent(out) :: num_tracers, num_prog, num_diag
integer, intent(out), optional :: num_family
if(.not.module_is_initialized) call tracer_manager_init
call get_number_tracers(model, num_tracers, num_prog, num_diag, num_family)
end subroutine register_tracers
!
!#######################################################################
!
!
! A routine to return the number of tracers included in a component model.
!
!
! This routine returns the total number of valid tracers,
! the number of prognostic and diagnostic tracers
!
!
! call get_number_tracers(model, num_tracers,num_prog,num_diag)
!
!
! A parameter to identify which model is being used.
!
!
! The total number of valid tracers within the component model.
!
!
! The number of prognostic tracers within the component model.
!
!
! The number of diagnostic tracers within the component model.
!
subroutine get_number_tracers(model, num_tracers, num_prog, num_diag, num_family)
integer, intent(in) :: model
integer, intent(out), optional :: num_tracers, num_prog, num_diag, num_family
if(.not.module_is_initialized) call tracer_manager_init
!
! The index of the component model is invalid.
!
if (model .ne. MODEL_ATMOS .and. model .ne. MODEL_LAND .and. &
model .ne. MODEL_OCEAN .and. model .ne. MODEL_ICE .and. &
model .ne. MODEL_COUPLER) &
call mpp_error(FATAL,"get_number_tracers : Model number is invalid.")
if (present(num_tracers)) num_tracers = total_tracers(model)
if (present(num_prog)) num_prog = prog_tracers(model)
if (present(num_diag)) num_diag = diag_tracers(model)
if (present(num_family)) num_family = 0 ! Needed only for backward compatability with lima
end subroutine get_number_tracers
!
!
!
! Routine to return the component model tracer indices as defined within
! the tracer manager.
!
!
! If several models are being used or redundant tracers have been written to
! the tracer_table, then the indices in the component model and the tracer
! manager may not have a one to one correspondence. Therefore the component
! model needs to know what index to pass to calls to tracer_manager routines in
! order that the correct tracer information be accessed.
!
!
! call get_tracer_indices(model, ind, prog_ind, diag_ind)
!
!
! A parameter to identify which model is being used.
!
!
! An array containing the tracer manager defined indices for
! all the tracers within the component model.
!
!
! An array containing the tracer manager defined indices for
! the prognostic tracers within the component model.
!
!
! An array containing the tracer manager defined indices for
! the diagnostic tracers within the component model.
!
subroutine get_tracer_indices(model, ind, prog_ind, diag_ind, fam_ind)
integer, intent(in) :: model
integer, intent(out), dimension(:), optional :: ind, prog_ind, diag_ind, fam_ind
integer :: i, j, np, nd, n
if(.not.module_is_initialized) call tracer_manager_init
nd=0;np=0;n=0
! Initialize arrays with dummy values
if (PRESENT(ind)) ind = NO_TRACER
if (PRESENT(prog_ind)) prog_ind = NO_TRACER
if (PRESENT(diag_ind)) diag_ind = NO_TRACER
if (PRESENT(fam_ind)) fam_ind = NO_TRACER
do i = 1, MAX_TRACER_FIELDS
j = TRACER_ARRAY(model,i)
if ( j /= NOTRACER) then
if ( model == tracers(j)%model) then
if (PRESENT(ind)) then
n=n+1
!
! The global index array is too small and cannot contain all the tracer numbers.
!
if (n > size(ind(:))) call mpp_error(FATAL,'get_tracer_indices : index array size too small in get_tracer_indices')
ind(n) = i
endif
if (tracers(j)%is_prognostic.and.PRESENT(prog_ind)) then
np=np+1
!
! The prognostic index array is too small and cannot contain all the tracer numbers.
!
if ( np > size( prog_ind(:)))call mpp_error(FATAL,&
'get_tracer_indices : prognostic array size too small in get_tracer_indices')
prog_ind(np) = i
else if (.not.tracers(j)%is_prognostic .and. PRESENT(diag_ind)) then
nd = nd+1
!
! The diagnostic index array is too small and cannot contain all the tracer numbers.
!
if (nd > size(diag_ind(:))) call mpp_error(FATAL,&
'get_tracer_indices : diagnostic array size too small in get_tracer_indices')
diag_ind(nd) = i
endif
endif
endif
enddo
return
end subroutine get_tracer_indices
!
!
!
! Function which returns the number assigned to the tracer name.
!
!
! This is a function which returns the index, as implied within the component model.
! There are two overloaded interfaces: one of type integer, one logical.
!
!
! integer: index = get_tracer_index(model, name, indices, verbose)
! logical: if ( get_tracer_index(model, name, index, indices, verbose) ) then
!
!
! A parameter to identify which model is being used.
!
!
! The name of the tracer (as assigned in the field table).
!
!
! An array indices.
! When present, the returned index will limit the search for the tracer
! to those tracers whos indices are amoung those in array "indices".
! This would be useful when it is desired to limit the search to a subset
! of the tracers. Such a subset might be the diagnostic or prognostic tracers.
! (Note that subroutine get_tracer_indices returns these subsets)
!
!
! A flag to allow the message saying that a tracer with this name has not
! been found. This should only be used for debugging purposes.
!
!
! integer function:
! The index of the tracer named "name".
! If no tracer by that name exists then the returned value is NO_TRACER.
! logical function:
! If no tracer by that name exists then the returned value is .false.,
! otherwise the returned value is .true.
!
function get_tracer_index_integer(model, name, indices, verbose)
integer, intent(in) :: model
character(len=*), intent(in) :: name
integer, intent(in), dimension(:), optional :: indices
logical, intent(in), optional :: verbose
integer :: get_tracer_index_integer
integer :: i
if(.not.module_is_initialized) call tracer_manager_init
get_tracer_index_integer = NO_TRACER
if (PRESENT(indices)) then
do i = 1, size(indices(:))
if (model == tracers(indices(i))%model .and. lowercase(trim(name)) == trim(tracers(indices(i))%tracer_name)) then
get_tracer_index_integer = i
exit
endif
enddo
else
do i=1, num_tracer_fields
if(TRACER_ARRAY(model,i) == NOTRACER) cycle
if (lowercase(trim(name)) == trim(tracers(TRACER_ARRAY(model,i))%tracer_name)) then
get_tracer_index_integer = i!TRACER_ARRAY(model,i)
exit
endif
enddo
end if
verbose_local=.FALSE.
if (present(verbose)) verbose_local=verbose
if (verbose_local) then
!
if (get_tracer_index_integer == NO_TRACER ) then
call mpp_error(NOTE,'get_tracer_index : tracer with this name not found: '//trim(name))
endif
!
endif
return
end function get_tracer_index_integer
!#######################################################################
function get_tracer_index_logical(model, name, index, indices, verbose)
integer, intent(in) :: model
character(len=*), intent(in) :: name
integer, intent(out) :: index
integer, intent(in), dimension(:), optional :: indices
logical, intent(in), optional :: verbose
logical :: get_tracer_index_logical
index = get_tracer_index_integer(model, name, indices, verbose)
if(index == NO_TRACER) then
get_tracer_index_logical = .false.
else
get_tracer_index_logical = .true.
endif
end function get_tracer_index_logical
!
!#######################################################################
!
!
! Routine to write to the log file that the tracer manager is ending.
!
!
! Routine to write to the log file that the tracer manager is ending.
!
!
! call tracer_manager_end
!
subroutine tracer_manager_end
integer :: log_unit
log_unit = stdlog()
if ( mpp_pe() == mpp_root_pe() ) then
write (log_unit,'(/,(a))') 'Exiting tracer_manager, have a nice day ...'
endif
module_is_initialized = .FALSE.
end subroutine tracer_manager_end
!
!#######################################################################
!
subroutine print_tracer_info(model,n)
!
! Routine to print out the components of the tracer.
! This is useful for informational purposes.
! Used in get_tracer_meta_data.
!
! Arguments:
! INTENT IN
! i : index of the tracer that is being printed.
!
integer, intent(in) :: model,n
integer :: i,log_unit
if(.not.module_is_initialized) call tracer_manager_init
if(mpp_pe()==mpp_root_pe() .and. TRACER_ARRAY(model,n)> 0 ) then
i = TRACER_ARRAY(model,n)
log_unit = stdlog()
write(log_unit, *)'----------------------------------------------------'
write(log_unit, *) 'Contents of tracer entry ', i
write(log_unit, *) 'Model type and field name'
write(log_unit, *) 'Model : ', tracers(i)%model
write(log_unit, *) 'Field name : ', trim(tracers(i)%tracer_name)
write(log_unit, *) 'Tracer units : ', trim(tracers(i)%tracer_units)
write(log_unit, *) 'Tracer longname : ', trim(tracers(i)%tracer_longname)
write(log_unit, *) 'Tracer is_prognostic : ', tracers(i)%is_prognostic
write(log_unit, *)'----------------------------------------------------'
endif
900 FORMAT(A,2(1x,E12.6))
901 FORMAT(E12.6,1x,E12.6)
end subroutine print_tracer_info
!#######################################################################
!
!
!
! Routine to find the names associated with a tracer number.
!
!
! This routine can return the name, long name and units associated
! with a tracer.
!
!
! call get_tracer_names(model,n,name,longname, units)
!
!
! A parameter representing the component model in use.
!
!
! Tracer number.
!
!
! Field name associated with tracer number.
!
!
! The long name associated with tracer number.
!
!
! The units associated with tracer number.
!
subroutine get_tracer_names(model,n,name,longname, units, err_msg)
integer, intent(in) :: model, n
character (len=*),intent(out) :: name
character (len=*), intent(out), optional :: longname, units, err_msg
character (len=128) :: err_msg_local
integer :: n1
character(len=11) :: chn
if(.not.module_is_initialized) call tracer_manager_init
if (n < 1 .or. n > total_tracers(model)) then
write(chn, '(i11)') n
err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn)
if(error_handler('get_tracer_names', err_msg_local, err_msg)) return
endif
n1 = TRACER_ARRAY(model,n)
name = trim(tracers(n1)%tracer_name)
if (PRESENT(longname)) longname = trim(tracers(n1)%tracer_longname)
if (PRESENT(units)) units = trim(tracers(n1)%tracer_units)
end subroutine get_tracer_names
!
!
!#######################################################################
!
!
!
! Routine to find the names associated with a tracer number.
!
!
! This routine can return the name, long name and units associated with a tracer.
! The return value of get_tracer_name is .false. when a FATAL error condition is
! detected, otherwise the return value is .true.
!
!
! if(.not.get_tracer_name(model,n,name,longname, units, err_msg)) call mpp_error(.....
!
!
! A parameter representing the component model in use.
!
!
! Tracer number.
!
!
! Field name associated with tracer number.
!
!
! The long name associated with tracer number.
!
!
! The units associated with tracer number.
!
!
! When present:
! If a FATAL error condition is detected then err_msg will contain an error message
! and the return value of get_tracer_name will be .false.
! If no FATAL error is detected err_msg will be filled with space characters and
! and the return value of get_tracer_name will be .true.
! When not present:
! A FATAL error will result in termination inside get_tracer_name without returning.
! If no FATAL error is detected the return value of get_tracer_name will be .true.
!
function get_tracer_name(model,n,name,longname, units, err_msg)
logical :: get_tracer_name
integer, intent(in) :: model, n
character (len=*),intent(out) :: name
character (len=*), intent(out), optional :: longname, units, err_msg
character (len=128) :: err_msg_local
integer :: n1
character(len=11) :: chn
if(.not.module_is_initialized) call tracer_manager_init
if (n < 1 .or. n > total_tracers(model)) then
write(chn, '(i11)') n
err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn)
if(error_handler('get_tracer_name', err_msg_local, err_msg)) then
get_tracer_name = .false.
return
endif
else
get_tracer_name = .true.
endif
n1 = TRACER_ARRAY(model,n)
name = trim(tracers(n1)%tracer_name)
if (PRESENT(longname)) longname = trim(tracers(n1)%tracer_longname)
if (PRESENT(units)) units = trim(tracers(n1)%tracer_units)
end function get_tracer_name
!
!
!#######################################################################
!
!
!
! Function to see if a tracer is prognostic or diagnostic.
!
!
! All tracers are assumed to be prognostic when read in from the field_table
! However a tracer can be changed to a diagnostic tracer by adding the line
! "tracer_type","diagnostic"
! to the tracer description in field_table.
!
!
! logical =check_if_prognostic(model, n)
!
!
! A parameter representing the component model in use.
!
!
! Tracer number
!
!
! A logical flag set TRUE if the tracer is
! prognostic.
!
function check_if_prognostic(model, n, err_msg)
integer, intent(in) :: model, n
logical :: check_if_prognostic
character(len=*), intent(out), optional :: err_msg
character(len=128) :: err_msg_local
character(len=11) :: chn
if(.not.module_is_initialized) call tracer_manager_init
if (n < 1 .or. n > total_tracers(model)) then
write(chn, '(i11)') n
err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn)
check_if_prognostic = .true.
if(error_handler('check_if_prognostic', err_msg_local, err_msg)) return
endif
!Convert local model index to tracer_manager index
check_if_prognostic = tracers(TRACER_ARRAY(model,n))%is_prognostic
end function check_if_prognostic
!
! Does tracer need mass or positive definite adjustments?
!#######################################################################
! Function to check whether tracer should have its mass adjusted
function adjust_mass(model, n, err_msg)
integer, intent(in) :: model, n
logical :: adjust_mass
character(len=*), intent(out), optional :: err_msg
character(len=128) :: err_msg_local
character(len=11) :: chn
if(.not.module_is_initialized) call tracer_manager_init
if (n < 1 .or. n > total_tracers(model)) then
write(chn, '(i11)') n
err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn)
adjust_mass = .true.
if(error_handler('adjust_mass', err_msg_local, err_msg)) return
endif
!Convert local model index to tracer_manager index
adjust_mass = tracers(TRACER_ARRAY(model,n))%needs_mass_adjust
end function adjust_mass
! Function to check whether tracer should be adjusted to remain positive definite
function adjust_positive_def(model, n, err_msg)
integer, intent(in) :: model, n
logical :: adjust_positive_def
character(len=*), intent(out), optional :: err_msg
character(len=128) :: err_msg_local
character(len=11) :: chn
if(.not.module_is_initialized) call tracer_manager_init
if (n < 1 .or. n > total_tracers(model)) then
write(chn, '(i11)') n
err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn)
adjust_positive_def = .true.
if(error_handler('adjust_positive_def', err_msg_local, err_msg)) return
endif
!Convert local model index to tracer_manager index
adjust_positive_def = tracers(TRACER_ARRAY(model,n))%needs_positive_adjust
end function adjust_positive_def
!
!#######################################################################
!
!
!
! Subroutine to set the tracer field to the wanted profile.
!
!
! If the profile type is 'fixed' then the tracer field values are set
! equal to the surface value.
! If the profile type is 'profile' then the top/bottom of model and
! surface values are read and an exponential profile is calculated,
! with the profile being dependent on the number of levels in the
! component model. This should be called from the part of the dynamical
! core where tracer restarts are called in the event that a tracer
! restart file does not exist.
!
! This can be activated by adding a method to the field_table
! e.g.
! "profile_type","fixed","surface_value = 1e-12"
! would return values of surf_value = 1e-12 and a multiplier of 1.0
! One can use these to initialize the entire field with a value of 1e-12.
!
! "profile_type","profile","surface_value = 1e-12, top_value = 1e-15"
! In a 15 layer model this would return values of surf_value = 1e-12 and
! multiplier = 0.6309573 i.e 1e-15 = 1e-12*(0.6309573^15)
! In this case the model should be MODEL_ATMOS as you have a "top" value.
!
! If you wish to initialize the ocean model, one can use bottom_value instead
! of top_value.
!
!
! call set_tracer_profile(model, n, tracer)
!
!
! A parameter representing the component model in use.
!
!
! Tracer number.
!
!
! The initialized tracer array.
!
subroutine set_tracer_profile(model, n, tracer, err_msg)
integer, intent(in) :: model, n
real, intent(inout), dimension(:,:,:) :: tracer
character(len=*), intent(out), optional :: err_msg
real :: surf_value, multiplier
integer :: numlevels, k, n1, flag
real :: top_value, bottom_value
character(len=80) :: scheme, control,profile_type
character(len=128) :: err_msg_local
character(len=11) :: chn
if(.not.module_is_initialized) call tracer_manager_init
if (n < 1 .or. n > total_tracers(model)) then
write(chn, '(i11)') n
err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn)
if(error_handler('set_tracer_profile', err_msg_local, err_msg)) return
endif
n1 = TRACER_ARRAY(model,n)
!default values
profile_type = 'Fixed'
surf_value = 0.0E+00
top_value = surf_value
bottom_value = surf_value
multiplier = 1.0
tracer = surf_value
if ( query_method ( 'profile_type',model,n,scheme,control)) then
!Change the tracer_number to the tracer_manager version
if(lowercase(trim(scheme(1:5))).eq.'fixed') then
profile_type = 'Fixed'
flag =parse(control,'surface_value',surf_value)
multiplier = 1.0
tracer = surf_value
endif
if(lowercase(trim(scheme(1:7))).eq.'profile') then
profile_type = 'Profile'
flag=parse(control,'surface_value',surf_value)
if (surf_value .eq. 0.0) &
call mpp_error(FATAL,'set_tracer_profile : Cannot have a zero surface value for an exponential profile. Tracer '&
//tracers(n1)%tracer_name//" "//control//" "//scheme)
select case (tracers(n1)%model)
case (MODEL_ATMOS)
flag=parse(control,'top_value',top_value)
if(mpp_pe()==mpp_root_pe() .and. flag == 0) &
call mpp_error(NOTE,'set_tracer_profile : Parameter top_value needs to be defined for the tracer profile.')
case (MODEL_OCEAN)
flag =parse(control,'bottom_value',bottom_value)
if(mpp_pe() == mpp_root_pe() .and. flag == 0) &
call mpp_error(NOTE,'set_tracer_profile : Parameter bottom_value needs to be defined for the tracer profile.')
case default
! Should there be a NOTE or WARNING message here?
end select
! If profile type is profile then set the surface value to the input
! value and calculate the vertical multiplier.
!
! Assume an exponential decay/increase from the surface to the top level
! C = C0 exp ( -multiplier* level_number)
! => multiplier = exp [ ln(Ctop/Csurf)/number_of_levels]
!
numlevels = size(tracer,3) -1
select case (tracers(n1)%model)
case (MODEL_ATMOS)
multiplier = exp( log (top_value/surf_value) /numlevels)
tracer(:,:,1) = surf_value
do k = 2, size(tracer,3)
tracer(:,:,k) = tracer(:,:,k-1) * multiplier
enddo
case (MODEL_OCEAN)
multiplier = exp( log (bottom_value/surf_value) /numlevels)
tracer(:,:,size(tracer,3)) = surf_value
do k = size(tracer,3) - 1, 1, -1
tracer(:,:,k) = tracer(:,:,k+1) * multiplier
enddo
case default
end select
endif !scheme.eq.profile
if (mpp_pe() == mpp_root_pe() ) write(*,700) 'Tracer ',trim(tracers(n1)%tracer_name), &
' initialized with surface value of ',surf_value, &
' and vertical multiplier of ',multiplier
700 FORMAT (3A,E12.6,A,F10.6)
endif ! end of query scheme
end subroutine set_tracer_profile
!
!
!#######################################################################
!
!
!
! A function to query the "methods" associated with each tracer.
!
!
! A function to query the "methods" associated with each tracer. The
! "methods" are the parameters of the component model that can be
! adjusted by user by placing formatted strings, associated with a
! particular tracer, within the field table.
! These methods can control the advection, wet deposition, dry
! deposition or initial profile of the tracer in question. Any
! parametrization can use this function as long as a routine for parsing
! the name and control strings are provided by that routine.
!
!
! logical =query_method (method_type, model, n, name, control)
!
!
! The method that is being requested.
!
!
! A parameter representing the component model in use.
!
!
! Tracer number
!
!
! A string containing the modified name to be used with
! method_type. i.e. "2nd_order" might be the default for
! advection. One could use "4th_order" here to modify
! that behaviour.
!
!
! A string containing the modified parameters that are
! associated with the method_type and name.
!
!
! A flag to show whether method_type exists with regard to
! tracer n. If method_type is not present then one must
! have default values.
!
!
! At present the tracer manager module allows the initialization of a tracer
! profile if a restart does not exist for that tracer.
! Options for this routine are as follows
!
! Tracer profile setup
! ==================================================================
! |method_type |method_name |method_control |
! ==================================================================
! |profile_type |fixed |surface_value = X |
! |profile_type |profile |surface_value = X, top_value = Y |(atmosphere)
! |profile_type |profile |surface_value = X, bottom_value = Y |(ocean)
! ==================================================================
!
!
function query_method (method_type, model, n, name, control, err_msg)
!
! A function to query the schemes associated with each tracer.
!
! INTENT IN
! method_type : The method that is being requested.
! model : The model that you are calling this function from.
! n : The tracer number.
! INTENT OUT
! name : A string containing the modified name to be used with
! method_type. i.e. "2nd_order" might be the default for
! advection. One could use "4th_order" here to modify
! that behaviour.
! control : A string containing the modified parameters that are
! associated with the method_type and name.
! query_method : A flag to show whether method_type exists with regard
! to tracer n. If method_type is not present then one
! must have default values.
character(len=*), intent(in) :: method_type
integer , intent(in) :: model, n
character(len=*), intent(out) :: name
character(len=*), intent(out), optional :: control, err_msg
logical :: query_method
integer :: n1
character(len=256) :: list_name, control_tr
character(len=11) :: chn
character(len=128) :: err_msg_local
if(.not.module_is_initialized) call tracer_manager_init
!Convert the local model tracer number to the tracer_manager version.
if (n < 1 .or. n > total_tracers(model)) then
write(chn, '(i11)') n
err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn)
if(error_handler('query_method', err_msg_local, err_msg)) return
endif
n1 = TRACER_ARRAY(model,n)
select case(model)
case (MODEL_COUPLER)
list_name = "/coupler_mod/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type)
case (MODEL_ATMOS)
list_name = "/atmos_mod/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type)
case (MODEL_OCEAN)
list_name = "/ocean_mod/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type)
case (MODEL_ICE )
list_name = "/ice_mod/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type)
case (MODEL_LAND )
list_name = "/land_mod/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type)
case default
list_name = "/default/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type)
end select
name = ''
control_tr = ''
query_method = fm_query_method(list_name, name, control_tr)
if ( present(control)) control = trim(control_tr)
end function query_method
!
!
!
! A subroutine to allow the user set the tracer longname and units from the
! tracer initialization routine.
!
!
! A function to allow the user set the tracer longname and units from the
! tracer initialization routine. It seems sensible that the user who is
! coding the tracer code will know what units they are working in and it
! is probably safer to set the value in the tracer code rather than in
! the field table.
!
!
! call set_tracer_atts(model, name, longname, units)
!
!
! A parameter representing the component model in use.
!
!
! Tracer name.
!
!
! A string describing the longname of the tracer for output to NetCDF files
!
!
! A string describing the units of the tracer for output to NetCDF files
!
subroutine set_tracer_atts(model, name, longname, units)
integer, intent(in) :: model
character(len=*), intent(in) :: name
character(len=*), intent(in), optional :: longname, units
integer :: n, index
logical :: success
character(len=128) :: list_name
if ( get_tracer_index(model,name,n) ) then
tracers(TRACER_ARRAY(model,n))%tracer_units = units
tracers(TRACER_ARRAY(model,n))%tracer_longname = longname
select case(model)
case(MODEL_COUPLER)
list_name = "/coupler_mod/tracer/"//trim(name)
case(MODEL_ATMOS)
list_name = "/atmos_mod/tracer/"//trim(name)
case(MODEL_OCEAN)
list_name = "/ocean_mod/tracer/"//trim(name)
case(MODEL_LAND)
list_name = "/land_mod/tracer/"//trim(name)
case(MODEL_ICE)
list_name = "/ice_mod/tracer/"//trim(name)
case DEFAULT
list_name = "/"//trim(name)
end select
! Method_type is a list, method_name is a name of a parameter and method_control has the value.
! list_name = trim(list_name)//"/longname"
if ( fm_exists(list_name)) then
success = fm_change_list(list_name)
if ( present(longname) ) then
if ( longname .ne. "" ) index = fm_new_value('longname',longname)
endif
if ( present(units) ) then
if (units .ne. "" ) index = fm_new_value('units',units)
endif
endif
else
call mpp_error(NOTE,'set_tracer_atts : Trying to set longname and/or units for non-existent tracer : '//trim(name))
endif
end subroutine set_tracer_atts
!
!
!
! A subroutine to allow the user to set some tracer specific methods.
!
!
! A subroutine to allow the user to set methods for a specific tracer.
!
!
! call set_tracer_method(model, name, method_type, method_name, method_control)
!
!
! A parameter representing the component model in use.
!
!
! Tracer name.
!
!
! The type of the method to be set.
!
!
! The name of the method to be set.
!
!
! The control parameters of the method to be set.
!
subroutine set_tracer_method(model, name, method_type, method_name, method_control)
integer, intent(in) :: model
character(len=*), intent(in) :: name
character(len=*), intent(in) :: method_type
character(len=*), intent(in) :: method_name
character(len=*), intent(in) :: method_control
integer :: n, num_method, index
logical :: success
character(len=128) :: list_name
if ( get_tracer_index(model,name,n) ) then
tracers(n)%num_methods = tracers(n)%num_methods + 1
num_method = tracers(n)%num_methods
select case(model)
case(MODEL_COUPLER)
list_name = "/coupler_mod/tracer/"//trim(name)
case(MODEL_ATMOS)
list_name = "/atmos_mod/tracer/"//trim(name)
case(MODEL_OCEAN)
list_name = "/ocean_mod/tracer/"//trim(name)
case(MODEL_LAND)
list_name = "/land_mod/tracer/"//trim(name)
case(MODEL_ICE)
list_name = "/ice_mod/tracer/"//trim(name)
case DEFAULT
list_name = "/"//trim(name)
end select
if ( method_control .ne. "" ) then
! Method_type is a list, method_name is a name of a parameter and method_control has the value.
list_name = trim(list_name)//"/"//trim(method_type)
if ( fm_exists(list_name)) then
success = fm_change_list(list_name)
index = fm_new_value(method_type,method_control)
endif
else
call mpp_error(NOTE,'set_tracer_method : Trying to set a method for non-existent tracer : '//trim(name))
endif
endif
end subroutine set_tracer_method
!
function error_handler(routine, err_msg_local, err_msg)
logical :: error_handler
character(len=*), intent(in) :: routine, err_msg_local
character(len=*), intent(out), optional :: err_msg
if(present(err_msg)) then
err_msg = err_msg_local
error_handler = .true.
else
call mpp_error(FATAL,trim(routine)//': '//trim(err_msg_local))
endif
end function error_handler
end module tracer_manager_mod