pflogger_stub.F90 Source File


This file depends on

sourcefile~~pflogger_stub.f90~~EfferentGraph sourcefile~pflogger_stub.f90 pflogger_stub.F90 sourcefile~pfl_keywordenforcer.f90 PFL_KeywordEnforcer.F90 sourcefile~pflogger_stub.f90->sourcefile~pfl_keywordenforcer.f90 sourcefile~wraparray.f90 WrapArray.F90 sourcefile~pflogger_stub.f90->sourcefile~wraparray.f90

Files dependent on this one

sourcefile~~pflogger_stub.f90~~AfferentGraph sourcefile~pflogger_stub.f90 pflogger_stub.F90 sourcefile~applicationsupport.f90 ApplicationSupport.F90 sourcefile~applicationsupport.f90->sourcefile~pflogger_stub.f90 sourcefile~basecomponent.f90 BaseComponent.F90 sourcefile~basecomponent.f90->sourcefile~pflogger_stub.f90 sourcefile~extdatagridcompmod.f90 ExtDataGridCompMod.F90 sourcefile~extdatagridcompmod.f90->sourcefile~pflogger_stub.f90 sourcefile~extdatagridcompng.f90 ExtDataGridCompNG.F90 sourcefile~extdatagridcompng.f90->sourcefile~pflogger_stub.f90 sourcefile~extdatalgr.f90 ExtDataLgr.F90 sourcefile~extdatalgr.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_cap.f90 MAPL_Cap.F90 sourcefile~mapl_cap.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_capgridcomp.f90 MAPL_CapGridComp.F90 sourcefile~mapl_capgridcomp.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_epochswathmod.f90 MAPL_EpochSwathMod.F90 sourcefile~mapl_epochswathmod.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_generic.f90 MAPL_Generic.F90 sourcefile~mapl_generic.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_geosatmaskmod.f90 MAPL_GeosatMaskMod.F90 sourcefile~mapl_geosatmaskmod.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_geosatmaskmod_smod.f90 MAPL_GeosatMaskMod_smod.F90 sourcefile~mapl_geosatmaskmod_smod.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_historygridcomp.f90 MAPL_HistoryGridComp.F90 sourcefile~mapl_historygridcomp.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_initialize.f90 MAPL_Initialize.F90 sourcefile~mapl_initialize.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_nuopcwrappermod.f90 MAPL_NUOPCWrapperMod.F90 sourcefile~mapl_nuopcwrappermod.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_obsutil.f90 MAPL_ObsUtil.F90 sourcefile~mapl_obsutil.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_stationsamplermod.f90 MAPL_StationSamplerMod.F90 sourcefile~mapl_stationsamplermod.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_sun_uc.f90 MAPL_sun_uc.F90 sourcefile~mapl_sun_uc.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_swathgridfactory.f90 MAPL_SwathGridFactory.F90 sourcefile~mapl_swathgridfactory.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_trajectorymod_smod.f90 MAPL_TrajectoryMod_smod.F90 sourcefile~mapl_trajectorymod_smod.f90->sourcefile~pflogger_stub.f90 sourcefile~maplcomponent.f90 MaplComponent.F90 sourcefile~maplcomponent.f90->sourcefile~pflogger_stub.f90 sourcefile~maplgenericcomponent.f90 MaplGenericComponent.F90 sourcefile~maplgenericcomponent.f90->sourcefile~pflogger_stub.f90 sourcefile~maplgrid.f90 MaplGrid.F90 sourcefile~maplgrid.f90->sourcefile~pflogger_stub.f90 sourcefile~multigroupserver.f90 MultiGroupServer.F90 sourcefile~multigroupserver.f90->sourcefile~pflogger_stub.f90 sourcefile~pfio_ctest_io.f90 pfio_ctest_io.F90 sourcefile~pfio_ctest_io.f90->sourcefile~pflogger_stub.f90 sourcefile~pfio_performance.f90 pfio_performance.F90 sourcefile~pfio_performance.f90->sourcefile~pflogger_stub.f90 sourcefile~shmem_implementation.f90 Shmem_implementation.F90 sourcefile~shmem_implementation.f90->sourcefile~pflogger_stub.f90 sourcefile~simulationtime.f90 SimulationTime.F90 sourcefile~simulationtime.f90->sourcefile~pflogger_stub.f90 sourcefile~statespecification.f90 StateSpecification.F90 sourcefile~statespecification.f90->sourcefile~pflogger_stub.f90 sourcefile~varconn.f90 VarConn.F90 sourcefile~varconn.f90->sourcefile~pflogger_stub.f90 sourcefile~varspec.f90 VarSpec.F90 sourcefile~varspec.f90->sourcefile~pflogger_stub.f90 sourcefile~varspecmiscmod.f90 VarSpecMiscMod.F90 sourcefile~varspecmiscmod.f90->sourcefile~pflogger_stub.f90

Source Code

#include "MAPL_ErrLog.h"
#define _SUCCESS 0
#ifdef _RETURN
#undef _RETURN
#endif
#define _RETURN(status) if(present(rc))rc=status; return

