logfiles.F90

Go to the documentation of this file.

module logfiles
 
  use version_control, only  : swb_version, git_commit_hash_string,           &
                               git_branch_string, compile_date, compile_time, &
                               compilation_timestamp
  use iso_c_binding, only : c_bool, c_int
  use iso_fortran_env, only : output_unit
  implicit none
 
  private
 
  public :: logfile_t
 
  enum, bind(c)
    enumerator :: dt_year = 1, dt_month = 2, dt_day = 3, dt_diff_fm_utc = 4,          &
                  dt_hour = 5, dt_minutes = 6, dt_seconds = 7, dt_milliseconds = 8
  end enum
 
  public :: log_none, log_general, log_debug, log_all
 
  enum, bind(c)
    enumerator :: log_none = 0, log_general = 1, log_debug = 2, log_all = 3
  end enum
 
  type logfile_t
    character (len=:), allocatable  :: spathname
    character (len=:), allocatable  :: sfileprefix
    character (len=256)             :: sfilename(2)
    logical (c_bool)                :: lisopen(2)       = .false._c_bool
    integer (c_int)                 :: iunitnum(2)      = -999
    integer (c_int)                 :: istat(2)
    integer (c_int)                 :: iloglevel        = log_general
 
  contains
 
    procedure, private :: initialize_logfiles_sub
    generic            :: initialize => initialize_logfiles_sub
 
    procedure, private :: write_to_logfiles_sub
    generic            :: write => write_to_logfiles_sub
 
    procedure, private :: set_log_level_sub
    generic            :: set_loglevel => set_log_level_sub
 
    procedure, private :: set_screen_echo_sub
    generic            :: set_echo => set_screen_echo_sub
 
    procedure, private :: open_files_write_access_sub
    generic            :: open => open_files_write_access_sub
 
    procedure, private :: close_files_sub
    generic            :: close => close_files_sub
 
    procedure, private :: make_prefix_sub
    generic            :: make_prefix => make_prefix_sub
 
    procedure, private :: set_output_directory_name_sub
    generic            :: set_output_directory => set_output_directory_name_sub
 
  end type logfile_t
 
  type (logfile_t), public :: logs
 
  integer (c_int)                   :: current_log_level     = log_general
  logical (c_bool)                  :: current_log_echo      = .false._c_bool
  logical (c_bool), parameter       :: true = .true._c_bool
  character (len=:), allocatable    :: logfile_directory_name
 
contains
 
  subroutine set_output_directory_name_sub( this, sDirName )
 
    class(logfile_t)                           :: this
    character (len=*), intent(in)               :: sDirName
 
    logfile_directory_name = trim(sdirname)
 
  end subroutine set_output_directory_name_sub
 
!--------------------------------------------------------------------------------------------------
 
  subroutine set_log_level_sub( this, iLogLevel )
 
    class(logfile_t)                           :: this
    integer (c_int), intent(in)                 :: iLogLevel
 
    current_log_level = iloglevel
 
  end subroutine set_log_level_sub
 
!--------------------------------------------------------------------------------------------------
 
  subroutine set_screen_echo_sub( this, lEcho )
 
    class(logfile_t)                           :: this
    logical (c_bool), intent(in)                :: lEcho
 
    current_log_echo = lecho
 
  end subroutine set_screen_echo_sub
 
!--------------------------------------------------------------------------------------------------
 
  subroutine initialize_logfiles_sub(this, iLogLevel, sFilePrefix, lWrite_SWB_Info )
 
    class(logfile_t)                            :: this
    integer (c_int), intent(in), optional        :: iLogLevel
    character (len=*), intent(in), optional      :: sFilePrefix
    logical (c_bool), intent(in), optional       :: lWrite_SWB_Info
 
    ! [ LOCALS ]
    integer (c_int)    :: iLogLevel_l
    logical (c_bool)   :: lWrite_SWB_Info_l
 
    if ( present( lwrite_swb_info) ) then
      lwrite_swb_info_l = lwrite_swb_info
    else
      lwrite_swb_info_l = .true._c_bool
    endif
 
    if (present(iloglevel) ) then
      iloglevel_l = iloglevel
    else
      iloglevel_l = log_general
    endif
 
    if ( present( sfileprefix) ) then
      this%sFilePrefix = sfileprefix
    else
      call this%make_prefix()
    endif
 
    this%iLogLevel = iloglevel_l
    call this%open( lwrite_swb_info=lwrite_swb_info_l )
 
  end subroutine initialize_logfiles_sub
 
