Break out of potentially infinite rescaling loop after 1000 iterations

Inf values in the input vector will survive rescaling, causing an infinite loop. The value of 1000 is arbitrarily chosen as a large but finite value with the intention to never interfere with regular calculations.

diff --git a/lapack-netlib/SRC/clarfg.f b/lapack-netlib/SRC/clarfg.f
index 05a27a2..4c0c5f7 100644 (file)
--- a/lapack-netlib/SRC/clarfg.f
+++ b/lapack-netlib/SRC/clarfg.f
@@ -175,7 +175,7 @@
             BETA = BETA*RSAFMN
             ALPHI = ALPHI*RSAFMN
             ALPHR = ALPHR*RSAFMN
-            IF( ABS( BETA ).LT.SAFMIN )
+            IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

diff --git a/lapack-netlib/SRC/clarfgp.f b/lapack-netlib/SRC/clarfgp.f
index d5f19b0..75cfd8c 100644 (file)
--- a/lapack-netlib/SRC/clarfgp.f
+++ b/lapack-netlib/SRC/clarfgp.f
@@ -197,7 +197,7 @@
             BETA = BETA*BIGNUM
             ALPHI = ALPHI*BIGNUM
             ALPHR = ALPHR*BIGNUM
-            IF( ABS( BETA ).LT.SMLNUM )
+            IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000 )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM

diff --git a/lapack-netlib/SRC/dlarfg.f b/lapack-netlib/SRC/dlarfg.f
index cb177a5..aa5fabc 100644 (file)
--- a/lapack-netlib/SRC/dlarfg.f
+++ b/lapack-netlib/SRC/dlarfg.f
@@ -170,7 +170,7 @@
             CALL DSCAL( N-1, RSAFMN, X, INCX )
             BETA = BETA*RSAFMN
             ALPHA = ALPHA*RSAFMN
-            IF( ABS( BETA ).LT.SAFMIN )
+            IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000 )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

diff --git a/lapack-netlib/SRC/dlarfgp.f b/lapack-netlib/SRC/dlarfgp.f
index c05f837..70efabb 100644 (file)
--- a/lapack-netlib/SRC/dlarfgp.f
+++ b/lapack-netlib/SRC/dlarfgp.f
@@ -181,7 +181,7 @@
             CALL DSCAL( N-1, BIGNUM, X, INCX )
             BETA = BETA*BIGNUM
             ALPHA = ALPHA*BIGNUM
-            IF( ABS( BETA ).LT.SMLNUM )
+            IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM

diff --git a/lapack-netlib/SRC/slarfg.f b/lapack-netlib/SRC/slarfg.f
index 638b9ab..d63c4ac 100644 (file)
--- a/lapack-netlib/SRC/slarfg.f
+++ b/lapack-netlib/SRC/slarfg.f
@@ -170,7 +170,7 @@
             CALL SSCAL( N-1, RSAFMN, X, INCX )
             BETA = BETA*RSAFMN
             ALPHA = ALPHA*RSAFMN
-            IF( ABS( BETA ).LT.SAFMIN )
+            IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

diff --git a/lapack-netlib/SRC/slarfgp.f b/lapack-netlib/SRC/slarfgp.f
index 59038df..d63a409 100644 (file)
--- a/lapack-netlib/SRC/slarfgp.f
+++ b/lapack-netlib/SRC/slarfgp.f
@@ -181,7 +181,7 @@
             CALL SSCAL( N-1, BIGNUM, X, INCX )
             BETA = BETA*BIGNUM
             ALPHA = ALPHA*BIGNUM
-            IF( ABS( BETA ).LT.SMLNUM )
+            IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000 )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM

diff --git a/lapack-netlib/SRC/zlarfg.f b/lapack-netlib/SRC/zlarfg.f
index f8a795d..76ca452 100644 (file)
--- a/lapack-netlib/SRC/zlarfg.f
+++ b/lapack-netlib/SRC/zlarfg.f
@@ -175,7 +175,7 @@
             BETA = BETA*RSAFMN
             ALPHI = ALPHI*RSAFMN
             ALPHR = ALPHR*RSAFMN
-            IF( ABS( BETA ).LT.SAFMIN )
+            IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

diff --git a/lapack-netlib/SRC/zlarfgp.f b/lapack-netlib/SRC/zlarfgp.f
index 54ce6e6..32e55ea 100644 (file)
--- a/lapack-netlib/SRC/zlarfgp.f
+++ b/lapack-netlib/SRC/zlarfgp.f
@@ -197,7 +197,7 @@
             BETA = BETA*BIGNUM
             ALPHI = ALPHI*BIGNUM
             ALPHR = ALPHR*BIGNUM
-            IF( ABS( BETA ).LT.SMLNUM )
+            IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM