Merge pull request #197 from martin-frbg/infty

Break out of potentially infinite rescaling loop after 1000 iterations
Reference-LAPACK · Nov 12, 2017 · 03f1d35 · 03f1d35
2 parents 88ee750 + d490984
commit 03f1d35
Show file tree

Hide file tree

Showing 8 changed files with 8 additions and 8 deletions.
diff --git a/SRC/clarfg.f b/SRC/clarfg.f
@@ -175,7 +175,7 @@ SUBROUTINE CLARFG( N, ALPHA, X, INCX, TAU )
             BETA = BETA*RSAFMN
             ALPHI = ALPHI*RSAFMN
             ALPHR = ALPHR*RSAFMN
-            IF( ABS( BETA ).LT.SAFMIN )
+            IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

diff --git a/SRC/clarfgp.f b/SRC/clarfgp.f
@@ -197,7 +197,7 @@ SUBROUTINE CLARFGP( N, ALPHA, X, INCX, TAU )
             BETA = BETA*BIGNUM
             ALPHI = ALPHI*BIGNUM
             ALPHR = ALPHR*BIGNUM
-            IF( ABS( BETA ).LT.SMLNUM )
+            IF( (ABS( BETA ).LT.SMLNUM) .AND. (KNT .LT. 20) )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM

diff --git a/SRC/dlarfg.f b/SRC/dlarfg.f
@@ -170,7 +170,7 @@ SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
             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. 20) )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

diff --git a/SRC/dlarfgp.f b/SRC/dlarfgp.f
@@ -181,7 +181,7 @@ SUBROUTINE DLARFGP( N, ALPHA, X, INCX, TAU )
             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. 20) )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM

diff --git a/SRC/slarfg.f b/SRC/slarfg.f
@@ -170,7 +170,7 @@ SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )
             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. 20) )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

diff --git a/SRC/slarfgp.f b/SRC/slarfgp.f
@@ -181,7 +181,7 @@ SUBROUTINE SLARFGP( N, ALPHA, X, INCX, TAU )
             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. 20) )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM

diff --git a/SRC/zlarfg.f b/SRC/zlarfg.f
@@ -175,7 +175,7 @@ SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
             BETA = BETA*RSAFMN
             ALPHI = ALPHI*RSAFMN
             ALPHR = ALPHR*RSAFMN
-            IF( ABS( BETA ).LT.SAFMIN )
+            IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

diff --git a/SRC/zlarfgp.f b/SRC/zlarfgp.f
@@ -197,7 +197,7 @@ SUBROUTINE ZLARFGP( N, ALPHA, X, INCX, TAU )
             BETA = BETA*BIGNUM
             ALPHI = ALPHI*BIGNUM
             ALPHR = ALPHR*BIGNUM
-            IF( ABS( BETA ).LT.SMLNUM )
+            IF( (ABS( BETA ).LT.SMLNUM) .AND. (KNT .LT. 20) )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM