floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

This commit is contained in:
Martin Kroeker 2022-11-20 19:39:12 +01:00 committed by GitHub
parent 6f09e4c121
commit c6816bb576
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 26 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lapack-netlib/SRC/claqz0.f
View File

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

16
lapack-netlib/SRC/dlaqz0.f
View File

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

17
lapack-netlib/SRC/slaqz0.f
View File

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

17
lapack-netlib/SRC/zlaqz0.f
View File

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