Merge pull request #1356 from martin-frbg/lapack-issue196

Break out of potentially infinite rescaling loop after 1000 iterations

Author: martin-frbg

lapack-netlib/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. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

lapack-netlib/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. 1000 )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM

lapack-netlib/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. 1000 )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

lapack-netlib/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. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM

lapack-netlib/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. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

lapack-netlib/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. 1000 )
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM

lapack-netlib/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. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SAFMIN

lapack-netlib/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. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM