module error_handling_m !! Contains functionality for error handling use MPI use netcdf, only: nf90_noerr, nf90_strerror use status_codes_m, only: PARALLAX_ERR_NETCDF use screen_io_m, only: get_stderr, get_stdout use comm_handling_m, only: get_communicator use precision_m, only: FP implicit none private ! This module contains the functionality to handle errors and warnings in ! PARALLAX and in other codes using the PARALLAX library. Internally a ! type error_handler_t is used for the functionality. This type can be ! used by other codes to implement their own error handling without the ! need to write new or duplicate the functionality. public :: ERRORS_RETURN, ERRORS_ARE_FATAL enum, bind(C) !! Enumerator defining the error mode enumerator :: ERRORS_RETURN = 0 enumerator :: ERRORS_ARE_FATAL end enum type, public :: error_info_t !! Specifies additional user defined output for an error message that !! contains more than a simple message. May have a descriptive string !! and one dimensional integer and real arrays to print out variables. character(len=:), allocatable :: c_info !! Additional user defined string message integer, dimension(:), allocatable :: i_info !! Additional user defined integer variables real(FP), dimension(:), allocatable :: r_info !! Additional user defined real variables contains procedure :: print => print_error_info end type interface module subroutine print_error_info(this, channel, prefix) !! Prints out the content of the error_info_t type class(error_info_t), intent(in) :: this !! Instance of the class integer, intent(in) :: channel !! Channel to print the error info to character(len=*), optional, intent(in) :: prefix !! Prefix that can be put before any printout end subroutine end interface type, public :: error_handler_t !! Type that can be used to handle errors for multiple code instances !! at once. Each calling code may create a singleton instance of this !! type. There is no initialize routine, the instance should be !! initialized via the constructor. character(len=32) :: handler_name !! Name of the error handler instance integer :: error_mode !! Error mode chosen, can be either ERRORS_RETURN or ERRORS_ARE_FATAL integer :: netcdf_error_code !! Error code that is associated with NetCDF errors. Used when handling !! NetCDF errors. logical :: first_time_warning = .true. !! Indicates that a warning has already been printed before or not contains procedure :: set_error_mode => error_handler_set_error_mode procedure :: handle_error => error_handler_handle_error procedure :: handle_error_netcdf => error_handler_handle_error_netcdf end type interface module subroutine error_handler_set_error_mode(this, err_mode) !! Set the error mode of the type instance class(error_handler_t), intent(inout) :: this !! Instance of the type integer, intent(in) :: err_mode !! Error mode: Use ERRORS_RETURN or ERRORS_ARE_FATAL. !! Other values are ignored and ERRORS_ARE_FATAL is used end subroutine module subroutine error_handler_handle_error(this, message, & status_code, line_number, & file_name, additional_info) !! Handle the given error by printing out messages and terminating !! the program if status_code is an error code. class(error_handler_t), intent(inout) :: this !! Instance of the type character(len=*), intent(in) :: message !! Error or warning message integer, intent(in) :: status_code !! Error or warning code integer, intent(in) :: line_number !! Line number where error or warning occured, i.e. __LINE__ character(len=*), intent(in) :: file_name !! File name where error or warning occured, i.e. __FILE__ type(error_info_t), optional, intent(in) :: additional_info !! Additional information end subroutine module subroutine error_handler_handle_error_netcdf(this, istatus, & line_number, & file_name) !! Handle the given NetCDF error by calling handle_error with !! special preprocessing taylored to NetCDF errors. class(error_handler_t), intent(inout) :: this !! Instance of the type integer, intent(in) :: istatus !! Status integer returned by the NetCDF function integer, intent(in) :: line_number !! Line number where error or warning occured, i.e. __LINE__ character(len=*), intent(in) :: file_name !! File name where error or warning occured, i.e. __FILE__ end subroutine end interface type(error_handler_t) :: parallax_error_handler = & error_handler_t(handler_name="PARALLAX", & error_mode=ERRORS_ARE_FATAL, & netcdf_error_code=PARALLAX_ERR_NETCDF) !! Stores the setup information about PARALLAX errors. Is used by the !! the public subroutines in this module to deliver the error handling !! functionality to PARALLAX. public :: set_error_mode public :: handle_error public :: handle_error_netcdf contains subroutine set_error_mode(err_mode) !! Sets the way PARALLAX responds to internal errors. !! When set to errors return, the error is logged into stderr without !! program termination, expecting that the error will be handled !! by the calling routine. When set to errors are !! fatal, the code will be terminated with error stop. integer, intent(in) :: err_mode !! Error mode: Use ERRORS_RETURN or ERRORS_ARE_FATAL. !! Other values are ignored and ERRORS_ARE_FATAL is used. call parallax_error_handler%set_error_mode(err_mode) end subroutine subroutine handle_error(message, status_code, line_number, file_name, & additional_info) !! Logs an error to stderr and stops the program. If status_code is !! PARALLAX_SUCCESS, this subroutine will do nothing. !! !! If status_code has an undefined value, the subroutine will be !! executed but the undefined status_code will be printed. !! This usage should be avoided, instead valid status codes given in !! status_codes_m should be used. character(len=*), intent(in) :: message !! Error or warning message integer, intent(in) :: status_code !! Error or warning code integer, intent(in) :: line_number !! Line number where error or warning occured, i.e. __LINE__ character(len=*), intent(in) :: file_name !! File name where error or warning occured, i.e. __FILE__ type(error_info_t), optional, intent(in) :: additional_info !! Additional information call parallax_error_handler%handle_error(message, status_code, & line_number, file_name, & additional_info) end subroutine subroutine handle_error_netcdf(istatus, line_number, file_name) !! Wrapper of handle error for calls of NetCDF functions. !! Checks for NetCDF errors and prints a standardized error message. integer, intent(in) :: istatus !! Status integer returned by the NetCDF function integer, intent(in) :: line_number !! Line number where error or warning occured, i.e. __LINE__ character(len=*), intent(in) :: file_name !! File name where error or warning occured, i.e. __FILE__ call parallax_error_handler%handle_error_netcdf(istatus, line_number, & file_name) end subroutine end module