Add new error handling capability

CMakeLists.txt

@@ -241,6 +241,9 @@ else()
         src/params/cable_photo_constants_mod.F90
         src/params/cable_other_constants_mod.F90
         src/params/cable_maths_constants_mod.F90
+        src/util/error_handler/cable_error_handler_base.F90
+        src/util/error_handler/cable_error_handler_mpi.F90
+        src/util/error_handler/cable_error_handler.F90
         src/util/cable_runtime_opts_mod.F90
         src/util/cable_common.F90
         src/shared/casa_offline_inout.F90

src/offline/cable_mpi.F90

@@ -4,6 +4,7 @@
 
 MODULE cable_mpi_mod
   !! Module for handling some common MPI operations and MPI groups
+  USE cable_error_handler_mod, ONLY: cable_abort
 #ifdef __MPI__
   USE mpi_f08
 #else
@@ -110,8 +111,7 @@ FUNCTION mpi_grp_constructor(comm) RESULT(mpi_grp)
       call MPI_Comm_size(mpi_grp%comm, mpi_grp%size, ierr)
       call mpi_check_error(ierr)
 #else
-      WRITE(error_unit,*) "Error initialising mpi group: CABLE was compiled without MPI support."
-      STOP
+      call cable_abort("Error initialising mpi group: CABLE was compiled without MPI support.", file=__FILE__, line=__LINE__)
 #endif
     ELSE
       mpi_grp%rank = 0
@@ -120,19 +120,22 @@ FUNCTION mpi_grp_constructor(comm) RESULT(mpi_grp)
 
   END FUNCTION mpi_grp_constructor
 
-  SUBROUTINE mpi_grp_abort(this)
+  SUBROUTINE mpi_grp_abort(this, error_code)
     !* Class method to abort execution of an MPI group.
     CLASS(mpi_grp_t), INTENT(IN) :: this
+    INTEGER, INTENT(IN) :: error_code
 
     INTEGER :: ierr
 
-    IF (this%comm /= MPI_COMM_UNDEFINED) THEN
-      ! Here we use an arbitrary error code
 #ifdef __MPI__
-      call MPI_Abort(this%comm, 999, ierr)
-#endif
+    IF (this%comm /= MPI_COMM_UNDEFINED) THEN
+      call MPI_Abort(this%comm, error_code, ierr)
       call mpi_check_error(ierr)
     END IF
+#else
+    ! Here we use an arbitrary error code
+    STOP 999
+#endif
 
   END SUBROUTINE mpi_grp_abort
 
@@ -147,8 +150,7 @@ SUBROUTINE mpi_check_error(ierr)
 
     IF (ierr /= MPI_SUCCESS ) THEN
       CALL MPI_Error_String(ierr, msg, length, tmp)
-      WRITE(error_unit,*) msg(1:length)
-      CALL MPI_Abort(MPI_COMM_WORLD, 1 , tmp)
+      CALL cable_abort(msg(1:length), file=__FILE__, line=__LINE__)
     END if
 #endif
 

src/offline/cable_offline_driver.F90

@@ -4,6 +4,9 @@
 PROGRAM cable_offline_driver
   USE iso_fortran_env, ONLY : error_unit
   USE cable_mpi_mod, ONLY : mpi_grp_t, mpi_mod_init, mpi_mod_end
+  USE cable_error_handler_mod, ONLY : cable_error_handler_set
+  USE cable_error_handler_mod, ONLY : cable_error_handler_free
+  USE cable_error_handler_mpi_mod, ONLY : cable_error_handler_mpi_t
   USE cable_driver_common_mod, ONLY: &
       cable_driver_init,             &
       cable_driver_init_gswp,        &
@@ -35,6 +38,8 @@ PROGRAM cable_offline_driver
   call mpi_mod_init()
   mpi_grp = mpi_grp_t()
 
+  CALL cable_error_handler_set(cable_error_handler_mpi_t(mpi_grp))
+
   CALL cable_driver_init(mpi_grp, NRRRR)
 
   SELECT CASE(TRIM(cable_user%MetType))
@@ -68,6 +73,8 @@ PROGRAM cable_offline_driver
     END IF
   END IF
 
+  CALL cable_error_handler_free()
+
   CALL mpi_mod_end()
 
   CALL CPU_TIME(etime)

src/util/error_handler/cable_error_handler.F90

@@ -0,0 +1,63 @@
+! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License)
+! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation
+! (CSIRO) ABN 41 687 119 230.
+
+module cable_error_handler_mod
+  !* This module provides error handling functionality that can be used
+  ! throughout the CABLE codebase.
+  !
+  ! Error handling behaviour is controlled internally by either the global error
+  ! handler instance (`error_handler_global`) or the fallback error handler
+  ! instance (`error_handler_fallback`). The global error handler instance can be
+  ! set via `cable_error_handler_set` to provide custom error handling behaviour,
+  ! while the fallback error handler instance provides a default implementation of
+  ! the error handling behaviour. The global error handler is polymorphic which
+  ! allows for customising the error handling behaviour dynamically at runtime. To
+  ! do this we can create a new type that extends `cable_error_handler_base_t` with
+  ! the new error handling behaviour and set the global error handler to an
+  ! instance of the extended type.
+
+  use cable_error_handler_base_mod, only: cable_error_handler_base_t
+
+  implicit none
+  private
+
+  public :: cable_error_handler_base_t
+  public :: cable_error_handler_set
+  public :: cable_error_handler_free
+  public :: cable_abort
+
+  type(cable_error_handler_base_t), target :: error_handler_fallback = cable_error_handler_base_t()
+
+  class(cable_error_handler_base_t), allocatable, target :: error_handler_global
+
+contains
+
+  subroutine cable_error_handler_set(new_error_handler)
+    !! Set the global error handler instance.
+    class(cable_error_handler_base_t), intent(in) :: new_error_handler
+      !! New error handler instance to set as the global error handler.
+    error_handler_global = new_error_handler
+  end subroutine
+
+  subroutine cable_error_handler_free()
+    !! Free the global error handler instance.
+    if (allocated(error_handler_global)) deallocate(error_handler_global)
+  end subroutine
+
+  subroutine cable_abort(message, file, line, error_code)
+    !! Abort CABLE with an error message.
+    character(len=*), intent(in) :: message !! Error message to display
+    character(len=*), intent(in) :: file !! Source file where the error occurred
+    integer, intent(in) :: line !! Line number where the error occurred
+    integer, intent(in), optional :: error_code !! Optional error code
+    class(cable_error_handler_base_t), pointer :: error_handler
+
+    error_handler => error_handler_fallback
+    if (allocated(error_handler_global)) error_handler => error_handler_global
+
+    call error_handler%abort(message, file, line, error_code)
+
+  end subroutine
+
+end module

