From eea1636380fe6b8462e2ae73cc0e6c3c1aa0e3ce Mon Sep 17 00:00:00 2001
From: Martin Kroeker <martin@ruby.chemie.uni-freiburg.de>
Date: Sun, 20 Nov 2022 13:22:55 +0100
Subject: [PATCH 1/3] Use normwise criterion for INF eigenvalues in QZ
 (Reference-LAPACK PR698)

---
 lapack-netlib/SRC/chgeqz.f | 9 ++-------
 lapack-netlib/SRC/dhgeqz.f | 9 ++-------
 lapack-netlib/SRC/shgeqz.f | 9 ++-------
 lapack-netlib/SRC/zhgeqz.f | 9 ++-------
 4 files changed, 8 insertions(+), 28 deletions(-)

diff --git a/lapack-netlib/SRC/chgeqz.f b/lapack-netlib/SRC/chgeqz.f
index 8c1d62a87..50c6827ff 100644
--- a/lapack-netlib/SRC/chgeqz.f
+++ b/lapack-netlib/SRC/chgeqz.f
@@ -523,9 +523,7 @@
             END IF
          END IF
 *
-         IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*( 
-     $         ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
-     $          ) ) ) ) THEN
+         IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
             T( ILAST, ILAST ) = CZERO
             GO TO 50
          END IF
@@ -551,10 +549,7 @@
 *
 *           Test 2: for T(j,j)=0
 *
-            TEMP = ABS ( T( J, J + 1 ) )
-            IF ( J .GT. ILO )
-     $           TEMP = TEMP + ABS ( T( J - 1, J ) )
-            IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
+            IF( ABS( T( J, J ) ).LT.BTOL ) THEN
                T( J, J ) = CZERO
 *
 *              Test 1a: Check for 2 consecutive small subdiagonals in A
diff --git a/lapack-netlib/SRC/dhgeqz.f b/lapack-netlib/SRC/dhgeqz.f
index 3fe2a083c..b5a2917e3 100644
--- a/lapack-netlib/SRC/dhgeqz.f
+++ b/lapack-netlib/SRC/dhgeqz.f
@@ -536,9 +536,7 @@
             END IF
          END IF
 *
-         IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*( 
-     $         ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
-     $          ) ) ) ) THEN
+         IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
             T( ILAST, ILAST ) = ZERO
             GO TO 70
          END IF
@@ -564,10 +562,7 @@
 *
 *           Test 2: for T(j,j)=0
 *
-            TEMP = ABS ( T( J, J + 1 ) )
-            IF ( J .GT. ILO )
-     $           TEMP = TEMP + ABS ( T( J - 1, J ) )
-            IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
+            IF( ABS( T( J, J ) ).LT.BTOL ) THEN
                T( J, J ) = ZERO
 *
 *              Test 1a: Check for 2 consecutive small subdiagonals in A
diff --git a/lapack-netlib/SRC/shgeqz.f b/lapack-netlib/SRC/shgeqz.f
index 79a9c6092..10fb2b7d7 100644
--- a/lapack-netlib/SRC/shgeqz.f
+++ b/lapack-netlib/SRC/shgeqz.f
@@ -536,9 +536,7 @@
             END IF
          END IF
 *
-         IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*( 
-     $         ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
-     $          ) ) ) ) THEN
+         IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
             T( ILAST, ILAST ) = ZERO
             GO TO 70
          END IF
@@ -564,10 +562,7 @@
 *
 *           Test 2: for T(j,j)=0
 *
-            TEMP = ABS ( T( J, J + 1 ) )
-            IF ( J .GT. ILO )
-     $           TEMP = TEMP + ABS ( T( J - 1, J ) )
-            IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
+            IF( ABS( T( J, J ) ).LT.BTOL ) THEN
                T( J, J ) = ZERO
 *
 *              Test 1a: Check for 2 consecutive small subdiagonals in A
diff --git a/lapack-netlib/SRC/zhgeqz.f b/lapack-netlib/SRC/zhgeqz.f
index 302b69f34..c15e7aace 100644
--- a/lapack-netlib/SRC/zhgeqz.f
+++ b/lapack-netlib/SRC/zhgeqz.f
@@ -524,9 +524,7 @@
             END IF
          END IF
 *
-         IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*( 
-     $         ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
-     $          ) ) ) ) THEN
+         IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
             T( ILAST, ILAST ) = CZERO
             GO TO 50
          END IF
@@ -552,10 +550,7 @@
 *
 *           Test 2: for T(j,j)=0
 *
-            TEMP = ABS ( T( J, J + 1 ) )
-            IF ( J .GT. ILO )
-     $           TEMP = TEMP + ABS ( T( J - 1, J ) )
-            IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
+            IF( ABS( T( J, J ) ).LT.BTOL ) THEN
                T( J, J ) = CZERO
 *
 *              Test 1a: Check for 2 consecutive small subdiagonals in A

From 60af35bfab111416f78db3a7797f2134c7f23ea0 Mon Sep 17 00:00:00 2001
From: Martin Kroeker <martin@ruby.chemie.uni-freiburg.de>
Date: Sun, 20 Nov 2022 13:25:21 +0100
Subject: [PATCH 2/3] Fix workspace query for ?SYEVD and ?HEEVD
 (Reference-LAPACK PR691)