!--------------------------------------------------------------------------------------------------
 
  subroutine open_files_write_access_sub(this, lWrite_SWB_Info )
 
    class(logfile_t), intent(inout)             :: this
    logical (c_bool), intent(in), optional       :: lWrite_SWB_Info
 
    ! [ LOCALS ]
    integer (c_int) :: iIndex
    character (len=:), allocatable   :: sFilename
    character (len=:), allocatable   :: sDatetime
    character (len=12)               :: sDescriptor(2) = [ "         ", "_DEBUG   " ]
    logical (c_bool)                 :: lWrite_SWB_Info_l
 
    if ( present( lwrite_swb_info) ) then
      lwrite_swb_info_l = lwrite_swb_info
    else
      lwrite_swb_info_l = .true._c_bool
    endif
 
    if ( this%iLogLevel /= log_none ) then
 
      do iindex = 1, min(this%iLogLevel, 2)
 
        sfilename = trim(logfile_directory_name)//trim(this%sFilePrefix)//trim(sdescriptor(iindex))//".md"
 
        if (.not. this%lIsOpen(iindex) ) then
 
          open(newunit=this%iUnitNum(iindex), file=sfilename, iostat=this%iStat(iindex), action='WRITE', encoding='UTF-8')
          if (this%iStat(iindex) /= 0) then
            write(unit=output_unit, fmt="(a)") "Failed to open logfile "//'"'//trim(sfilename)//'".'
            stop
          endif
 
          if (this%iStat(iindex) == 0) this%lIsOpen(iindex) = .true._c_bool
 
          sdatetime = make_timestamp()
 
          if ( lwrite_swb_info_l ) then
 
            write(this%iUnitNum(iindex), fmt="(a)") "# USGS Soil Water Balance Code run log #"
            write(this%iUnitNum(iindex), fmt="(a,/)") repeat("-", 80)
            write(this%iUnitNum(iindex), fmt="(a,/)") "## Model run started on "//sdatetime//" ##"
            write(this%iUnitNum(iindex), fmt="(a)") "## SWB version "//swb_version//" compiled on "  &
              //compilation_timestamp//" ##"
            write(this%iUnitNum(iindex), fmt="(a,/)") "Git branch and commit hash: " &
              //trim( git_branch_string)//"  "//trim(git_commit_hash_string)
 
          endif
 
        else
 
          stop( "Failed to open file logfile." )
 
        endif
 
      enddo
 
    endif
 
 
  end subroutine open_files_write_access_sub
 
!--------------------------------------------------------------------------------------------------
 
  subroutine close_files_sub(this)
 
    class(logfile_t)    :: this
 
    ! [ LOCALS ]
    integer (c_int) :: iIndex
 
    do iindex = 1,2
 
      if (this%lIsOpen(iindex) ) then
 
        flush ( unit=this%iUnitNum(iindex) )
        close ( unit=this%iUnitNum(iindex) )
 
      endif
 
    enddo
 
  end subroutine close_files_sub
 
