tracer_manager.F90

!***********************************************************************
!*                             Apache License 2.0
!*
!* This file is part of the GFDL Flexible Modeling System (FMS).
!*
!* Licensed under the Apache License, Version 2.0 (the "License");
!* you may not use this file except in compliance with the License.
!* You may obtain a copy of the License at
!*
!*     http://www.apache.org/licenses/LICENSE-2.0
!*
!* FMS is distributed in the hope that it will be useful, but WITHOUT
!* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied;
!* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
!* PARTICULAR PURPOSE. See the License for the specific language
!* governing permissions and limitations under the License.
!***********************************************************************
!> @defgroup tracer_manager_mod tracer_manager_mod
!> @ingroup tracer_manager
!> @brief 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.
!!
!> @author William Cooke
!!
!> 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.
 
module tracer_manager_mod
 
!----------------------------------------------------------------------
 
use           mpp_mod, only : mpp_error,          &
                              mpp_pe,             &
                              mpp_root_pe,        &
                              fatal,              &
                              warning,            &
                              note,               &
                              stdlog
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
use platform_mod, only      : r4_kind,            &
                              r8_kind
 
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,   &
        set_tracer_method
 
!> @brief 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.
!!
!! @param model A integer parameter to identify which model is being used
!! @param name The name of the tracer (as assigned in the field table).
!! @param indices An array indices. When present, the returned index will limit the search for the
!! tracer to thos tracers whose indices are among 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 @ref get_tracer_indices returns these subsets)
!! @param verbose Optional flag for debugging
!! @param[out] index Holds the returned index if given
!! @returns The integer function returns the index of the tracer named "name". If no tracer by that
!!  name exists then the returned value is NO_TRACER. The logical function returns false if no
!!  tracer by the given name exists and true otherwise, and stores the returned value in index.
!!
!! <br>Example usage:
!! @code{.F90}
!!     integer:
!!       index = get_tracer_index(model, name,        indices, verbose)
!!     logical:
!!       if ( get_tracer_index(model, name, index, indices, verbose) ) then
!! @endcode
!> @ingroup tracer_manager_mod
interface get_tracer_index
  module procedure get_tracer_index_integer, get_tracer_index_logical
end interface
 
interface set_tracer_profile
   module procedure set_tracer_profile_r4
   module procedure set_tracer_profile_r8
end interface set_tracer_profile
 
!> Private type to hold metadata for a tracer
!> @ingroup tracer_manager_mod
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
 
!> Private type to holds string data for a tracer
!> @ingroup tracer_manager_mod
type, private ::  tracer_name_type
   character(len=32)  :: model_name, tracer_name, tracer_units
   character(len=128) :: tracer_longname
end type tracer_name_type
 
!> Private type to represent named instances
!> @ingroup tracer_manager_mod
type, private :: inst_type
   character(len=128) :: name
   integer            :: instances
end type inst_type
 
!> @addtogroup tracer_manager_mod
!> @{
 
integer            :: num_tracer_fields = 0
integer, parameter :: MAX_TRACER_FIELDS = 250
integer, parameter :: MAX_TRACER_METHOD = 20
integer, parameter :: NO_TRACER         = 1-huge(1)
integer, parameter :: NOTRACER          = -huge(1)
 
type(tracer_type), save  :: tracers(MAX_TRACER_FIELDS)
type(inst_type)  , save  :: instantiations(MAX_TRACER_FIELDS)
 
integer :: total_tracers(NUM_MODELS), prog_tracers(NUM_MODELS), diag_tracers(NUM_MODELS)
logical :: model_registered(NUM_MODELS) = .false.
 
! Include variable "version" to be written to log file.
#include<file_version.h>
 
logical            :: module_is_initialized = .false.
 
logical            :: verbose_local
integer            :: TRACER_ARRAY(NUM_MODELS,MAX_TRACER_FIELDS)
 
contains
 
!#######################################################################
 
!> @brief Not necessary to call, only needed for backward compatability.
!!
!> Writes version to logfile and sets init flag for this module
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 ("TRACER_MANAGER_MOD", version)
  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
 
!> @brief Read in 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
 
!   <ERROR MSG="invalid model type" STATUS="FATAL">
!     The index for the model type is invalid.
!   </ERROR>
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)
 
!   <ERROR MSG="No tracers are available to be registered." STATUS="NOTE">
!      No tracers are available to be registered. This means that the field
!      table does not exist or is empty.
!   </ERROR>
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
!   <ERROR MSG="MAX_TRACER_FIELDS exceeded" STATUS="FATAL">
!     The maximum number of tracer fields has been exceeded.
!   </ERROR>
         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
 