---
 lapack-netlib/SRC/cheevd.f | 2 +-
 lapack-netlib/SRC/dsyevd.f | 2 +-
 lapack-netlib/SRC/ssyevd.f | 2 +-
 lapack-netlib/SRC/zheevd.f | 2 +-
 4 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/lapack-netlib/SRC/cheevd.f b/lapack-netlib/SRC/cheevd.f
index 9a4a1efb7..2ddf74b98 100644
--- a/lapack-netlib/SRC/cheevd.f
+++ b/lapack-netlib/SRC/cheevd.f
@@ -284,7 +284,7 @@
                LIWMIN = 1
             END IF
             LOPT = MAX( LWMIN, N +
-     $                  ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) )
+     $                  N*ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) )
             LROPT = LRWMIN
             LIOPT = LIWMIN
          END IF
diff --git a/lapack-netlib/SRC/dsyevd.f b/lapack-netlib/SRC/dsyevd.f
index edbe896fe..eaaecd8d9 100644
--- a/lapack-netlib/SRC/dsyevd.f
+++ b/lapack-netlib/SRC/dsyevd.f
@@ -257,7 +257,7 @@
                LWMIN = 2*N + 1
             END IF
             LOPT = MAX( LWMIN, 2*N +
-     $                  ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) )
+     $                  N*ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) )
             LIOPT = LIWMIN
          END IF
          WORK( 1 ) = LOPT
diff --git a/lapack-netlib/SRC/ssyevd.f b/lapack-netlib/SRC/ssyevd.f
index 8b90d9263..ac0d0284d 100644
--- a/lapack-netlib/SRC/ssyevd.f
+++ b/lapack-netlib/SRC/ssyevd.f
@@ -255,7 +255,7 @@
                LWMIN = 2*N + 1
             END IF
             LOPT = MAX( LWMIN, 2*N +
-     $                  ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) )
+     $                  N*ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) )
             LIOPT = LIWMIN
          END IF
          WORK( 1 ) = LOPT
diff --git a/lapack-netlib/SRC/zheevd.f b/lapack-netlib/SRC/zheevd.f
index a6484eb03..7f58c7f72 100644
--- a/lapack-netlib/SRC/zheevd.f
+++ b/lapack-netlib/SRC/zheevd.f
@@ -284,7 +284,7 @@
                LIWMIN = 1
             END IF
             LOPT = MAX( LWMIN, N +
-     $                  ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) )
+     $                  N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) )
             LROPT = LRWMIN
             LIOPT = LIWMIN
          END IF

From 3f31b691211a772b61c0e016961e9c0d8f05a02e Mon Sep 17 00:00:00 2001
From: Martin Kroeker <martin@ruby.chemie.uni-freiburg.de>
Date: Sun, 20 Nov 2022 13:30:25 +0100
Subject: [PATCH 3/3] Add quick return if scaling with one (Reference-LAPACK
 PR674)

---
 lapack-netlib/SRC/clascl.f | 2 ++
 lapack-netlib/SRC/dlascl.f | 2 ++
 lapack-netlib/SRC/slascl.f | 2 ++
 lapack-netlib/SRC/zlascl.f | 2 ++
 4 files changed, 8 insertions(+)

diff --git a/lapack-netlib/SRC/clascl.f b/lapack-netlib/SRC/clascl.f
index 399af23a4..f9aace0bc 100644
--- a/lapack-netlib/SRC/clascl.f
+++ b/lapack-netlib/SRC/clascl.f
@@ -272,6 +272,8 @@
          ELSE
             MUL = CTOC / CFROMC
             DONE = .TRUE.
+            IF (MUL .EQ. ONE)
+     $         RETURN
          END IF
       END IF
 *
diff --git a/lapack-netlib/SRC/dlascl.f b/lapack-netlib/SRC/dlascl.f
index 05ad1c4f3..0a4bf21ce 100644
--- a/lapack-netlib/SRC/dlascl.f
+++ b/lapack-netlib/SRC/dlascl.f
@@ -272,6 +272,8 @@
          ELSE
             MUL = CTOC / CFROMC
             DONE = .TRUE.
+            IF (MUL .EQ. ONE)
+     $         RETURN
          END IF
       END IF
 *
diff --git a/lapack-netlib/SRC/slascl.f b/lapack-netlib/SRC/slascl.f
index e1cb420ea..28cbd6514 100644
--- a/lapack-netlib/SRC/slascl.f
+++ b/lapack-netlib/SRC/slascl.f
@@ -272,6 +272,8 @@
          ELSE
             MUL = CTOC / CFROMC
             DONE = .TRUE.
+            IF (MUL .EQ. ONE)
+     $         RETURN
          END IF
       END IF
 *
diff --git a/lapack-netlib/SRC/zlascl.f b/lapack-netlib/SRC/zlascl.f
index 3d53f5ae6..4cce5ff5e 100644
--- a/lapack-netlib/SRC/zlascl.f
+++ b/lapack-netlib/SRC/zlascl.f
@@ -272,6 +272,8 @@
          ELSE
             MUL = CTOC / CFROMC
             DONE = .TRUE.
+            IF (MUL .EQ. ONE)
+     $         RETURN
          END IF
       END IF
 *