!--------------------------------------------------------------------------------------------------
 
  subroutine make_prefix_sub(this)
 
    class(logfile_t)     :: this
 
    ! [ LOCALS ]
    integer (c_int) :: iValues(8)
    character (len=2)    :: sHour
    character (len=2)    :: sMinutes
    character (len=2)    :: sSeconds
 
    character (len=2)    :: sDay
    character (len=2)    :: sMonth
    character (len=4)    :: sYear
 
    call date_and_time( values = ivalues )
 
    write(shour, fmt="(i0.2)") ivalues( dt_hour )
    write(sminutes, fmt="(i0.2)") ivalues( dt_minutes )
    write(sseconds, fmt="(i0.2)") ivalues( dt_seconds )
    write(smonth, fmt="(i0.2)") ivalues( dt_month )
    write(sday, fmt="(i0.2)") ivalues( dt_day )
    write(syear, fmt="(i0.4)") ivalues( dt_year )
 
    this%sFilePrefix = "SWB_LOGFILE__"//syear//smonth//sday//"_"  &
                                                   //shour//sminutes//sseconds
 
  end subroutine make_prefix_sub
 
!--------------------------------------------------------------------------------------------------
 
  subroutine write_to_logfiles_sub(this, sMessage, iTab, iLinesBefore,         &
                                   iLinesAfter, iLogLevel, lEcho )
 
    class(logfile_t)                            :: this
    character (len=*), intent(in)                :: sMessage
    integer (c_int), intent(in), optional        :: iTab
    integer (c_int), intent(in), optional        :: iLinesBefore
    integer (c_int), intent(in), optional        :: iLinesAfter
    integer (c_int), intent(in), optional        :: iLogLevel
    logical (c_bool), intent(in), optional       :: lEcho
 
    ! [ LOCALS ]
    integer (c_int)  :: iTab_l
    integer (c_int)  :: iLinesBefore_l
    integer (c_int)  :: iLinesAfter_l
 
    if (present(iloglevel) )   call this%set_loglevel( iloglevel )
    if (present(lecho) )       call this%set_echo( lecho )
 
    if (present(itab) ) then
      itab_l = itab
    else
      itab_l = 1
    endif
 
    if (present(ilinesbefore) ) then
      ilinesbefore_l = ilinesbefore
    else
      ilinesbefore_l = 0
    endif
 
    if (present(ilinesafter) ) then
      ilinesafter_l = ilinesafter
    else
      ilinesafter_l = 0
    endif
 
    if ( current_log_echo ) then
 
      call writemultiline(smessagetext=smessage, ilu=output_unit, &
        itab=itab_l, ilinesbefore=ilinesbefore_l, ilinesafter=ilinesafter_l )
 
    endif
 
    select case ( current_log_level )
 
      case ( log_general )
 
        if ( this%iLogLevel >= log_general ) &
          call writemultiline(smessagetext=smessage, ilu=this%iUnitNum( log_general ), &
            itab=itab_l, ilinesbefore=ilinesbefore_l, ilinesafter=ilinesafter_l )
 
      case ( log_debug )
 
        if ( this%iLogLevel >= log_debug ) &
          call writemultiline(smessagetext=smessage, ilu=this%iUnitNum( log_debug ), &
            itab=itab_l, ilinesbefore=ilinesbefore_l, ilinesafter=ilinesafter_l )
 
      case ( log_all )
 
        if ( this%iLogLevel >= log_general ) &
          call writemultiline(smessagetext=smessage, ilu=this%iUnitNum( log_general ), &
            itab=itab_l, ilinesbefore=ilinesbefore_l, ilinesafter=ilinesafter_l )
 
        if ( this%iLogLevel >= log_debug ) &
          call writemultiline(smessagetext=smessage, ilu=this%iUnitNum( log_debug ), &
            itab=itab_l, ilinesbefore=ilinesbefore_l, ilinesafter=ilinesafter_l )
 
      case default
 
    end select
 
  end subroutine write_to_logfiles_sub
 
