Use normwise criterion in multishift QZ (Reference-LAPACK PR698)

lapack-netlib/SRC/claqz0.f

@@ -299,7 +299,7 @@
       PARAMETER( ZERO = 0.0, ONE = 1.0, HALF = 0.5 )
 
 *     Local scalars
-      REAL :: SMLNUM, ULP, SAFMIN, SAFMAX, C1, TEMPR
+      REAL :: SMLNUM, ULP, SAFMIN, SAFMAX, C1, TEMPR, BNORM, BTOL
       COMPLEX :: ESHIFT, S1, TEMP
       INTEGER :: ISTART, ISTOP, IITER, MAXIT, ISTART2, K, LD, NSHIFTS,
      $           NBLOCK, NW, NMIN, NIBBLE, N_UNDEFLATED, N_DEFLATED,
@@ -312,7 +312,7 @@
 *     External Functions
       EXTERNAL :: XERBLA, CHGEQZ, CLAQZ2, CLAQZ3, CLASET, SLABAD,
      $            CLARTG, CROT
-      REAL, EXTERNAL :: SLAMCH
+      REAL, EXTERNAL :: SLAMCH, CLANHS
       LOGICAL, EXTERNAL :: LSAME
       INTEGER, EXTERNAL :: ILAENV
 
@@ -466,6 +466,9 @@
       ULP = SLAMCH( 'PRECISION' )
       SMLNUM = SAFMIN*( REAL( N )/ULP )
 
+      BNORM = CLANHS( 'F', IHI-ILO+1, B( ILO, ILO ), LDB, RWORK )
+      BTOL = MAX( SAFMIN, ULP*BNORM )
+
       ISTART = ILO
       ISTOP = IHI
       MAXIT = 30*( IHI-ILO+1 )
@@ -528,15 +531,8 @@
 *        slow down the method when many infinite eigenvalues are present
          K = ISTOP
          DO WHILE ( K.GE.ISTART2 )
-            TEMPR = ZERO
-            IF( K .LT. ISTOP ) THEN
-               TEMPR = TEMPR+ABS( B( K, K+1 ) )
-            END IF
-            IF( K .GT. ISTART2 ) THEN
-               TEMPR = TEMPR+ABS( B( K-1, K ) )
-            END IF
 
-            IF( ABS( B( K, K ) ) .LT. MAX( SMLNUM, ULP*TEMPR ) ) THEN
+            IF( ABS( B( K, K ) ) .LT. BTOL ) THEN
 *              A diagonal element of B is negligable, move it
 *              to the top and deflate it
                

lapack-netlib/SRC/dlaqz0.f

@@ -322,7 +322,7 @@
 
 *     Local scalars
       DOUBLE PRECISION :: SMLNUM, ULP, ESHIFT, SAFMIN, SAFMAX, C1, S1,
-     $                    TEMP, SWAP
+     $                    TEMP, SWAP, BNORM, BTOL
       INTEGER :: ISTART, ISTOP, IITER, MAXIT, ISTART2, K, LD, NSHIFTS,
      $           NBLOCK, NW, NMIN, NIBBLE, N_UNDEFLATED, N_DEFLATED,
      $           NS, SWEEP_INFO, SHIFTPOS, LWORKREQ, K2, ISTARTM,
@@ -334,7 +334,7 @@
 *     External Functions
       EXTERNAL :: XERBLA, DHGEQZ, DLASET, DLAQZ3, DLAQZ4, DLABAD,
      $            DLARTG, DROT
-      DOUBLE PRECISION, EXTERNAL :: DLAMCH
+      DOUBLE PRECISION, EXTERNAL :: DLAMCH, DLANHS
       LOGICAL, EXTERNAL :: LSAME
       INTEGER, EXTERNAL :: ILAENV
 
@@ -486,6 +486,9 @@
       ULP = DLAMCH( 'PRECISION' )
       SMLNUM = SAFMIN*( DBLE( N )/ULP )
 
+      BNORM = DLANHS( 'F', IHI-ILO+1, B( ILO, ILO ), LDB, WORK )
+      BTOL = MAX( SAFMIN, ULP*BNORM )
+
       ISTART = ILO
       ISTOP = IHI
       MAXIT = 3*( IHI-ILO+1 )
@@ -562,15 +565,8 @@
 *        slow down the method when many infinite eigenvalues are present
          K = ISTOP
          DO WHILE ( K.GE.ISTART2 )
-            TEMP = ZERO
-            IF( K .LT. ISTOP ) THEN
-               TEMP = TEMP+ABS( B( K, K+1 ) )
-            END IF
-            IF( K .GT. ISTART2 ) THEN
-               TEMP = TEMP+ABS( B( K-1, K ) )
-            END IF
 
-            IF( ABS( B( K, K ) ) .LT. MAX( SMLNUM, ULP*TEMP ) ) THEN
+            IF( ABS( B( K, K ) ) .LT. BTOL ) THEN
 *              A diagonal element of B is negligable, move it
 *              to the top and deflate it
                

lapack-netlib/SRC/slaqz0.f

