* Bug #9196 fixed - The threshold level for conditioning in backslash was too
[scilab.git] / scilab / modules / linear_algebra / src / fortran / intzgesv3.f
index 6ceb4ce..cb83a47 100644 (file)
@@ -18,6 +18,7 @@ c     a\b
       character fname*(*)
       double precision ANORM, EPS, RCOND
       double precision dlamch, zlange
+      double precision RCOND_thresh
       integer vfinite
       external dlamch, zlange, vfinite
       intrinsic sqrt
@@ -26,6 +27,7 @@ c
       maxrhs=2
       minlhs=1
       maxlhs=1
+
 c     
       if(.not.checkrhs(fname,minrhs,maxrhs)) return
       if(.not.checklhs(fname,minlhs,maxlhs)) return
@@ -75,6 +77,7 @@ c     Check if A and B matrices contains Inf or NaN's
       if(.not.createvar(10,'z',1,LWORK,lDWORK)) return
       
       EPS = dlamch('eps')
+      RCOND_thresh=EPS*10
       ANORM = zlange( '1', M, N, zstk(lA), M, zstk(lDWORK) )
 c     
       if(M.eq.N) then
@@ -92,7 +95,7 @@ c     SUBROUTINE ZGETRF( N, N, A, LDA, IPIV, INFO )
      $           zstk(lDWORK), stk(lRWORK), INFO )
 c     SUBROUTINE ZGECON( NORM, N, A, LDA, ANORM, RCOND, WORK,
 c     $                        RWORK, INFO )
-            if(RCOND.gt.sqrt(EPS)) then
+            if(RCOND.gt.RCOND_thresh) then
                call ZGETRS( 'N', N, NRHS, zstk(lAF), N, istk(lIPIV),
      $              zstk(lXB), N, INFO ) 
 c     SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV,
@@ -111,7 +114,7 @@ c     .        ill conditioned problem
 c     
 c     M.ne.N or A  singular
 c     
-      RCOND = sqrt(EPS)
+      RCOND = RCOND_thresh
       call ZLACPY( 'F', M, NRHS, zstk(lB), M, zstk(lXB), max(M,N) )
 c     SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB )
       do 10 i = 1, N