!#######################################################################
 
!> @brief Not necessary to call, only needed for backward compatability.
!!
!> Returns the total number of valid, prognostic and diagnostic tracers.
subroutine register_tracers(model, num_tracers, num_prog, num_diag, num_family)
integer, intent(in) :: model !< A parameter to identify which model is being used.
integer, intent(out) :: num_tracers !< The total number of valid tracers within the component model.
integer, intent(out) :: num_prog !< The number of prognostic tracers within the component model.
integer, intent(out) :: num_diag !< The number of diagnostic tracers within the component model.
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
 
!#######################################################################
 
!> @brief 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
subroutine get_number_tracers(model, num_tracers, num_prog, num_diag, num_family)
 
integer,  intent(in) :: model !< A parameter to identify which model is being used
integer, intent(out), optional :: num_tracers !< The total number of valid tracers within
                                              !! the component model
integer, intent(out), optional :: num_prog !< The number of prognostic tracers within the
                                           !! component model.
integer, intent(out), optional :: num_diag !< The number of diagnostic tracers within the
                                           !! component model
integer, intent(out), optional :: num_family
 
if(.not.module_is_initialized) call tracer_manager_init
 
!   <ERROR MSG="Model number is invalid." STATUS="FATAL">
!     The index of the component model is invalid.
!   </ERROR>
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
 
!> @brief 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.
!> @param model A parameter to identify which model is being used.
!> @param ind An array containing the tracer manager defined indices for
!! all the tracers within the component model.
!> @param prog_ind An array containing the tracer manager defined indices for
!! the prognostic tracers within the component model.
!> @param diag_ind 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
!   <ERROR MSG="index array size too small in get_tracer_indices" STATUS="FATAL">
!     The global index array is too small and cannot contain all the tracer numbers.
!   </ERROR>
         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
!   <ERROR MSG="prognostic array size too small in get_tracer_indices" STATUS="FATAL">
!     The prognostic index array is too small and cannot contain all the tracer numbers.
!   </ERROR>
         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
!   <ERROR MSG="diagnostic array size too small in get_tracer_indices" STATUS="FATAL">
!     The diagnostic index array is too small and cannot contain all the tracer numbers.
!   </ERROR>
         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 NAME= "get_tracer_index">
!   <OVERVIEW>
!     Function which returns the number assigned to the tracer name.
!   </OVERVIEW>
!   <DESCRIPTION>
!     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.
!   </DESCRIPTION>
!   <TEMPLATE>
!     integer: index = get_tracer_index(model, name,        indices, verbose)
!     logical:    if ( get_tracer_index(model, name, index, indices, verbose) ) then
!   </TEMPLATE>
!   <IN NAME="model" TYPE="integer">
!     A parameter to identify which model is being used.
!   </IN>
!   <IN NAME="name" TYPE="character">
!     The name of the tracer (as assigned in the field table).
!   </IN>
!   <IN NAME="indices" TYPE="integer, optional" DIM="(:)">
!     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)
!   </IN>
!   <IN NAME="verbose" TYPE="logical, optional">
!     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.
!   </IN>
!   <OUT NAME="get_tracer_index" TYPE="integer">
!     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.
!   </OUT>
 
!> @brief Function which returns the number assigned to the tracer name.
!!
!> See @ref get_tracer_index Interface for more information.
!! @returns index of given tracer name if present, otherwise returns NO_TRACER
function get_tracer_index_integer(model, name, indices, verbose)
 
integer, intent(in)                         :: model !< Parameter to identify which model is used
character(len=*), intent(in)                :: name !< name of the tracer
integer, intent(in), dimension(:), optional :: indices !< An array of indices, limits search to tracers
                                                       !! whose indices are within the array.
