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 !**************************************************************************** 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 end module marbl_logging