From 2df1e3372d648eaa16eb8c8278138034608e1d00 Mon Sep 17 00:00:00 2001
From: Martin Kroeker <martin@ruby.chemie.uni-freiburg.de>
Date: Fri, 10 Nov 2017 20:02:21 +0100
Subject: [PATCH] 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.
---
 lapack-netlib/SRC/clarfg.f  | 2 +-
 lapack-netlib/SRC/clarfgp.f | 2 +-
 lapack-netlib/SRC/dlarfg.f  | 2 +-
 lapack-netlib/SRC/dlarfgp.f | 2 +-
 lapack-netlib/SRC/slarfg.f  | 2 +-
 lapack-netlib/SRC/slarfgp.f | 2 +-
 lapack-netlib/SRC/zlarfg.f  | 2 +-
 lapack-netlib/SRC/zlarfgp.f | 2 +-
 8 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/lapack-netlib/SRC/clarfg.f b/lapack-netlib/SRC/clarfg.f
index 05a27a283..4c0c5f715 100644
--- 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 d5f19b041..75cfd8cc2 100644
--- 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 cb177a570..aa5fabc57 100644
--- 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 c05f837ea..70efabbb8 100644
--- 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 638b9ab8f..d63c4ac29 100644
--- 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 59038dfce..d63a409a1 100644
--- 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 f8a795d54..76ca452f6 100644
--- 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 54ce6e63f..32e55ea6c 100644
--- 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