Break out of potentially infinite rescaling loop after 1000 iterations

martin-frbg · web-flow · commit 49d10ea305b7 · 2017-11-10T19:48:28.000+01:00
inf values in the input vector will survive rescaling, making the code hang. The limit of 1000 iterations is arbitrarily chosen with the intention to not interfere with regular behaviour.
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. 1000)
      $         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. 1000 )
      $         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. 1000 )
      $         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. 1000)
      $         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. 1000)
      $         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. 1000 )
      $         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. 1000)
      $         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. 1000)
      $         GO TO 10
 *
 *           New BETA is at most 1, at least SMLNUM

Original file line number	Diff line number	Diff line change
`@@ -175,7 +175,7 @@ SUBROUTINE CLARFG( N, ALPHA, X, INCX, TAU )`
`175`	`175`	`BETA = BETA*RSAFMN`
`176`	`176`	`ALPHI = ALPHI*RSAFMN`
`177`	`177`	`ALPHR = ALPHR*RSAFMN`
`178`		`- IF( ABS( BETA ).LT.SAFMIN )`
	`178`	`+ IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000)`
`179`	`179`	`$ GO TO 10`
`180`	`180`	`*`
`181`	`181`	`* New BETA is at most 1, at least SAFMIN`
Original file line number	Diff line number	Diff line change
`@@ -197,7 +197,7 @@ SUBROUTINE CLARFGP( N, ALPHA, X, INCX, TAU )`
`197`	`197`	`BETA = BETA*BIGNUM`
`198`	`198`	`ALPHI = ALPHI*BIGNUM`
`199`	`199`	`ALPHR = ALPHR*BIGNUM`
`200`		`- IF( ABS( BETA ).LT.SMLNUM )`
	`200`	`+ IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000 )`
`201`	`201`	`$ GO TO 10`
`202`	`202`	`*`
`203`	`203`	`* New BETA is at most 1, at least SMLNUM`
Original file line number	Diff line number	Diff line change
`@@ -170,7 +170,7 @@ SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )`
`170`	`170`	`CALL DSCAL( N-1, RSAFMN, X, INCX )`
`171`	`171`	`BETA = BETA*RSAFMN`
`172`	`172`	`ALPHA = ALPHA*RSAFMN`
`173`		`- IF( ABS( BETA ).LT.SAFMIN )`
	`173`	`+ IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000 )`
`174`	`174`	`$ GO TO 10`
`175`	`175`	`*`
`176`	`176`	`* New BETA is at most 1, at least SAFMIN`
Original file line number	Diff line number	Diff line change
`@@ -181,7 +181,7 @@ SUBROUTINE DLARFGP( N, ALPHA, X, INCX, TAU )`
`181`	`181`	`CALL DSCAL( N-1, BIGNUM, X, INCX )`
`182`	`182`	`BETA = BETA*BIGNUM`
`183`	`183`	`ALPHA = ALPHA*BIGNUM`
`184`		`- IF( ABS( BETA ).LT.SMLNUM )`
	`184`	`+ IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000)`
`185`	`185`	`$ GO TO 10`
`186`	`186`	`*`
`187`	`187`	`* New BETA is at most 1, at least SMLNUM`
Original file line number	Diff line number	Diff line change
`@@ -170,7 +170,7 @@ SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )`
`170`	`170`	`CALL SSCAL( N-1, RSAFMN, X, INCX )`
`171`	`171`	`BETA = BETA*RSAFMN`
`172`	`172`	`ALPHA = ALPHA*RSAFMN`
`173`		`- IF( ABS( BETA ).LT.SAFMIN )`
	`173`	`+ IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000)`
`174`	`174`	`$ GO TO 10`
`175`	`175`	`*`
`176`	`176`	`* New BETA is at most 1, at least SAFMIN`
Original file line number	Diff line number	Diff line change
`@@ -181,7 +181,7 @@ SUBROUTINE SLARFGP( N, ALPHA, X, INCX, TAU )`
`181`	`181`	`CALL SSCAL( N-1, BIGNUM, X, INCX )`
`182`	`182`	`BETA = BETA*BIGNUM`
`183`	`183`	`ALPHA = ALPHA*BIGNUM`
`184`		`- IF( ABS( BETA ).LT.SMLNUM )`
	`184`	`+ IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000 )`
`185`	`185`	`$ GO TO 10`
`186`	`186`	`*`
`187`	`187`	`* New BETA is at most 1, at least SMLNUM`
Original file line number	Diff line number	Diff line change
`@@ -175,7 +175,7 @@ SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )`
`175`	`175`	`BETA = BETA*RSAFMN`
`176`	`176`	`ALPHI = ALPHI*RSAFMN`
`177`	`177`	`ALPHR = ALPHR*RSAFMN`
`178`		`- IF( ABS( BETA ).LT.SAFMIN )`
	`178`	`+ IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000)`
`179`	`179`	`$ GO TO 10`
`180`	`180`	`*`
`181`	`181`	`* New BETA is at most 1, at least SAFMIN`
Original file line number	Diff line number	Diff line change
`@@ -197,7 +197,7 @@ SUBROUTINE ZLARFGP( N, ALPHA, X, INCX, TAU )`
`197`	`197`	`BETA = BETA*BIGNUM`
`198`	`198`	`ALPHI = ALPHI*BIGNUM`
`199`	`199`	`ALPHR = ALPHR*BIGNUM`
`200`		`- IF( ABS( BETA ).LT.SMLNUM )`
	`200`	`+ IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000)`
`201`	`201`	`$ GO TO 10`
`202`	`202`	`*`
`203`	`203`	`* New BETA is at most 1, at least SMLNUM`