module marbl_logging

! ============
! Module Usage
! ============
!
! Assume a variable named StatusLog (as appears in the marbl_interface_class)
!
! -----------------------------------------------
! Use the following routines to write log entries
! -----------------------------------------------
!
! (1) StatusLog%log_noerror -- this stores a log message in StatusLog that does
!     not contain a fatal error
! (2) StatusLog%log_header -- this stores a log message in StatusLog that is
!     meant to be read as a section header; e.g. StatusLog%log_header('HEADER',...)
!     writes the following (including blank lines)
!
!     ------
!     HEADER
!     ------
!
! (3) StatusLog%log_error -- this stores a log message in StatusLog that DOES
!     contain a fatal error. It does this by setting StatusLog%labort_marbl =
!     .true.; when a call from the GCM to MARBL returns, it is important for the
!     GCM to check the value of StatusLog%labort_marbl and abort the run if an
!     error has been reported.
! (4) StatusLog%log_error_trace -- this stores a log message in StatusLog
!     detailing what subroutine was just called and where it was called from. It
!     is meant to provide more information when trying to trace the path through
!     the code that resulted in an error.
!
! -----------------------------------------------
! Pseudo-code for writing StatusLog in the driver
! -----------------------------------------------
!
!  type(marbl_status_log_entry_type), pointer :: LogEntry
!
!  ! Set pointer to first entry of the log
!  LogEntry => StatusLog%FullLog
!
!  do while (associated(LogEntry))
!    ! If running in parallel, you may want to check if you are the master
!    ! task or if LogEntry%lalltasks = .true.
!    write(stdout,*) trim(LogEntry%LogMessage)
!    LogEntry => LogEntry%next
!  end do
!
!  ! Erase contents of log now that they have been written out
!  call StatusLog%erase()
!
!  if (StatusLog%labort_marbl) then
!    [GCM abort call: "error found in MARBL"]
!  end if
!

  use marbl_kinds_mod, only : char_len

  implicit none
  private
  save

  integer, parameter, private :: marbl_log_len = 2*char_len

  !****************************************************************************

  type, public :: marbl_status_log_entry_type
    integer :: ElementInd = -1      ! ElementInd < 0 implies no location data
    logical :: lonly_master_writes  ! True => message should be written to stdout
                           !                  master task; False => all tasks
    character(len=marbl_log_len) :: LogMessage   ! Message text
    character(len=char_len)      :: CodeLocation ! Information on where log was written

    type(marbl_status_log_entry_type), pointer :: next
  end type marbl_status_log_entry_type

  !****************************************************************************

  ! Note: this data type is not in use at the moment, but it is included as an
  !       initial step towards allowing the user some control over what types
  !       of messages are added to the log. For example, if you do not want
  !       the contents of namelists written to the log, you would simply set
  !
  !       lLogNamelist = .false.
  !
  !       In the future we hope to be able to set these options via namelist,
  !       but for now lLogNamelist, lLogGeneral, lLogWarning, and lLogError are
  !       all set to .true. and can not be changed without modifying the source
  !       code in this file.
  type, private :: marbl_log_output_options_type
    logical :: labort_on_warning ! True => elevate Warnings to Errors
    logical :: lLogVerbose       ! Debugging output should be given Verbose label
    logical :: lLogNamelist      ! Write namelists to log?
    logical :: lLogGeneral       ! General diagnostic output
    logical :: lLogWarning       ! Warnings (can be elevated to errors via labort_on_warning)
    logical :: lLogError         ! Errors (will toggle labort_marbl whether log
                                 ! is written or not)
  contains
    procedure :: construct => marbl_output_options_constructor
  end type marbl_log_output_options_type

  !****************************************************************************

  type, public :: marbl_log_type
    logical, private :: lconstructed = .false. ! True => constructor was already called
    logical, public  :: labort_marbl = .false. ! True => driver should abort GCM
    logical, public  :: lwarning     = .false. ! True => warnings are present
    type(marbl_log_output_options_type) :: OutputOptions
    type(marbl_status_log_entry_type), pointer :: FullLog
    type(marbl_status_log_entry_type), pointer :: LastEntry
  contains
    procedure, public :: construct => marbl_log_constructor
    procedure, public :: log_header   => marbl_log_header
    procedure, public :: log_error    => marbl_log_error
    procedure, public :: log_warning  => marbl_log_warning
    procedure, public :: log_noerror  => marbl_log_noerror
    procedure, public :: log_error_trace => marbl_log_error_trace
    procedure, public :: log_warning_trace => marbl_log_warning_trace
    procedure, public :: erase => marbl_log_erase
    procedure, private :: append_to_log
  end type marbl_log_type

  !****************************************************************************

  public :: marbl_logging_add_diagnostics_error

