* Bug #9196 fixed - The threshold level for conditioning in backslash was too

[scilab.git] / scilab / modules / linear_algebra / src / fortran / intdgesv3.f

diff --git a/scilab/modules/linear_algebra/src/fortran/intdgesv3.f b/scilab/modules/linear_algebra/src/fortran/intdgesv3.f
index 669c72e..c71b1e6 100644 (file)
--- a/scilab/modules/linear_algebra/src/fortran/intdgesv3.f
+++ b/scilab/modules/linear_algebra/src/fortran/intdgesv3.f
@@ -1,5 +1,6 @@
 c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
 c Copyright (C) INRIA
+c Copyright (C) 2013 - Michael Baudin
 c$
 c This file must be used under the terms of the CeCILL.
 c This source file is licensed as described in the file COPYING, which
@@ -17,10 +18,12 @@ c     a\b
       character fname*(*)
       double precision ANORM, EPS, RCOND
       double precision dlamch, dlange
+      double precision RCONDthresh
       integer vfinite
       external dlamch, dlange, vfinite
       intrinsic sqrt
-c     
+
+c
       minrhs=2
       maxrhs=2
       minlhs=1
@@ -74,6 +77,7 @@ c     Check if A and B matrices contains Inf or NaN's
       if(.not.createvar(10,'d',1,LWORK,lDWORK)) return
       
       EPS = dlamch('eps')
+      RCOND_thresh=EPS*10
       ANORM = dlange( '1', M, N, stk(lA), M, stk(lDWORK) )
 c     
       if(M.eq.N) then
@@ -90,7 +94,7 @@ c     SUBROUTINE DGETRF( N, N, A, LDA, IPIV, INFO )
      $           istk(lIWORK), INFO )
 c     SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK,
 c     $                        IWORK, INFO )
-            if(RCOND.gt.sqrt(EPS)) then
+            if(RCOND.gt.RCONDthresh) then
                call DGETRS( 'N', N, NRHS, stk(lAF), N, istk(lIPIV),
      $              stk(lB), N, INFO ) 
 c     SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV,
@@ -107,7 +111,7 @@ c     SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
 c     
 c     M.ne.N or A singular
 c     
-      RCOND = sqrt(EPS)
+      RCOND = RCONDthresh
       call DLACPY( 'F', M, NRHS, stk(lB), M, stk(lXB), max(M,N) )
 c     SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
       do 10 i = 1, N