From 2cbabfbc388056bcf3a8aaff0a977deea8f6b3c2 Mon Sep 17 00:00:00 2001
From: "philippe.theveny"
 <philippe.theveny@8a072113-8704-0410-8d35-dd094bca7971>
Date: Fri, 6 Feb 2015 20:31:47 +0000
Subject: [PATCH] Systematically return with INFO=1 when the root finder
 failed. This corresponds to the documentation of [d/s]lasdx routines and
 fixes bug121 reported Justin Si.

---
 SRC/dlasd0.f | 3 +++
 SRC/dlasd1.f | 3 +++
 SRC/dlasd3.f | 2 +-
 SRC/dlasd6.f | 3 +--
 SRC/dlasd8.f | 3 +--
 SRC/slasd0.f | 3 +++
 SRC/slasd1.f | 3 +++
 SRC/slasd3.f | 2 +-
 SRC/slasd6.f | 3 +--
 SRC/slasd8.f | 3 +--
 10 files changed, 18 insertions(+), 10 deletions(-)

diff --git a/SRC/dlasd0.f b/SRC/dlasd0.f
index 735e630..6d9a24e 100644
--- a/SRC/dlasd0.f
+++ b/SRC/dlasd0.f
@@ -302,6 +302,9 @@
             CALL DLASD1( NL, NR, SQREI, D( NLF ), ALPHA, BETA,
      $                   U( NLF, NLF ), LDU, VT( NLF, NLF ), LDVT,
      $                   IWORK( IDXQC ), IWORK( IWK ), WORK, INFO )
+*
+*        Report the possible convergence failure.
+*
             IF( INFO.NE.0 ) THEN
                RETURN
             END IF
diff --git a/SRC/dlasd1.f b/SRC/dlasd1.f
index 8b8ae08..6e9e6e9 100644
--- a/SRC/dlasd1.f
+++ b/SRC/dlasd1.f
@@ -302,6 +302,9 @@
      $             U, LDU, WORK( IU2 ), LDU2, VT, LDVT, WORK( IVT2 ),
      $             LDVT2, IWORK( IDXC ), IWORK( COLTYP ), WORK( IZ ),
      $             INFO )
+*
+*     Report the convergence failure.
+*
       IF( INFO.NE.0 ) THEN
          RETURN
       END IF
diff --git a/SRC/dlasd3.f b/SRC/dlasd3.f
index 8a07389..ba5998b 100644
--- a/SRC/dlasd3.f
+++ b/SRC/dlasd3.f
@@ -351,7 +351,7 @@
          CALL DLASD4( K, J, DSIGMA, Z, U( 1, J ), RHO, D( J ),
      $                VT( 1, J ), INFO )
 *
-*        If the zero finder fails, the computation is terminated.
+*        If the zero finder fails, report the convergence failure.
 *
          IF( INFO.NE.0 ) THEN
             RETURN
diff --git a/SRC/dlasd6.f b/SRC/dlasd6.f
index 8b0f8d5..d5ecb59 100644
--- a/SRC/dlasd6.f
+++ b/SRC/dlasd6.f
@@ -414,10 +414,9 @@
       CALL DLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDGNUM,
      $             WORK( ISIGMA ), WORK( IW ), INFO )
 *
-*     Handle error returned
+*     Report the possible convergence failure.
 *
       IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DLASD8', -INFO )
          RETURN
       END IF
 *
diff --git a/SRC/dlasd8.f b/SRC/dlasd8.f
index 60275e7..00bf80a 100644
--- a/SRC/dlasd8.f
+++ b/SRC/dlasd8.f
@@ -276,10 +276,9 @@
          CALL DLASD4( K, J, DSIGMA, Z, WORK( IWK1 ), RHO, D( J ),
      $                WORK( IWK2 ), INFO )
 *
-*        If the root finder fails, the computation is terminated.
+*        If the root finder fails, report the convergence failure.
 *
          IF( INFO.NE.0 ) THEN
-            CALL XERBLA( 'DLASD4', -INFO )
             RETURN
          END IF
          WORK( IWK3I+J ) = WORK( IWK3I+J )*WORK( J )*WORK( IWK2I+J )
diff --git a/SRC/slasd0.f b/SRC/slasd0.f
index b04a32d..b2d3e8b 100644
--- a/SRC/slasd0.f
+++ b/SRC/slasd0.f
@@ -300,6 +300,9 @@
             CALL SLASD1( NL, NR, SQREI, D( NLF ), ALPHA, BETA,
      $                   U( NLF, NLF ), LDU, VT( NLF, NLF ), LDVT,
      $                   IWORK( IDXQC ), IWORK( IWK ), WORK, INFO )
+*
+*     Report the possible convergence failure.
+*
             IF( INFO.NE.0 ) THEN
                RETURN
             END IF
diff --git a/SRC/slasd1.f b/SRC/slasd1.f
index b076fca..080368e 100644
--- a/SRC/slasd1.f
+++ b/SRC/slasd1.f
@@ -302,6 +302,9 @@
      $             U, LDU, WORK( IU2 ), LDU2, VT, LDVT, WORK( IVT2 ),
      $             LDVT2, IWORK( IDXC ), IWORK( COLTYP ), WORK( IZ ),
      $             INFO )
+*
+*     Report the possible convergence failure.
+*
       IF( INFO.NE.0 ) THEN
          RETURN
       END IF
diff --git a/SRC/slasd3.f b/SRC/slasd3.f
index 1ad481c..5833b65 100644
--- a/SRC/slasd3.f
+++ b/SRC/slasd3.f
@@ -351,7 +351,7 @@
          CALL SLASD4( K, J, DSIGMA, Z, U( 1, J ), RHO, D( J ),
      $                VT( 1, J ), INFO )
 *
-*        If the zero finder fails, the computation is terminated.
+*        If the zero finder fails, report convergence the failure.
 *
          IF( INFO.NE.0 ) THEN
             RETURN
diff --git a/SRC/slasd6.f b/SRC/slasd6.f
index 45b3ab1..3fe2c16 100644
--- a/SRC/slasd6.f
+++ b/SRC/slasd6.f
@@ -414,10 +414,9 @@
       CALL SLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDGNUM,
      $             WORK( ISIGMA ), WORK( IW ), INFO )
 *
-*     Handle error returned
+*     Report the possible convergence failure.
 *
       IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'SLASD8', -INFO )
          RETURN
       END IF
 *
diff --git a/SRC/slasd8.f b/SRC/slasd8.f
index c80d7cd..be22369 100644
--- a/SRC/slasd8.f
+++ b/SRC/slasd8.f
@@ -276,10 +276,9 @@
          CALL SLASD4( K, J, DSIGMA, Z, WORK( IWK1 ), RHO, D( J ),
      $                WORK( IWK2 ), INFO )
 *
-*        If the root finder fails, the computation is terminated.
+*        If the root finder fails, report the convergence failure.
 *
          IF( INFO.NE.0 ) THEN
-            CALL XERBLA( 'SLASD4', -INFO )
             RETURN
          END IF
          WORK( IWK3I+J ) = WORK( IWK3I+J )*WORK( J )*WORK( IWK2I+J )
-- 
2.7.4