libErrorHandling.f90 Source File

module libErrorHandling
  implicit none
  private

  public :: SUCCESS
  public :: ERR_FILE_NOT_FOUND
  public :: ERR_INVALID_INPUT
  public :: ERR_CONVERGENCE_FAILED
  public :: ERR_MISC
  public :: error_message
  public :: raise_error

  integer, parameter :: SUCCESS                = 0
  integer, parameter :: ERR_FILE_NOT_FOUND     = 1
  integer, parameter :: ERR_INVALID_INPUT      = 2
  integer, parameter :: ERR_CONVERGENCE_FAILED = 3
  integer, parameter :: ERR_MISC               = 99

contains

  function error_message(code, context) result(msg)
    integer, intent(in) :: code
    character(len=*), intent(in), optional :: context
    character(len=256) :: msg

    character(len=200) :: ctx
    if (present(context)) then
       ctx = trim(context)
    else
       ctx = ''
    end if

    select case (code)
    case (SUCCESS)
       msg = 'No error.'
    case (ERR_FILE_NOT_FOUND)
       if (ctx /= '') then
          write(msg,'(A,1X,A)') 'File not found:', ctx
       else
          msg = 'File not found.'
       end if
    case (ERR_INVALID_INPUT)
       if (ctx /= '') then
          write(msg,'(A,1X,A)') 'Invalid input:', ctx
       else
          msg = 'Invalid input.'
       end if
    case (ERR_CONVERGENCE_FAILED)
       if (ctx /= '') then
          write(msg,'(A,1X,A)') 'Convergence failed in:', ctx
       else
          msg = 'Convergence failed.'
       end if
    case (ERR_MISC)
       if (ctx /= '') then
          write(msg,'(A,1X,A)') 'Error:', ctx
       else
          msg = 'Unspecified error.'
       end if
    case default
       write(msg,'(A,I0)') 'Unknown error code:', code
    end select
  end function error_message


  subroutine raise_error(code, context)
    integer, intent(in) :: code
    character(len=*), intent(in), optional :: context

    write(*,'(A)') trim(error_message(code, context))
    call exit(code)
  end subroutine raise_error

end module libErrorHandling