Sebastianwolf/error checking

CMakeLists.txt

@@ -13,6 +13,7 @@ set(FASTSCAPELIB_SRC_FILES
   ${FASTSCAPELIB_SRC_DIR}/Diffusion.f90
   ${FASTSCAPELIB_SRC_DIR}/FastScape_api.f90
   ${FASTSCAPELIB_SRC_DIR}/FastScape_ctx.f90
+  ${FASTSCAPELIB_SRC_DIR}/FastScapeErrorCodes.f90
   ${FASTSCAPELIB_SRC_DIR}/LocalMinima.f90
   ${FASTSCAPELIB_SRC_DIR}/Marine.f90
   ${FASTSCAPELIB_SRC_DIR}/Strati.f90
@@ -45,7 +46,7 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp")
 # =====
 
 if(CMAKE_Fortran_COMPILER_ID MATCHES "Flang|GNU")
-    set(dialect "-ffree-form -std=f2008 -fimplicit-none -fall-intrinsics")
+    set(dialect "-ffree-form -std=f2008 -fimplicit-none -fall-intrinsics -ffree-line-length-none")
     set(ioflags "-fconvert=big-endian")
     set(f77flags "-std=legacy -ffixed-form")
     set(bounds "-fbounds-check")
@@ -99,9 +100,15 @@ endif()
 # Fortran library (static/shared)
 # ===============================
 
+set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/mod)
+
 if(BUILD_FASTSCAPELIB_STATIC OR BUILD_FASTSCAPELIB_SHARED)
+  # build temp library
   set(FASTSCAPELIB_OBJECTS libfastscape_objects)
   add_library(${FASTSCAPELIB_OBJECTS} OBJECT ${FASTSCAPELIB_SRC_FILES})
+
+  # install api Fortran module
+  install(FILES ${CMAKE_Fortran_MODULE_DIRECTORY}/fastscapeapi.mod DESTINATION include)
 endif()
 
 if(BUILD_FASTSCAPELIB_STATIC)

src/Diffusion.f90

@@ -1,4 +1,5 @@
-subroutine Diffusion ()
+#include "Error.fpp"
+subroutine Diffusion (ierr)
 
   ! subroutine to solve the diffusion equation by ADI
 
@@ -11,6 +12,7 @@ subroutine Diffusion ()
   integer i,j,ij
   double precision factxp,factxm,factyp,factym,dx,dy
   character cbc*4
+  integer ierr
 
   !print*,'Diffusion'
 
@@ -79,7 +81,7 @@ subroutine Diffusion ()
     inf(nx)=-factxm
     f(nx)=zintp(nx,j)+factyp*zintp(nx,j+1)-(factyp+factym)*zintp(nx,j)+factym*zintp(nx,j-1)
     endif
-  call tridag (inf,diag,sup,f,res,nx)
+  call tridag (inf,diag,sup,f,res,nx,ierr);FSCAPE_CHKERR(ierr)
     do i=1,nx
     zint(i,j)=res(i)
     enddo
@@ -131,7 +133,7 @@ subroutine Diffusion ()
     inf(ny)=-factym
     f(ny)=zint(i,ny)+factxp*zint(i+1,ny)-(factxp+factxm)*zint(i,ny)+factxm*zint(i-1,ny)
     endif
-  call tridag (inf,diag,sup,f,res,ny)
+  call tridag (inf,diag,sup,f,res,ny,ierr);FSCAPE_CHKERR(ierr)
     do j=1,ny
     zintp(i,j)=res(j)
     enddo
@@ -161,19 +163,23 @@ end subroutine Diffusion
 
 ! subroutine to solve a tri-diagonal system of equations (from Numerical Recipes)
 
-      SUBROUTINE tridag(a,b,c,r,u,n)
+      SUBROUTINE tridag(a,b,c,r,u,n,ierr)
 
+      use FastScapeErrorCodes
       implicit none
 
       INTEGER n
       double precision a(n),b(n),c(n),r(n),u(n)
       INTEGER j
       double precision bet
       double precision,dimension(:),allocatable::gam
-
+      integer,intent(inout):: ierr
       allocate (gam(n))
 
-      if(b(1).eq.0.d0) stop 'in tridag'
+      if(b(1).eq.0.d0) then
+        FSCAPE_RAISE_MESSAGE('Tridag error b(1)=0: cannot solve system',ERR_TridiagNotSolvable,ierr);FSCAPE_CHKERR(ierr)
+      end if
+      !if(b(1).eq.0.d0) stop 'in tridag'
 
 ! first pass
 