src/util/error_handler/cable_error_handler_base.F90

@@ -0,0 +1,55 @@
+! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License)
+! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation
+! (CSIRO) ABN 41 687 119 230.
+
+module cable_error_handler_base_mod
+  !* This module defines the base error handler type for CABLE.
+  ! It provides a default implementation of the error handling behaviour, which
+  ! can be extended to provide custom error handling.
+  use iso_fortran_env, only: error_unit
+  implicit none
+  private
+
+  public :: cable_error_handler_base_t
+
+  integer, parameter, public :: DEFAULT_ERROR_CODE = 999 !! Default error code to use when none is provided
+
+  type cable_error_handler_base_t
+    !* Base error handler type for CABLE.
+    ! This type provides a default implementation of the error handling behaviour.
+  contains
+    procedure :: build_error_message => cable_error_handler_base_build_error_message
+    procedure :: abort => cable_error_handler_base_abort
+  end type cable_error_handler_base_t
+
+contains
+
+  function cable_error_handler_base_build_error_message(this, message, file, line, error_code) result(error_message)
+    !! Build an error message string.
+    class(cable_error_handler_base_t), intent(inout) :: this
+    character(len=*), intent(in) :: message !! Error message to display
+    character(len=*), intent(in) :: file !! Source file where the error occurred
+    integer, intent(in) :: line !! Line number where the error occurred
+    integer, intent(in), optional :: error_code !! Optional error code
+    character(len=:), allocatable :: error_message
+    character(5) :: line_string
+
+    write (line_string, "(I5)") line
+    error_message = "Error: " // file // ":" // "L" // trim(adjustl(line_string)) // ": " // message
+
+  end function cable_error_handler_base_build_error_message
+
+  subroutine cable_error_handler_base_abort(this, message, file, line, error_code)
+    !! Default implementation of the abort procedure for the base error handler.
+    class(cable_error_handler_base_t), intent(inout) :: this
+    character(len=*), intent(in) :: message !! Error message to display
+    character(len=*), intent(in) :: file !! Source file where the error occurred
+    integer, intent(in) :: line !! Line number where the error occurred
+    integer, intent(in), optional :: error_code !! Optional error code
+
+    write(unit=error_unit, fmt="(A)") this%build_error_message(message, file, line, DEFAULT_ERROR_CODE)
+    error stop DEFAULT_ERROR_CODE
+
+  end subroutine
+
+end module

src/util/error_handler/cable_error_handler_mpi.F90

@@ -0,0 +1,48 @@
+! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License)
+! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation
+! (CSIRO) ABN 41 687 119 230.
+
+module cable_error_handler_mpi_mod
+  !* This module defines an MPI-aware error handler for CABLE.
+  ! It extends the base error handler to provide functionality for aborting an MPI program.
+  use iso_fortran_env, only: error_unit
+  use cable_error_handler_base_mod, only: cable_error_handler_base_t
+  use cable_error_handler_base_mod, only: DEFAULT_ERROR_CODE
+  use cable_mpi_mod, only: mpi_grp_t
+  implicit none
+  private
+
+  public :: cable_error_handler_mpi_t
+
+  type, extends(cable_error_handler_base_t) :: cable_error_handler_mpi_t
+    !* MPI-aware error handler type for CABLE.
+    ! This type extends the base error handler to provide functionality for aborting an MPI program.
+    type(mpi_grp_t) :: mpi_grp
+  contains
+    procedure :: abort => cable_error_handler_mpi_abort
+  end type cable_error_handler_mpi_t
+
+contains
+
+  subroutine cable_error_handler_mpi_abort(this, message, file, line, error_code)
+    !! Implementation of the abort procedure for the MPI-aware error handler.
+    class(cable_error_handler_mpi_t), intent(inout) :: this
+    character(len=*), intent(in) :: message !! Error message to display
+    character(len=*), intent(in) :: file !! Source file where the error occurred
+    integer, intent(in) :: line !! Line number where the error occurred
+    integer, intent(in), optional :: error_code !! Optional error code
+
+    integer :: err_code
+
+    if (present(error_code)) then
+      err_code = error_code
+    else
+      err_code = DEFAULT_ERROR_CODE
+    end if
+
+    write(unit=error_unit, fmt="(A)") this%build_error_message(message, file, line, err_code)
+    call this%mpi_grp%abort(err_code)
+
+  end subroutine
+
+end module