contains

  !****************************************************************************

  subroutine marbl_output_options_constructor(this, labort_on_warning, LogVerbose, LogNamelist, &
                                              LogGeneral, LogWarning, LogError)

    class(marbl_log_output_options_type), intent(inout) :: this
    logical, intent(in), optional :: labort_on_warning, LogVerbose, LogNamelist
    logical, intent(in), optional :: LogGeneral, LogWarning, LogError

    if (present(labort_on_warning)) then
      this%labort_on_warning = labort_on_warning
    else
      this%labort_on_warning = .false.
    end if

    if (present(LogVerbose)) then
      this%lLogVerbose = LogVerbose
    else
      this%lLogVerbose = .false.
    end if

    if (present(LogNamelist)) then
      this%lLogNamelist = LogNamelist
    else
      this%lLogNamelist = .true.
    end if

    if (present(LogGeneral)) then
      this%lLogGeneral = LogGeneral
    else
      this%lLogGeneral = .true.
    end if

    if (present(LogWarning)) then
      this%lLogWarning = LogWarning
    else
      this%lLogWarning = .true.
    end if

    if (present(LogError)) then
      this%lLogError = LogError
    else
      this%lLogError = .true.
    end if

  end subroutine marbl_output_options_constructor

  !****************************************************************************

  subroutine marbl_log_constructor(this)

    class(marbl_log_type), intent(inout) :: this

    if (this%lconstructed) return
    this%lconstructed = .true.
    nullify(this%FullLog)
    nullify(this%LastEntry)
    call this%OutputOptions%construct()

  end subroutine marbl_log_constructor

  !****************************************************************************

  subroutine marbl_log_header(this, HeaderMsg, CodeLoc)

    class(marbl_log_type), intent(inout) :: this
    ! StatusMsg is the message to be printed in the log; it does not need to
    !    contain the name of the module or subroutine producing the log message
    ! CodeLoc is the name of the subroutine that is calling StatusLog%log_noerror
    character(len=*),      intent(in)    :: HeaderMsg, CodeLoc

    character(len=len_trim(HeaderMsg)) :: dashes
    integer :: n

    do n=1, len(dashes)
      dashes(n:n) = '-'
    end do
    call this%log_noerror('', CodeLoc)
    call this%log_noerror(dashes, CodeLoc)
    call this%log_noerror(HeaderMsg, CodeLoc)
    call this%log_noerror(dashes, CodeLoc)
    call this%log_noerror('', CodeLoc)

  end subroutine marbl_log_header

  !****************************************************************************

  subroutine marbl_log_error(this, ErrorMsg, CodeLoc, ElemInd)

    class(marbl_log_type), intent(inout) :: this
    ! ErrorMsg is the error message to be printed in the log; it does not need
    !     to contain the name of the module or subroutine triggering the error
    ! CodeLoc is the name of the subroutine that is calling StatusLog%log_error
    character(len=*),      intent(in)    :: ErrorMsg, CodeLoc
    integer, optional,     intent(in)    :: ElemInd

    character(len=marbl_log_len) :: ErrorMsg_loc   ! Message text

    this%labort_marbl = .true.

    ! Only allocate memory and add entry if we want to log full namelist!
    if (.not.this%OutputOptions%lLogError) then
      return
    end if

    write(ErrorMsg_loc, "(4A)") "MARBL ERROR (", trim(CodeLoc), "): ", &
                                        trim(ErrorMsg)

    call this%append_to_log(ErrorMsg_loc, CodeLoc, ElemInd, lonly_master_writes=.false.)

  end subroutine marbl_log_error

  !****************************************************************************

  subroutine marbl_log_warning(this, WarningMsg, CodeLoc, ElemInd)

    class(marbl_log_type), intent(inout) :: this
    ! WarningMsg is the message to be printed in the log; it does not need to
    !    contain the name of the module or subroutine producing the log message
    ! CodeLoc is the name of the subroutine that is calling StatusLog%log_warning
    character(len=*),      intent(in)    :: WarningMsg, CodeLoc
    integer, optional,     intent(in)    :: ElemInd

    character(len=marbl_log_len) :: WarningMsg_loc   ! Message text

    this%lwarning = .true.

    ! Only allocate memory and add entry if we want to log full namelist!
    if (.not.this%OutputOptions%lLogWarning) then
      return
    end if

    write(WarningMsg_loc, "(4A)") "MARBL WARNING (", trim(CodeLoc), "): ", &
                                        trim(WarningMsg)

    call this%append_to_log(WarningMsg_loc, CodeLoc, ElemInd, lonly_master_writes=.false.)

  end subroutine marbl_log_warning

  !****************************************************************************

  subroutine marbl_log_noerror(this, StatusMsg, CodeLoc, ElemInd, lonly_master_writes)

    class(marbl_log_type), intent(inout) :: this
    ! StatusMsg is the message to be printed in the log; it does not need to
    !    contain the name of the module or subroutine producing the log message
    ! CodeLoc is the name of the subroutine that is calling StatusLog%log_noerror
    character(len=*),      intent(in)    :: StatusMsg, CodeLoc
    integer, optional,     intent(in)    :: ElemInd
    ! If lonly_master_writes is .false., then this is a message that should be
    ! printed out regardless of which task produced it. By default, MARBL assumes
    ! that only the master task needs to print a message
    logical, optional,     intent(in)    :: lonly_master_writes

    ! Only allocate memory and add entry if we want to log full namelist!
    if (.not.this%OutputOptions%lLogGeneral) then
      return
    end if

    call this%append_to_log(StatusMsg, CodeLoc, ElemInd, lonly_master_writes)

  end subroutine marbl_log_noerror

  !****************************************************************************

  subroutine append_to_log(this, StatusMsg, CodeLoc, ElemInd, lonly_master_writes)

    class(marbl_log_type), intent(inout) :: this
    ! StatusMsg is the message to be printed in the log; it does not need to
    !    contain the name of the module or subroutine producing the log message
    ! CodeLoc is the name of the subroutine that is calling StatusLog%log_noerror
    character(len=*),      intent(in)    :: StatusMsg, CodeLoc
    integer, optional,     intent(in)    :: ElemInd
    ! If lonly_master_writes is .false., then this is a message that should be
    ! printed out regardless of which task produced it. By default, MARBL assumes
    ! that only the master task needs to print a message
    logical, optional,     intent(in)    :: lonly_master_writes
    type(marbl_status_log_entry_type), pointer :: new_entry

    allocate(new_entry)
    nullify(new_entry%next)
    if (present(ElemInd)) then
      new_entry%ElementInd = ElemInd
    else
      new_entry%ElementInd = -1
    end if
    new_entry%LogMessage   = trim(StatusMsg)
    new_entry%CodeLocation = trim(CodeLoc)
    if (present(lonly_master_writes)) then
      new_entry%lonly_master_writes = lonly_master_writes
    else
      new_entry%lonly_master_writes = .true.
    end if

    if (associated(this%FullLog)) then
      ! Append new entry to last entry in the log
      this%LastEntry%next => new_entry
    else
      this%FullLog => new_entry
    end if
    ! Update LastEntry attribute of linked list
    this%LastEntry => new_entry

  end subroutine append_to_log

  !****************************************************************************

  subroutine marbl_log_error_trace(this, RoutineName, CodeLoc, ElemInd)

  ! This routine should only be called if another subroutine has returned and
  ! StatusLog%labort_marbl = .true.

    class(marbl_log_type), intent(inout) :: this
    ! RoutineName is the name of the subroutine that returned with
    !             labort_marbl = .true.
    ! CodeLoc is the name of the subroutine that is calling StatusLog%log_error_trace
    !
    ! Log will contain a message along the lines of
    !
    ! "(CodeLoc) Error reported from RoutineName"
    !
    ! When the log is printed, this will provide a traceback through the sequence
    ! of calls that led to the original error message.
    character(len=*),      intent(in)    :: RoutineName, CodeLoc
    integer, optional,     intent(in)    :: ElemInd
    character(len=char_len) :: log_message

    write(log_message, "(2A)") "Error reported from ", trim(RoutineName)
    call this%log_error(log_message, CodeLoc, ElemInd)

  end subroutine marbl_log_error_trace

  !****************************************************************************

  subroutine marbl_log_warning_trace(this, RoutineName, CodeLoc, ElemInd)

  ! This routine should only be called if another subroutine has returned and
  ! StatusLog%lwarning = .true.

    class(marbl_log_type), intent(inout) :: this
    ! RoutineName is the name of the subroutine that returned with
    !             lwarning = .true.
    ! CodeLoc is the name of the subroutine that is calling StatusLog%log_warning_trace
    !
    ! Log will contain a message along the lines of
    !
    ! "(CodeLoc) Warning reported from RoutineName"
    !
    ! When the log is printed, this will provide a traceback through the sequence
    ! of calls that led to the original warning message.
    character(len=*),      intent(in)    :: RoutineName, CodeLoc
    integer, optional,     intent(in)    :: ElemInd
    character(len=char_len) :: log_message

    write(log_message, "(2A)") "Warning reported from ", trim(RoutineName)
    call this%log_warning(log_message, CodeLoc, ElemInd)
    this%lwarning = .false.

  end subroutine marbl_log_warning_trace

  !****************************************************************************

  subroutine marbl_log_erase(this)

    class(marbl_log_type), intent(inout) :: this
    type(marbl_status_log_entry_type), pointer :: tmp

    do while (associated(this%FullLog))
      tmp => this%FullLog%next
      deallocate(this%FullLog)
      this%FullLog => tmp
    end do
    nullify(this%FullLog)
    nullify(this%LastEntry)

    this%lwarning = .false.

  end subroutine marbl_log_erase

  !*****************************************************************************

  subroutine marbl_logging_add_diagnostics_error(marbl_status_log, sname, subname)

    type(marbl_log_type),          intent(inout) :: marbl_status_log
    character(len=*),              intent(in)    :: sname, subname

    character(len=char_len) :: routine_name

    write(routine_name,"(3A)") "diags%add_diagnostic(", trim(sname), ")"
    call marbl_status_log%log_error_trace(routine_name, subname)

  end subroutine marbl_logging_add_diagnostics_error

  !*****************************************************************************

end module marbl_logging
