dc_log.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module dc_log
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: loginit
  public :: logfinalize
  public :: log

  !-----------------------------------------------------------------------------
  !
  !++ Private parameters
  !
  integer, parameter :: log_none  = 0
  integer, parameter :: log_error = 1
  integer, parameter :: log_warn  = 2
  integer, parameter :: log_info  = 3
  integer, parameter :: log_debug = 4

  integer, parameter :: stderr = 0
  integer, parameter :: stdout = 6

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  integer, public, parameter :: log_lmsg = 4096
  integer, public            :: log_fid  = stdout

  !-----------------------------------------------------------------------------
  !
  !++ Private variables
  !
  integer, private :: log_ilevel = log_info

  logical, private :: log_master = .true.
  logical, private :: log_opened = .false.

contains

  subroutine loginit( &
       fid_conf, & ! (in)
       fid_log,  & ! (in) optional
       master    & ! (in) optional
       )
    implicit none
    integer, intent(in) :: fid_conf
    integer, intent(in), optional :: fid_log
    logical, intent(in), optional :: master

    character(len=5)   :: LOG_LEVEL = 'I'
    character(len=100) :: LOG_FILE = "LOG_"

    integer :: ierr

    namelist / param_dc_log / &
         log_level, &
         log_file
  !-----------------------------------------------------------------------------

    if ( present(master) ) log_master = master

    call date_and_time(log_file(4:11), log_file(12:21))

    !--- read PARAM
    rewind(fid_conf)
    read(fid_conf,nml=param_dc_log,iostat=ierr)

    if ( ierr > 0 ) then
       call log('E', 'xxx Not appropriate names in namelist PARAM_DC_LOG. Check!')
    end if

    if ( present(fid_log) ) then
       log_fid = fid_log
    else
       open( log_fid,                & ! (out)
            file   = trim(log_file), & ! (in)
            form   = 'formatted',    & ! (in)
            iostat = ierr            ) ! (in)
       if ( ierr /= 0 ) then
          call log('E', 'xxx File open error! :' // trim(log_file))
       end if
       log_opened = .true.
    end if

    select case (trim(log_level))
    case ('E', 'e', 'ERROR', 'error')
       log_ilevel = log_error
    case ('W', 'w', 'WARN', 'warn')
       log_ilevel = log_warn
    case ('I', 'i', 'INFO', 'info')
       log_ilevel = log_info
    case ('D', 'd', 'DEBUG', 'debug')
       log_ilevel = log_debug
    case default
       call log('E', 'xxx LOG_LEVEL is invalid. Check!')
    end select
       
    return
  end subroutine loginit

  subroutine logfinalize

    if ( log_opened ) close(log_fid)
    log_opened = .false.

  end subroutine logfinalize

  subroutine log( &
       type,   & ! (in)
       message & ! (in)
       )
    implicit none
    character(len=*), intent(in) :: type
    character(len=*), intent(in) :: message

    select case (trim(type))
    case ('E', 'e')
       if ( log_ilevel >= log_error ) call logput(message)
       write(stderr,*) trim(message)
       call abort
    case ('W', 'w')
       if ( log_ilevel >= log_warn ) call logput(message)
    case ('I', 'i')
       if ( log_ilevel >= log_info ) call logput(message)
    case ('D', 'd')
       if ( log_ilevel >= log_debug ) call logput(message)
    case default
       write(stderr,*) 'BUG: wrong log level'
       call abort
    end select

    return
  end subroutine log

!  private
  subroutine logput( &
       message & ! (in)
       )
    character(len=*) :: message

    if ( log_master ) write(log_fid, *) trim(message)

    return
  end subroutine logput

end module dc_log