@@ -183,8 +189,9 @@ SUBROUTINE tridag(a,b,c,r,u,n)
   gam(j)=c(j-1)/bet
   bet=b(j)-a(j)*gam(j)
   if(bet.eq.0.) then
-    print*,'tridag failed'
-    stop
+    FSCAPE_RAISE_MESSAGE('Tridag error bet=0: cannot solve system',ERR_TridiagNotSolvable,ierr);FSCAPE_CHKERR(ierr)
+    ! print*,'tridag failed'
+    ! stop
   endif
   u(j)=(r(j)-a(j)*u(j-1))/bet
   11    continue

src/Error.fpp

@@ -0,0 +1,69 @@
+
+! Error.fpp
+
+!
+! Macros for error handling.
+! Fortran preprocessor must be enabled: -fpp.
+!
+
+!
+! Initialize ierr argument in API functions
+!
+#define FSCAPE_INITERR(ierr, ierr_, fname)        \
+  ierr_ = 0;                                      \
+  if (present(ierr)) then;                        \
+    ierr = ierr_;                                 \
+  else;                                           \
+    print '(A)', "*** Depreciation warning *** "; \
+    print '(A,A,A)', "Calling ", TRIM((fname)), " without 'ierr' argument (integer) is depreciated! Please update your code!"; \
+  end if;
+
+!
+! Raise an exception by pushing the name of the exception + file name, line number to stdout
+! Sets ierr to the error type specified by err_type
+!
+#define FSCAPE_RAISE(err_type, ierr) \
+  ierr = (err_type);                 \
+  print '(A,I4,A)', "*** FastScape exception *** -> " // TRIM(err_names((ierr))) // " (" // __FILE__ // ", line", __LINE__, ")";
+
+!
+! Raise an exception by pushing custom user provided message to stdout,
+! along with the name of the exception + file name, line number to stdout
+! Sets ierr to the error type specified by err_type
+!
+#define FSCAPE_RAISE_MESSAGE(msg, err_type, ierr)                    \
+  print '(A,A)', "*** FastScape exception *** ", TRIM((msg)) // "!"; \
+  FSCAPE_RAISE(err_type, ierr);
+
+!
+! Calls return if error code is non-zero.
+!
+#define FSCAPE_CHKERR(ierr) \
+  if (ierr /= 0) then;      \
+    return;                 \
+  end if;
+
+!
+! Either calls return or stop if error code is non-zero, dependening on whether the
+! the ierr argument is present.
+!
+#define FSCAPE_CHKERR_OPT(ierr, ierr_)                                         \
+  if (ierr_ /= 0) then;                                                        \
+    if (present(ierr)) then;                                                   \
+      ierr = ierr_;                                                            \
+      return;                                                                  \
+    else;                                                                      \
+      print '(A)', "*** Execution being halted by calling stop!";               \
+      print '(A)', "Call all API routine with 'ierr' argument to avoid this."; \
+      stop;                                                                    \
+    end if;                                                                    \
+  end if;
+
+!
+! Force stop if error code is non-zero.
+! This should only be called in driver code - never within library code or the API.
+!
+#define FSCAPE_CHKERR_ABORT(ierr) \
+  if (ierr /= 0) then;            \
+    stop;                         \
+  end if;

src/FastScapeErrorCodes.f90

@@ -0,0 +1,23 @@
+
+module FastScapeErrorCodes
+  implicit none
+  integer, parameter :: ERR_None                = 0,  &
+                        ERR_Default             = 1,  &
+                        ERR_FileNotFound        = 2,  &
+                        ERR_FileOpenFailed      = 3,  &
+                        ERR_ParameterInvalid    = 4,  &
+                        ERR_ParameterOutOfRange = 5,  &
+                        ERR_TridiagNotSolvable  = 6,  &
+                        ERR_SetupNotRun         = 7,  &
+                        ERR_NotConverged        = 8
+
+  character(len=50), dimension(8) :: err_names = [character(len=50) :: "Default run time error", &
+      "File error: File not found",             &
+      "File error: File open failed",           &
+      "Parameter error: Input invalid",         &
+      "Parameter error: Out of range" ,         &
+      "Solver error: Tridiag not solvable",     &
+      "Order invalid: Must call SetUp() first", &
+      "Solver error: not converged"  ]
+
+end module FastScapeErrorCodes