!--------------------------------------------------------------------------------------------------
 
  !> Write multiple lines of output to Fortran logical unit
  !> @details Writes one or more lines of an input text string to a Fortran
  !> logical unit number. To output multiple lines, insert a tilde (~) at
  !> each point in the text string where a carriage return is desired.
  !> @param[in] sMessageText Character string that contains the message to be written.
  !> @param[in] iLU Integer value of the Fortran logical unit number to write to.
  subroutine writemultiline(sMessageText, iLU, iTab, iLinesBefore, iLinesAfter)
 
    ! [ ARGUMENTS ]
    character (len=*), intent(in)     :: sMessageText
    integer (c_int), intent(in)  :: iLU
    integer (c_int), intent(in)  :: iTab
    integer (c_int), intent(in)  :: iLinesBefore
    integer (c_int), intent(in)  :: iLinesAfter
 
 
    ! [ LOCALS ]
    character (len=len(sMessageText) ) :: sRecord
    character (len=256) :: sItem
    logical (c_bool) :: lFileOpen
    character (len=12) :: sFmt
    integer (c_int) :: iIndex
 
    inquire (unit=ilu, opened=lfileopen)
 
    srecord = trim(smessagetext)
 
    if (lfileopen) then
 
      if ( ilinesbefore > 0 ) then
        do iindex=1, ilinesbefore
          write(unit=ilu, fmt="(a,2x)" ) ""
        enddo
      endif
 
      do
 
        ! break up string with '~' as delimiter
        call split(srecord, sitem)
        write(sfmt, fmt="('(t',i0,' ,a)')") itab
        if(len_trim(sitem) == 0) exit
        write(unit=ilu,fmt=trim(sfmt) ) trim(sitem)//"  "
      enddo
 
      if ( ilinesafter > 0 ) then
        do iindex=1, ilinesafter
          write(unit=ilu,fmt="(a,2x)" ) ""
        enddo
      endif
 
      flush(ilu)
 
    endif
 
  end subroutine writemultiline
 
!--------------------------------------------------------------------------------------------------
 
  subroutine split(sText1, sText2)
 
    character (len=*), intent(inout)                     :: sText1
    character (len=*), intent(inout)                     :: sText2
 
    ! [ LOCALS ]
    character (len=1)    :: sDelimiter
    integer (c_int) :: iIndex
 
    sdelimiter = "~"
 
    stext1 = adjustl(stext1)
 
    iindex = scan( string = stext1, set = sdelimiter )
 
    if (iindex == 0) then
      ! no delimiter found; return string as was supplied originally
      stext2 = stext1
      stext1 = ""
    else
      ! delimiters were found; split and return the chunks of text
      stext2 = trim( stext1(1:iindex-1) )
      stext1 = trim( stext1(iindex + 1:) )
    endif
 
  end subroutine split
 
!--------------------------------------------------------------------------------------------------
 
  function dquote(sText1)    result(sText)
 
    character (len=*), intent(in)         :: stext1
    character (len=len_trim(sText1)+2)    :: stext
 
    stext = '"'//trim(stext1)//'"'
 
  end function dquote
 
!--------------------------------------------------------------------------------------------------
 
  function make_timestamp()    result(sDatetime)
 
    character (len=:), allocatable   :: sdatetime
 
    ! [ LOCALS ]
    integer (c_int) :: ivalues(8)
    character (len=2)    :: shour
    character (len=2)    :: sminutes
    character (len=2)    :: sseconds
 
    character (len=2)    :: sday
    character (len=2)    :: smonth
    character (len=4)    :: syear
    character (len=9)    :: smonthname
 
    character (len=9), parameter :: months(12) = &
      ["January  ", "February ", "March    ", "April    ", "May      ", "June     ", "July     ", &
       "August   ", "September", "October  ", "November ", "December "]
 
    call date_and_time( values = ivalues )
 
    write(shour, fmt="(i0.2)") ivalues( dt_hour )
    write(sminutes, fmt="(i0.2)") ivalues( dt_minutes )
    write(sseconds, fmt="(i0.2)") ivalues( dt_seconds )
    write(smonth, fmt="(i0.2)") ivalues( dt_month )
    write(sday, fmt="(i0.2)") ivalues( dt_day )
    write(syear, fmt="(i0.4)") ivalues( dt_year )
 
    smonthname = months( ivalues( dt_month ) )
 
    sdatetime = trim(smonthname)//" "//sday//" "//syear//" "//shour//":"//sminutes//":"//sseconds
 
  end function make_timestamp
 
end module logfiles