Aleksandar Donev writes:

> In absence of things like exception handling or assertions in Fortran
> 95, I am finding it hard to design good error-handling mechanisms. I
> would appreciate any advice or pointers to good strategies from library
> writers and others alike.

Here's what I use in my Monte Carlo library VAMP.  Since all
procedures are PURE in order to simplify parallel processing, I pass
error conditions around and check them in driver routines.  The
crucial point is that RAISE_EXCEPTION doesn't overwrite the messages
in EXC if it holds a more severe exception.  This way one can
accumulate error codes across procedure calls.  I also have have EXC
optional to simplify life for the calling procedures, which might have
it optional themselves.

Also interesting is GATHER_EXCEPTIONS, which allows idioms like

    CALL CLEAR_EXCEPTION (EXCS)
    CALL ELEMENTAL_PROCEDURE_1 (Y, X, EXCS)
    CALL ELEMENTAL_PROCEDURE_2 (B, A, EXCS)
    IF (ANY (EXCS%LEVEL > 0)) THEN
       CALL GATHER_EXCEPTIONS (EXC, EXCS)
       RETURN
    END IF

if ELEMENTAL_PROCEDURE_1 and ELEMENTAL_PROCEDURE_2 call
RAISE_EXCEPTION.

! exceptions.f90 --
! Copyright (C) 1998 by Thorsten Ohl <[log in to unmask]>
!
! VAMP is free software; you can redistribute it and/or modify it
! under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 2, or (at your option)
! any later version.
!
! VAMP is distributed in the hope that it will be useful, but
! WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This version of the source code of vamp has no comments and
! can be hard to understand, modify, and improve.  You should have
! received a copy of the literate noweb sources of vamp that
! contain the documentation in full detail.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module exceptions
  use kinds
  implicit none

  public :: handle_exception
  public :: raise_exception, clear_exception, gather_exceptions
  integer, public, parameter :: &
       EXC_NONE = 0, &
       EXC_INFO = 1, &
       EXC_WARN = 2, &
       EXC_ERROR = 3, &
       EXC_FATAL = 4
  integer, private, parameter :: EXC_DEFAULT = EXC_ERROR
  integer, private, parameter :: NAME_LENGTH = 64
  type, public :: exception
     integer :: level                                          =EXC_NONE
     character(len=NAME_LENGTH) :: message                     =""
     character(len=NAME_LENGTH) :: origin                      =""
  end type exception
  character(len=*), public, parameter :: EXCEPTIONS_RCS_ID = &
       "$Id: exceptions.nw,v 1.14 1998/09/01 09:44:55 ohl Exp $"
contains
  subroutine handle_exception (exc)
    type(exception), intent(inout) :: exc
    character(len=10) :: name
    if (exc%level > 0) then
       select case (exc%level)
       case (EXC_NONE)
          name = "(none)"
       case (EXC_INFO)
          name = "info"
       case (EXC_WARN)
          name = "warning"
       case (EXC_ERROR)
          name = "error"
       case (EXC_FATAL)
          name = "fatal"
       case default
          name = "invalid"
       end select
       print *, trim (exc%origin), ": ", trim(name), ": ", trim (exc%message)
       if (exc%level >= EXC_FATAL) then
          print *, "terminated."
          stop
       end if
    end if
  end subroutine handle_exception
  elemental subroutine raise_exception (exc, level, origin, message)
    type(exception), intent(inout), optional :: exc
    integer, intent(in), optional :: level
    character(len=*), intent(in), optional :: origin, message
    integer :: local_level
    if (present (exc)) then
       if (present (level)) then
          local_level = level
       else
          local_level = EXC_DEFAULT
       end if
       if (exc%level < local_level) then
          exc%level = local_level
          if (present (origin)) then
             exc%origin = origin
          else
             exc%origin = "[vamp]"
          end if
          if (present (message)) then
             exc%message = message
          else
             exc%message = "[vamp]"
          end if
       end if
    end if
  end subroutine raise_exception
  elemental subroutine clear_exception (exc)
    type(exception), intent(inout) :: exc
    exc%level = 0
    exc%message = ""
    exc%origin = ""
  end subroutine clear_exception
  pure subroutine gather_exceptions (exc, excs)
    type(exception), intent(inout) :: exc
    type(exception), dimension(:), intent(in) :: excs
    integer :: i
    i = sum (maxloc (excs%level))
    if (exc%level < excs(i)%level) then
       call raise_exception (exc, excs(i)%level, excs(i)%origin, &
            excs(i)%message)
    end if
  end subroutine gather_exceptions
end module exceptions

--
Thorsten Ohl,  Physics Dept., Wuerzburg Univ.  -- [log in to unmask]
http://heplix.ikp.physik.tu-darmstadt.de/~ohl/ [<=== PGP public key here]