Improved error handling in linear solver

MintonGroup · May 14, 2021 · 4041b4d · 4041b4d
1 parent cb64464
commit 4041b4d
Showing 1 changed file with 8 additions and 3 deletions.
diff --git a/src/util/util_solve_linear_system.f90 b/src/util/util_solve_linear_system.f90
@@ -20,6 +20,7 @@ function util_solve_linear_system(A,b,n,lerr) result(x)
    real(QP), dimension(:), allocatable :: qx
 
    qx = solve_wbs(ge_wpp(real(A, kind=QP), real(b, kind=QP)),lerr)
+   where(abs(qx(:)) < tiny(1._DP)) qx(:) = 0._QP
    x = real(qx, kind=DP)
    return
 
@@ -37,11 +38,15 @@ function solve_wbs(u, lerr) result(x) ! solve with backward substitution
          integer(I4B)             :: i,n
          real(DP), parameter :: epsilon = 10 * tiny(1._DP) 
 
+         if (allocated(x)) deallocate(x)
+         allocate(x(n))
+
          lerr = any(abs(u(:,:)) < epsilon)
-         if (lerr) return
+         if (lerr) then
+            x(:) = 0._DP
+            return
+         end if
 
-         n = size(u,1)
-         allocate(x(n))
          do i = n,1,-1 
             x(i) = (u(i, n + 1) - sum(u(i, i + 1:n) * x(i + 1:n))) / u(i, i)
          end do