module PFL_SeverityLevels
   implicit none
   public :: NOTSET
   public :: DEBUG
   public :: INFO
   public :: WARNING
   public :: ERROR
   public :: CRITICAL

   enum, bind(c)
      enumerator :: &
           & NOTSET   =  0, &
           & DEBUG    = 10, &
           & INFO     = 20, &
           & WARNING  = 30, &
           & ERROR    = 40, &
           & CRITICAL = 50
   end enum

end module PFL_SeverityLevels

module PFL_Logger
   use PFL_SeverityLevels, only: NOTSET
   use PFL_SeverityLevels, only: DEBUG_LEVEL => DEBUG
   use PFL_SeverityLevels, only: INFO_LEVEL => INFO
   use PFL_SeverityLevels, only: WARNING_LEVEL => WARNING
   use PFL_SeverityLevels, only: ERROR_LEVEL => ERROR
   use PFL_SeverityLevels, only: CRITICAL_LEVEL => critical
   use gFTL_StringUnlimitedMap
   use PFL_KeywordEnforcerMod
   implicit none
   private

   public :: Logger

   type :: Logger
   contains
      procedure :: debug
      procedure :: info
      procedure :: warning
      procedure :: error
      procedure :: critical
      procedure :: free
      procedure :: isEnabledFor
   end type Logger

#define ARG_LIST arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9

contains

   subroutine free(this)
      class (Logger), intent(inout) :: this
      _UNUSED_DUMMY(this)
   end subroutine free

   subroutine debug(this, message, ARG_LIST, unusable, extra, line, file, rc)
      class (Logger), target, intent(inout) :: this
      character(len=*), intent(in) :: message
      include 'recordOptArgs.inc'
      class (KeywordEnforcer), optional, intent(in) :: unusable
      type (StringUnlimitedMap), optional, target, intent(in) :: extra
      integer, optional, intent(in) :: line
      character(*), optional, intent(in) :: file
      integer, optional, intent(out) :: rc

      _UNUSED_DUMMY(this)
      _UNUSED_DUMMY(message)
      _UNUSED_DUMMY(arg1)
      _UNUSED_DUMMY(arg2)
      _UNUSED_DUMMY(arg3)
      _UNUSED_DUMMY(arg4)
      _UNUSED_DUMMY(arg5)
      _UNUSED_DUMMY(arg6)
      _UNUSED_DUMMY(arg7)
      _UNUSED_DUMMY(arg8)
      _UNUSED_DUMMY(arg9)
      _UNUSED_DUMMY(unusable)
      _UNUSED_DUMMY(extra)
      _UNUSED_DUMMY(line)
      _UNUSED_DUMMY(file)

      _RETURN(_SUCCESS)
   end subroutine debug

   subroutine info(this, message, ARG_LIST, unusable, extra, line, file, rc)
      class (Logger), target, intent(inout) :: this
      character(len=*), intent(in) :: message
      include 'recordOptArgs.inc'
      class (KeywordEnforcer), optional, intent(in) :: unusable
      type (StringUnlimitedMap), optional, target, intent(in) :: extra
      integer, optional, intent(in) :: line
      character(*), optional, intent(in) :: file
      integer, optional, intent(out) :: rc

      _UNUSED_DUMMY(this)
      _UNUSED_DUMMY(message)
      _UNUSED_DUMMY(arg1)
      _UNUSED_DUMMY(arg2)
      _UNUSED_DUMMY(arg3)
      _UNUSED_DUMMY(arg4)
      _UNUSED_DUMMY(arg5)
      _UNUSED_DUMMY(arg6)
      _UNUSED_DUMMY(arg7)
      _UNUSED_DUMMY(arg8)
      _UNUSED_DUMMY(arg9)
      _UNUSED_DUMMY(unusable)
      _UNUSED_DUMMY(extra)
      _UNUSED_DUMMY(line)
      _UNUSED_DUMMY(file)

      _RETURN(_SUCCESS)
   end subroutine info

   subroutine warning(this, message, ARG_LIST, unusable, extra, line, file, rc)
      class (Logger), target, intent(inout) :: this
      character(len=*), intent(in) :: message
      include 'recordOptArgs.inc'
      class (KeywordEnforcer), optional, intent(in) :: unusable
      type (StringUnlimitedMap), optional, target, intent(in) :: extra
      integer, optional, intent(in) :: line
      character(*), optional, intent(in) :: file
      integer, optional, intent(out) :: rc

      _UNUSED_DUMMY(this)
      _UNUSED_DUMMY(message)
      _UNUSED_DUMMY(arg1)
      _UNUSED_DUMMY(arg2)
      _UNUSED_DUMMY(arg3)
      _UNUSED_DUMMY(arg4)
      _UNUSED_DUMMY(arg5)
      _UNUSED_DUMMY(arg6)
      _UNUSED_DUMMY(arg7)
      _UNUSED_DUMMY(arg8)
      _UNUSED_DUMMY(arg9)
      _UNUSED_DUMMY(unusable)
      _UNUSED_DUMMY(extra)
      _UNUSED_DUMMY(line)
      _UNUSED_DUMMY(file)

      _RETURN(_SUCCESS)
   end subroutine warning

   subroutine error(this, message, ARG_LIST, unusable, extra, line, file, rc)
      ! Log message with the integer severity 'DEBUG'.
      class (Logger), target, intent(inout) :: this
      character(len=*), intent(in) :: message
      include 'recordOptArgs.inc'
      class (KeywordEnforcer), optional, intent(in) :: unusable
      type (StringUnlimitedMap), optional, target, intent(in) :: extra
      integer, optional, intent(in) :: line
      character(*), optional, intent(in) :: file
      integer, optional, intent(out) :: rc

      _UNUSED_DUMMY(this)
      _UNUSED_DUMMY(message)
      _UNUSED_DUMMY(arg1)
      _UNUSED_DUMMY(arg2)
      _UNUSED_DUMMY(arg3)
      _UNUSED_DUMMY(arg4)
      _UNUSED_DUMMY(arg5)
      _UNUSED_DUMMY(arg6)
      _UNUSED_DUMMY(arg7)
      _UNUSED_DUMMY(arg8)
      _UNUSED_DUMMY(arg9)
      _UNUSED_DUMMY(unusable)
      _UNUSED_DUMMY(extra)
      _UNUSED_DUMMY(line)
      _UNUSED_DUMMY(file)

      _RETURN(_SUCCESS)
   end subroutine error

   subroutine critical(this, message, ARG_LIST, unusable, extra, line, file, rc)
      class (Logger), target, intent(inout) :: this
      character(len=*), intent(in) :: message
      include 'recordOptArgs.inc'
      class (KeywordEnforcer), optional, intent(in) :: unusable
      type (StringUnlimitedMap), optional, target, intent(in) :: extra
      integer, optional, intent(in) :: line
      character(*), optional, intent(in) :: file
      integer, optional, intent(out) :: rc

      _UNUSED_DUMMY(this)
      _UNUSED_DUMMY(message)
      _UNUSED_DUMMY(arg1)
      _UNUSED_DUMMY(arg2)
      _UNUSED_DUMMY(arg3)
      _UNUSED_DUMMY(arg4)
      _UNUSED_DUMMY(arg5)
      _UNUSED_DUMMY(arg6)
      _UNUSED_DUMMY(arg7)
      _UNUSED_DUMMY(arg8)
      _UNUSED_DUMMY(arg9)
      _UNUSED_DUMMY(unusable)
      _UNUSED_DUMMY(extra)
      _UNUSED_DUMMY(line)
      _UNUSED_DUMMY(file)

      _RETURN(_SUCCESS)
   end subroutine critical

   logical function isEnabledFor(this, level)
      class (Logger), intent(in) :: this
      integer, intent(in) :: level
      isEnabledFor = .false.
   end function isEnabledFor

