implemented a simple fortran error handling framework.

examples/example_hl.f90

+MODULE mo_example
+
+  USE error_handling
+  IMPLICIT NONE
+
+CONTAINS
+
+  INTEGER FUNCTION division(number1, number2, ifail)
+    INTEGER,       INTENT(IN)    :: number1, number2
+    TYPE(t_error), INTENT(INOUT) :: ifail
+
+    division = 0
+    IF (number2 == 0) THEN
+      CALL create_error(ifail, t_arithmetic_error("Division by zero!"))
+    ELSE IF ((number1 < 0) .OR. (number2 < 0)) THEN
+      CALL create_error(ifail, t_invalid_input_error("Only positive numbers allowed!"))
+    ELSE
+      division = number1 / number2
+    END IF
+  END FUNCTION division
+END MODULE mo_example
+
+
+
 PROGRAM example
 
-  USE mtime,    ONLY: setCalendar, PROLEPTIC_GREGORIAN  
-  USE mtime_hl, ONLY: t_datetime, t_timedelta
+  USE mo_example
+
+  USE mtime,          ONLY: setCalendar, PROLEPTIC_GREGORIAN  
+  USE mtime_hl,       ONLY: t_datetime, t_timedelta
+  USE error_handling
   
   IMPLICIT NONE
   
   TYPE(t_datetime)  :: dt, dt2, dt3
   TYPE(t_timedelta) :: td
 
+  INTEGER       :: test_number1, test_number2, test_result
+  TYPE(t_error) :: ifail
+
+
   WRITE (0,*) "example_hl : test example"
 
   WRITE (0,*) "  setting calendar."
@@ -55,5 +86,26 @@ PROGRAM example
   WRITE (0,*) dt%to_string(), " == ", dt2%to_string(), ": ", (dt == dt2)
   dt3 = "1970-01-01T00:00:01"
   WRITE (0,*) dt%to_string(), " == ", dt3%to_string(), ": ", (dt == dt3)
+
+  ! ------------------------------------------------------------
+  ! EXAMPLE FOR ERROR HANDLING
+  ! ------------------------------------------------------------
+
+  WRITE (0,*) "EXAMPLE FOR ERROR HANDLING"
+  test_number1 = 10
+  test_number2 = -1
+  test_result  = division(test_number1, test_number2, ifail)
+
+  SELECT TYPE(info => ifail%info)
+  CLASS is (t_arithmetic_error)
+    WRITE (0,*) "I'm too stupid!"
+    CALL ifail%report()
+  CLASS is (t_invalid_input_error)
+    WRITE (0,*) "You are too stupid!"
+    CALL ifail%report()
+  CLASS default
+    WRITE (0,*) "Everything was ok!"
+    WRITE (0,*) "result = ", test_result
+  END SELECT
   
 END PROGRAM example

src/Makefile.am

@@ -19,6 +19,7 @@ libmtime_la_SOURCES = mtime_calendar.c \
 		      vsop87.c \
 		      kepler.c \
 		      orbit.c \
+                      error_handling.f90 \
                       libmtime.f90 \
                       libmtime_hl.f90
 

src/Makefile.in

@@ -128,7 +128,8 @@ am_libmtime_la_OBJECTS = mtime_calendar.lo mtime_calendar360day.lo \
 	mtime_iso8601.lo mtime_date.lo mtime_datetime.lo \
 	mtime_julianDay.lo mtime_time.lo mtime_timedelta.lo \
 	mtime_eventList.lo mtime_eventHandling.lo mtime_utilities.lo \
-	vsop87.lo kepler.lo orbit.lo libmtime.lo libmtime_hl.lo
+	vsop87.lo kepler.lo orbit.lo error_handling.lo libmtime.lo \
+	libmtime_hl.lo
 libmtime_la_OBJECTS = $(am_libmtime_la_OBJECTS)
 AM_V_lt = $(am__v_lt_@AM_V@)
 am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
@@ -382,6 +383,7 @@ libmtime_la_SOURCES = mtime_calendar.c \
 		      vsop87.c \
 		      kepler.c \
 		      orbit.c \
+                      error_handling.f90 \
                       libmtime.f90 \
                       libmtime_hl.f90
 

src/error_handling.f90

+!> Simple framework for error handling in Fortran.
+!
+!  This error handling strategy has been described in:
+!
+!  Poppe, Cools,Vandewoestyne: 
+!  Error handling in Fortran 2003 (2012)
+!
+!  It benefits from a number of F2003 features.  In this
+!  implementation, some parts of the framework have been simplified.
+!
+!  Implementation: 09/2016, F. Prill (DWD)
+!
+MODULE error_handling
+
+  IMPLICIT NONE
+
+  PUBLIC :: t_error
+  PUBLIC :: t_error_info, t_invalid_input_error, t_arithmetic_error
+
+  PUBLIC :: create_error
+  PUBLIC :: transfer_error
+
+
+  INTEGER, PARAMETER :: MAX_ERROR_STR_LEN = 256
+
+
+  !> Base class for error info, storing the details of the
+  !  circumstances in which the error occured. Making a distinction
+  !  between the error and the associated information simplifies the
+  !  use.
+  TYPE t_error_info   
+    CHARACTER(LEN=MAX_ERROR_STR_LEN) :: error_string
+  END TYPE t_error_info
+
+
+  !> Error info type: Invalid user input
+  TYPE, EXTENDS(t_error_info) :: t_invalid_input_error
+  END TYPE t_invalid_input_error
+
+  !> Error info type: Arithmetic error
+  TYPE, EXTENDS(t_error_info) :: t_arithmetic_error
+  END TYPE t_arithmetic_error
+
+ 
+
+  !> Base class for errors
+  TYPE t_error
+    CLASS(t_error_info), POINTER :: info => NULL()
+  CONTAINS 
+    PROCEDURE :: report  => error_report
+    PROCEDURE :: discard => error_discard
+  END TYPE t_error
+
+CONTAINS
+
+  !> Called in an unexpected situation, this subroutine creates an
+  !  error, storing all parameters that are needed to uniquely define
+  !  the situation.
+  !
+  SUBROUTINE create_error(new_error, new_info)
+    TYPE(t_error),       INTENT(INOUT) :: new_error
+    CLASS(t_error_info), INTENT(IN)    :: new_info
+    ALLOCATE(new_error%info, source=new_info)
+  END SUBROUTINE create_error
+
+
+  !> Transfers the error from @p inform to the @p ifail argument.
+  !
+  !  Thus, the responsibility of the error can be transferred to the
+  !  calling procedure.
+  !
+  SUBROUTINE transfer_error(inform, new_error)
+    TYPE(t_error), INTENT(IN)    :: inform
+    TYPE(t_error), INTENT(INOUT) :: new_error
+    new_error%info => inform%info
+  END SUBROUTINE transfer_error
+
+
+  !> Outputs the given error.
+  !
+  SUBROUTINE error_report(this)
+    CLASS(t_error) :: this
+    IF (ASSOCIATED(this%info)) THEN
+      WRITE (0,*) "ERROR STRING: ", this%info%error_string
+    ELSE
+      WRITE (0,*) "SUCCESS"
+    END IF
+    CALL this%discard()
+  END SUBROUTINE error_report
+
+
+  !> Indicates that the given error has been taken care of and can be
+  !  silenced safely.
+  !
+  SUBROUTINE error_discard(this)
+    CLASS(t_error) :: this
+    IF (ASSOCIATED(this%info))  DEALLOCATE(this%info)
+  END SUBROUTINE error_discard
+
+END MODULE error_handling