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
  public :: log_nml
 
  !-----------------------------------------------------------------------------
  !
  !++ 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
  integer, public            :: log_fid_nml
 
  !-----------------------------------------------------------------------------
  !
  !++ Private variables
  !
  integer, private :: log_ilevel = log_info
 
  logical, private :: log_master
#if defined(PGI) || defined(SX)
  logical, public :: log_master_nml
#else
  logical, private :: log_master_nml
#endif
  logical, private :: log_opened     = .false.
 
contains
 
  subroutine loginit( &
       fid_conf,  & ! (in)
       fid_log,   & ! (in) optional
       master,    & ! (in) optional
       fid_nml,   & ! (in) optional
       master_nml & ! (in) optional
       )
    implicit none
    integer, intent(in) :: fid_conf
    integer, intent(in), optional :: fid_log
    logical, intent(in), optional :: master
    integer, intent(in), optional :: fid_nml
    logical, intent(in), optional :: master_nml
 
    character(len=5)   :: log_level = 'I'
    character(len=100) :: log_file  = "LOG_"
 
    integer :: ierr
 
    namelist / param_dc_log / &
         log_level, &
         log_file
 
    character(len=LOG_LMSG) :: message
  !-----------------------------------------------------------------------------
 
    log_fid = stdout
    log_fid_nml = stdout
    log_master = .true.
 
    if ( present(master)     ) log_master     = master
    log_master_nml = log_master
    if ( present(master_nml) ) log_master_nml = master_nml
 
    call date_and_time(log_file(4:11), log_file(12:21))
 
    !--- read PARAM
    if ( fid_conf > 0 ) then
       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
    end if
 
    if ( present(fid_log) ) then
       log_fid  = fid_log
       log_file = ''
    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
 
    log_fid_nml = log_fid
    if ( present(fid_nml) ) then
       log_fid_nml = fid_nml
    end if
 
#if defined(PGI) || defined(SX)
    if ( log_master_nml ) write(log_fid_nml,nml=param_dc_log)
#else
    write(message,nml=param_dc_log)
    call log_nml('I',message)
#endif
 
    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
 
  subroutine log_nml( &
       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_nml(message)
       write(stderr,*) trim(message)
       call abort
    case ('W', 'w')
       if ( log_ilevel >= log_warn ) call logput_nml(message)
    case ('I', 'i')
       if ( log_ilevel >= log_info ) call logput_nml(message)
    case ('D', 'd')
       if ( log_ilevel >= log_debug ) call logput_nml(message)
    case default
       write(stderr,*) 'BUG: wrong log level'
       call abort
    end select
 
    return
  end subroutine log_nml
 
!  private
  subroutine logput_nml( &
       message & ! (in)
       )
    character(len=*) :: message
 
    if ( log_master_nml ) write(log_fid_nml, *) trim(message)
 
    return
  end subroutine logput_nml
 
end module dc_log