end module PFL_Logger

module PFL_LoggerManager
   use PFL_Logger, only: Logger
   implicit none
   private

   public :: logging ! singleton instance

   type :: LoggerManager
      private
      type(Logger) :: log_
   contains
      procedure :: get_logger_name
      procedure :: get_logger_root
      generic :: get_logger => get_logger_name
      generic :: get_logger => get_logger_root
      procedure :: free
   end type LoggerManager

   type (LoggerManager), target, save :: logging

contains

   function get_logger_root(this, rc) result(lgr)
      class (Logger), pointer :: lgr
      class (LoggerManager), target, intent(inout) :: this
      integer, optional, intent(out) :: rc
      lgr => this%log_
      _RETURN(_SUCCESS)
   end function get_logger_root

   function get_logger_name(this, name, rc) result(lgr)
      class (Logger), pointer :: lgr
      class (LoggerManager), target, intent(inout) :: this
      character(len=*), intent(in) :: name
      integer, optional, intent(out) :: rc
      _UNUSED_DUMMY(name)
      lgr => this%log_
      _RETURN(_SUCCESS)
   end function get_logger_name

   subroutine free(this)
      class(LoggerManager), intent(inout) :: this
      _UNUSED_DUMMY(this)
   end subroutine free

end module PFL_LoggerManager

module pflogger
   use PFL_SeverityLevels
   use PFL_Logger
   use PFL_LoggerManager
   use PFL_WrapArray
   use PFL_KeywordEnforcerMod
   implicit none
   private

   public :: initialize
   public :: finalize

   public :: logging
   public :: Logger
   public :: WrapArray

   public :: NOTSET
   public :: DEBUG
   public :: INFO
   public :: WARNING
   public :: ERROR
   public :: CRITICAL

contains
   subroutine initialize(unusable, comm, logging_config, logger_name, rc)
      class (KeywordEnforcer), optional, intent(in) :: unusable
      integer, optional, intent(in) :: comm
      character(len=*), optional,intent(in) :: logging_config
      character(len=*), optional,intent(in) :: logger_name
      integer, optional, intent(out) :: rc
      _UNUSED_DUMMY(unusable)
      _UNUSED_DUMMY(comm)
      _UNUSED_DUMMY(logging_config)
      _UNUSED_DUMMY(logger_name)
      _RETURN(_SUCCESS)
   end subroutine initialize

   subroutine finalize()
   end subroutine finalize

end module pflogger