* Bug #9196 fixed - The threshold level for conditioning in backslash and slash 53/10753/3
Michaƫl Baudin [Fri, 8 Mar 2013 15:43:51 +0000 (16:43 +0100)]
                    were too small.

Change-Id: Ibd0b17766a1d92a89e4d2bcd68cca038aab862a4

scilab/CHANGES_5.4.X
scilab/modules/linear_algebra/src/fortran/intdgesv4.f
scilab/modules/linear_algebra/src/fortran/intzgesv4.f
scilab/modules/linear_algebra/tests/nonreg_tests/bug_9196.dia.ref
scilab/modules/linear_algebra/tests/nonreg_tests/bug_9196.tst

index 3033fea..f7d1342 100644 (file)
@@ -257,8 +257,8 @@ Bug fixes
 
 * Bug #9005 fixed - The bitset function did not have any tests.
 
-* Bug #9196 fixed - The threshold level for conditioning in backslash was too
-                    small.
+* Bug #9196 fixed - The threshold level for conditioning in backslash and slash
+                    were too small.
 
 * Bug #9305 fixed - In the optimisation help page, new chapter "Least Squares functions"
                     created.
index 0dd2d7c..ba4fb4a 100644 (file)
@@ -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
@@ -16,6 +17,7 @@ c     a/b
       logical checklhs,checkrhs
       character fname*(*)
       double precision ANORM, EPS, RCOND
+      double precision RCONDthresh
       double precision dlamch, dlange
       integer vfinite
       external dlamch, dlange, vfinite
@@ -74,6 +76,7 @@ c     Check if A and B matrices contains Inf or NaN's
       endif
       if(.not.createvar(11,'d',1,LWORK,lDWORK)) return
       EPS = dlamch('eps')
+      RCOND_thresh=EPS*10
       ANORM = dlange( '1', M, N, stk(lA), M, stk(lDWORK) )
 c     
 c     Transpose A and B
@@ -107,7 +110,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.RCOND_thresh) then
                call DGETRS( 'N', N, K, stk(lAF), N, istk(lIPIV),
      $              stk(lBT), N, INFO ) 
 c     SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV,
@@ -132,7 +135,7 @@ c
 c     
 c     M.ne.N or A singular
 c     
-      RCOND = sqrt(eps)
+      RCOND = RCOND_thresh
       do 70 i = 1, M
          istk(lJPVT+i-1) = 0
  70   continue
index b905f92..8172341 100644 (file)
@@ -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
@@ -16,6 +17,7 @@ c     a/b
       logical checklhs,checkrhs
       character fname*(*)
       double precision ANORM, EPS, RCOND
+      double precision RCONDthresh
       double precision dlamch, zlange
       integer vfinite
       external dlamch, zlange, vfinite
@@ -76,6 +78,7 @@ c     Check if A and B matrices contains Inf or NaN's
       endif
       if(.not.createvar(11,'z',1,LWORK,lDWORK)) return
       EPS = dlamch('eps')
+      RCOND_thresh=EPS*10
       ANORM = zlange( '1', M, N, zstk(lA), M, zstk(lDWORK) )
 c     
 c     Transpose A and B
@@ -109,7 +112,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, K, zstk(lAF), N, istk(lIPIV),
      $              zstk(lBT), N, INFO ) 
 c     SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV,
@@ -135,7 +138,7 @@ c     .  ill conditionned problem
 c     
 c     M.ne.N or A singular
 c     
-      RCOND = sqrt(eps)
+      RCOND = RCOND_thresh
       do 70 i = 1, M
          istk(lJPVT+i-1) = 0
  70   continue
index ab9ef99..c7bf84f 100644 (file)
@@ -67,3 +67,19 @@ bc=complex(b,zeros(b));
 xc = Ac\bc;
 xcexpected=complex(xexpected,zeros(xexpected));
 assert_checkalmostequal(xc, xexpected);
+n=9;
+A = testmatrix("hilb",n);
+b = ones(n,1);
+x = (b'/A')';
+xexpected=[
+2.82896825396825370e+000
+1.92896825396825400e+000
+1.51987734487734480e+000
+1.26987734487734480e+000
+1.09680042180042170e+000
+9.68228993228993360e-001
+8.68228993228993270e-001
+7.87871850371850480e-001
+7.21695379783615090e-001
+];
+assert_checkalmostequal(x, xexpected);
index 7c91813..837381e 100644 (file)
@@ -74,3 +74,20 @@ bc=complex(b,zeros(b));
 xc = Ac\bc;
 xcexpected=complex(xexpected,zeros(xexpected));
 assert_checkalmostequal(xc, xexpected);
+
+n=9;
+A = testmatrix("hilb",n);
+b = ones(n,1);
+x = (b'/A')';
+xexpected=[
+2.82896825396825370e+000
+1.92896825396825400e+000
+1.51987734487734480e+000
+1.26987734487734480e+000
+1.09680042180042170e+000
+9.68228993228993360e-001
+8.68228993228993270e-001
+7.87871850371850480e-001
+7.21695379783615090e-001
+];
+assert_checkalmostequal(x, xexpected);