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] 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