@@ -318,7 +318,8 @@
       PARAMETER( ZERO = 0.0, ONE = 1.0, HALF = 0.5 )
 
 *     Local scalars
-      REAL :: SMLNUM, ULP, ESHIFT, SAFMIN, SAFMAX, C1, S1, TEMP, SWAP
+      REAL :: SMLNUM, ULP, ESHIFT, SAFMIN, SAFMAX, C1, S1, TEMP, SWAP,
+     $        BNORM, BTOL 
       INTEGER :: ISTART, ISTOP, IITER, MAXIT, ISTART2, K, LD, NSHIFTS,
      $           NBLOCK, NW, NMIN, NIBBLE, N_UNDEFLATED, N_DEFLATED,
      $           NS, SWEEP_INFO, SHIFTPOS, LWORKREQ, K2, ISTARTM,
@@ -330,7 +331,7 @@
 *     External Functions
       EXTERNAL :: XERBLA, SHGEQZ, SLAQZ3, SLAQZ4, SLASET, SLABAD,
      $            SLARTG, SROT
-      REAL, EXTERNAL :: SLAMCH
+      REAL, EXTERNAL :: SLAMCH, SLANHS
       LOGICAL, EXTERNAL :: LSAME
       INTEGER, EXTERNAL :: ILAENV
 
@@ -482,6 +483,9 @@
       ULP = SLAMCH( 'PRECISION' )
       SMLNUM = SAFMIN*( REAL( N )/ULP )
 
+      BNORM = SLANHS( 'F', IHI-ILO+1, B( ILO, ILO ), LDB, WORK )
+      BTOL = MAX( SAFMIN, ULP*BNORM )
+
       ISTART = ILO
       ISTOP = IHI
       MAXIT = 3*( IHI-ILO+1 )
@@ -558,15 +562,8 @@
 *        slow down the method when many infinite eigenvalues are present
          K = ISTOP
          DO WHILE ( K.GE.ISTART2 )
-            TEMP = ZERO
-            IF( K .LT. ISTOP ) THEN
-               TEMP = TEMP+ABS( B( K, K+1 ) )
-            END IF
-            IF( K .GT. ISTART2 ) THEN
-               TEMP = TEMP+ABS( B( K-1, K ) )
-            END IF
 
-            IF( ABS( B( K, K ) ) .LT. MAX( SMLNUM, ULP*TEMP ) ) THEN
+            IF( ABS( B( K, K ) ) .LT. BTOL ) THEN
 *              A diagonal element of B is negligable, move it
 *              to the top and deflate it
                

lapack-netlib/SRC/zlaqz0.f

@@ -300,7 +300,8 @@
       PARAMETER( ZERO = 0.0D0, ONE = 1.0D0, HALF = 0.5D0 )
 
 *     Local scalars
-      DOUBLE PRECISION :: SMLNUM, ULP, SAFMIN, SAFMAX, C1, TEMPR
+      DOUBLE PRECISION :: SMLNUM, ULP, SAFMIN, SAFMAX, C1, TEMPR,
+     $                    BNORM, BTOL
       COMPLEX*16 :: ESHIFT, S1, TEMP
       INTEGER :: ISTART, ISTOP, IITER, MAXIT, ISTART2, K, LD, NSHIFTS,
      $           NBLOCK, NW, NMIN, NIBBLE, N_UNDEFLATED, N_DEFLATED,
@@ -313,7 +314,7 @@
 *     External Functions
       EXTERNAL :: XERBLA, ZHGEQZ, ZLAQZ2, ZLAQZ3, ZLASET, DLABAD,
      $            ZLARTG, ZROT
-      DOUBLE PRECISION, EXTERNAL :: DLAMCH
+      DOUBLE PRECISION, EXTERNAL :: DLAMCH, ZLANHS
       LOGICAL, EXTERNAL :: LSAME
       INTEGER, EXTERNAL :: ILAENV
 
@@ -467,6 +468,9 @@
       ULP = DLAMCH( 'PRECISION' )
       SMLNUM = SAFMIN*( DBLE( N )/ULP )
 
+      BNORM = ZLANHS( 'F', IHI-ILO+1, B( ILO, ILO ), LDB, RWORK )
+      BTOL = MAX( SAFMIN, ULP*BNORM )
+
       ISTART = ILO
       ISTOP = IHI
       MAXIT = 30*( IHI-ILO+1 )
@@ -529,15 +533,8 @@
 *        slow down the method when many infinite eigenvalues are present
          K = ISTOP
          DO WHILE ( K.GE.ISTART2 )
-            TEMPR = ZERO
-            IF( K .LT. ISTOP ) THEN
-               TEMPR = TEMPR+ABS( B( K, K+1 ) )
-            END IF
-            IF( K .GT. ISTART2 ) THEN
-               TEMPR = TEMPR+ABS( B( K-1, K ) )
-            END IF
 
-            IF( ABS( B( K, K ) ) .LT. MAX( SMLNUM, ULP*TEMPR ) ) THEN
+            IF( ABS( B( K, K ) ) .LT. BTOL ) THEN
 *              A diagonal element of B is negligable, move it
 *              to the top and deflate it