Merge pull request #2648 from martin-frbg/lapack411

Break out of potentially infinite rescaling loop in LAPACK xLARGV/xLARTG/xLARTGP
OpenMathLib · Jun 7, 2020 · 430e8b4 · 430e8b4
2 parents 88fe85f + 522aaf5
commit 430e8b4
Show file tree

Hide file tree

Showing 8 changed files with 8 additions and 8 deletions.
diff --git a/lapack-netlib/SRC/clargv.f b/lapack-netlib/SRC/clargv.f
@@ -200,7 +200,7 @@ SUBROUTINE CLARGV( N, X, INCX, Y, INCY, C, INCC )
             FS = FS*SAFMN2
             GS = GS*SAFMN2
             SCALE = SCALE*SAFMN2
-            IF( SCALE.GE.SAFMX2 )
+            IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20 )
      $         GO TO 10
          ELSE IF( SCALE.LE.SAFMN2 ) THEN
             IF( G.EQ.CZERO ) THEN

diff --git a/lapack-netlib/SRC/clartg.f b/lapack-netlib/SRC/clartg.f
@@ -161,7 +161,7 @@ SUBROUTINE CLARTG( F, G, CS, SN, R )
          FS = FS*SAFMN2
          GS = GS*SAFMN2
          SCALE = SCALE*SAFMN2
-         IF( SCALE.GE.SAFMX2 )
+         IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20)
      $      GO TO 10
       ELSE IF( SCALE.LE.SAFMN2 ) THEN
          IF( G.EQ.CZERO.OR.SISNAN( ABS( G ) ) ) THEN

diff --git a/lapack-netlib/SRC/dlartg.f b/lapack-netlib/SRC/dlartg.f
@@ -163,7 +163,7 @@ SUBROUTINE DLARTG( F, G, CS, SN, R )
             F1 = F1*SAFMN2
             G1 = G1*SAFMN2
             SCALE = MAX( ABS( F1 ), ABS( G1 ) )
-            IF( SCALE.GE.SAFMX2 )
+            IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20)
      $         GO TO 10
             R = SQRT( F1**2+G1**2 )
             CS = F1 / R

diff --git a/lapack-netlib/SRC/dlartgp.f b/lapack-netlib/SRC/dlartgp.f
@@ -161,7 +161,7 @@ SUBROUTINE DLARTGP( F, G, CS, SN, R )
             F1 = F1*SAFMN2
             G1 = G1*SAFMN2
             SCALE = MAX( ABS( F1 ), ABS( G1 ) )
-            IF( SCALE.GE.SAFMX2 )
+            IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20 )
      $         GO TO 10
             R = SQRT( F1**2+G1**2 )
             CS = F1 / R

diff --git a/lapack-netlib/SRC/slartg.f b/lapack-netlib/SRC/slartg.f
@@ -163,7 +163,7 @@ SUBROUTINE SLARTG( F, G, CS, SN, R )
             F1 = F1*SAFMN2
             G1 = G1*SAFMN2
             SCALE = MAX( ABS( F1 ), ABS( G1 ) )
-            IF( SCALE.GE.SAFMX2 )
+            IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20)
      $         GO TO 10
             R = SQRT( F1**2+G1**2 )
             CS = F1 / R

diff --git a/lapack-netlib/SRC/slartgp.f b/lapack-netlib/SRC/slartgp.f
@@ -161,7 +161,7 @@ SUBROUTINE SLARTGP( F, G, CS, SN, R )
             F1 = F1*SAFMN2
             G1 = G1*SAFMN2
             SCALE = MAX( ABS( F1 ), ABS( G1 ) )
-            IF( SCALE.GE.SAFMX2 )
+            IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20)
      $         GO TO 10
             R = SQRT( F1**2+G1**2 )
             CS = F1 / R

diff --git a/lapack-netlib/SRC/zlargv.f b/lapack-netlib/SRC/zlargv.f
@@ -201,7 +201,7 @@ SUBROUTINE ZLARGV( N, X, INCX, Y, INCY, C, INCC )
             FS = FS*SAFMN2
             GS = GS*SAFMN2
             SCALE = SCALE*SAFMN2
-            IF( SCALE.GE.SAFMX2 )
+            IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20 )
      $         GO TO 10
          ELSE IF( SCALE.LE.SAFMN2 ) THEN
             IF( G.EQ.CZERO ) THEN

diff --git a/lapack-netlib/SRC/zlartg.f b/lapack-netlib/SRC/zlartg.f
@@ -161,7 +161,7 @@ SUBROUTINE ZLARTG( F, G, CS, SN, R )
          FS = FS*SAFMN2
          GS = GS*SAFMN2
          SCALE = SCALE*SAFMN2
-         IF( SCALE.GE.SAFMX2 )
+         IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20 )
      $      GO TO 10
       ELSE IF( SCALE.LE.SAFMN2 ) THEN
          IF( G.EQ.CZERO.OR.DISNAN( ABS( G ) ) ) THEN