logical, intent(in), optional               :: verbose !< debug flag
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
! <ERROR MSG="tracer with this name not found: X" STATUS="NOTE">
  if (get_tracer_index_integer == no_tracer ) then
    call mpp_error(note,'get_tracer_index : tracer with this name not found: '//trim(name))
  endif
! </ERROR>
endif
 
return
 
end function get_tracer_index_integer
 
!#######################################################################
!> @brief Checks if tracer is present, and returns it's position in index
function get_tracer_index_logical(model, name, index, indices, verbose)
 
integer, intent(in)                         :: model !< Parameter for which model is used
character(len=*), intent(in)                :: name !< name of given drifter
integer, intent(out)                        :: index !< returned drifter index
integer, intent(in), dimension(:), optional :: indices !< optional list of indices to limit results to
logical, intent(in), optional               :: verbose !< debug flag
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
 
!#######################################################################
 
!> @brief Uninitializes module and writes exit to logfile.
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
 
!#######################################################################
 
!> @brief Routine to print out the components of the tracer.
!! This is useful for informational purposes.
!! Used in get_tracer_meta_data.
subroutine print_tracer_info(model,n)
integer, intent(in) :: model
integer, intent(in) :: n !< index of the tracer that is being printed
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
 
end subroutine print_tracer_info
 
!#######################################################################
 
!> @brief Routine to find the names associated with a tracer number.
!!
!> This routine can return the name, long name and units associated
!! with a tracer.
subroutine get_tracer_names(model,n,name,longname, units, err_msg)
 
integer,          intent(in)  :: model !< A parameter representing component model in use
integer,          intent(in)  :: n !< Tracer number
character (len=*),intent(out) :: name !< Field name associate with tracer number
character (len=*), intent(out), optional :: longname !< Long name associated with tracer number
character (len=*), intent(out), optional :: units !< Tracer associated units
character (len=*), intent(out), optional :: 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
 
!#######################################################################
 
!> @brief 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.
function get_tracer_name(model,n,name,longname, units, err_msg)
 
integer,          intent(in)  :: model !< A parameter representing component model in use
integer,          intent(in)  :: n !< Tracer number
character (len=*),intent(out) :: name !< Field name associate with tracer number
character (len=*), intent(out), optional :: longname !< Long name associated with tracer number
character (len=*), intent(out), optional :: units !< Tracer associated units
character (len=*), intent(out), optional :: err_msg !< 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.
 
logical :: get_tracer_name
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
 
!#######################################################################
 
!> @brief 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.
!!
!! @returns A logical flag set TRUE if the tracer is prognostic.
function check_if_prognostic(model, n, err_msg)
 
integer, intent(in) :: model !< Parameter representing component model in use
integer, intent(in) :: n !< Tracer number
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
 
!#######################################################################
 
!> @brief A function to query the schemes 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
!!
!! @returns 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. the name and control strings are provided by that routine.
!!
!!  @note 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)
 
 character(len=*), intent(in)            :: method_type !< The requested method
 integer         , intent(in)            :: model !< Model the function is being called from
 integer         , intent(in)            :: n !< Tracer number
 character(len=*), intent(out)           :: name !< A string containing the modified name to be used
                                         !! with method_type. i.e. "2nd_order" might be the default
                                         !! advection. One could use "4th_order" to modify behaviour
 character(len=*), intent(out), optional :: control !< A string containing the modified parameters
                                         !! that are associated with method_type and name.
 character(len=*), intent(out), optional :: err_msg
 logical                                 :: query_method
 
 integer :: n1
 character(len=256) :: list_name
 character(len=1024):: control_tr
 character(len=16)  :: chn,chn1
 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) ) then
    if ( len_trim(control_tr)>len(control) ) then
       write(chn,*)len(control)
       write(chn1,*)len_trim(control_tr)
       if(error_handler('query_method', &
           ' Output string length ('//trim(adjustl(chn)) &
               // ') is not enough to return all "control" parameters ("'//trim(control_tr) &
               // '", length='//trim(adjustl(chn1))//')', &
           err_msg)) return
    endif
    control = trim(control_tr)
 endif
 
 end function query_method
 
!> @brief 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.
subroutine set_tracer_atts(model, name, longname, units)
 
integer, intent(in)                    :: model !< A parameter representing component model in use
character(len=*), intent(in)           :: name !< Tracer name
character(len=*), intent(in), optional :: longname !< Long name of the tracer
character(len=*), intent(in), optional :: units !< Units for the tracer
 
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
 
!> @brief A subroutine to allow the user to set some tracer specific methods.
subroutine set_tracer_method(model, name, method_type, method_name, method_control)
 
integer, intent(in)                    :: model !< A parameter representing component model in use
character(len=*), intent(in)           :: name !< Tracer name
character(len=*), intent(in)           :: method_type !< type of method to be set
character(len=*), intent(in)           :: method_name !< name of method to be set
character(len=*), intent(in)           :: method_control !< control parameters of the given method
 
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
 
#include "tracer_manager_r4.fh"
#include "tracer_manager_r8.fh"
 
end module tracer_manager_mod
!> @}
! close documentation grouping