version 1.19, 2020/05/21 21:46:07
|
version 1.20, 2023/08/07 08:39:29
|
Line 171
|
Line 171
|
*> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
*> \author NAG Ltd. |
*> \author NAG Ltd. |
* |
* |
*> \date December 2016 |
|
* |
|
*> \ingroup complex16OTHERauxiliary |
*> \ingroup complex16OTHERauxiliary |
* |
* |
*> \par Contributors: |
*> \par Contributors: |
Line 194
|
Line 192
|
* ===================================================================== |
* ===================================================================== |
SUBROUTINE ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, |
SUBROUTINE ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, |
$ IHIZ, Z, LDZ, INFO ) |
$ IHIZ, Z, LDZ, INFO ) |
|
IMPLICIT NONE |
* |
* |
* -- LAPACK auxiliary routine (version 3.7.0) -- |
* -- LAPACK auxiliary routine -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* December 2016 |
|
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N |
INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N |
Line 218
|
Line 216
|
PARAMETER ( RZERO = 0.0d0, RONE = 1.0d0, HALF = 0.5d0 ) |
PARAMETER ( RZERO = 0.0d0, RONE = 1.0d0, HALF = 0.5d0 ) |
DOUBLE PRECISION DAT1 |
DOUBLE PRECISION DAT1 |
PARAMETER ( DAT1 = 3.0d0 / 4.0d0 ) |
PARAMETER ( DAT1 = 3.0d0 / 4.0d0 ) |
|
INTEGER KEXSH |
|
PARAMETER ( KEXSH = 10 ) |
* .. |
* .. |
* .. Local Scalars .. |
* .. Local Scalars .. |
COMPLEX*16 CDUM, H11, H11S, H22, SC, SUM, T, T1, TEMP, U, |
COMPLEX*16 CDUM, H11, H11S, H22, SC, SUM, T, T1, TEMP, U, |
Line 225
|
Line 225
|
DOUBLE PRECISION AA, AB, BA, BB, H10, H21, RTEMP, S, SAFMAX, |
DOUBLE PRECISION AA, AB, BA, BB, H10, H21, RTEMP, S, SAFMAX, |
$ SAFMIN, SMLNUM, SX, T2, TST, ULP |
$ SAFMIN, SMLNUM, SX, T2, TST, ULP |
INTEGER I, I1, I2, ITS, ITMAX, J, JHI, JLO, K, L, M, |
INTEGER I, I1, I2, ITS, ITMAX, J, JHI, JLO, K, L, M, |
$ NH, NZ |
$ NH, NZ, KDEFL |
* .. |
* .. |
* .. Local Arrays .. |
* .. Local Arrays .. |
COMPLEX*16 V( 2 ) |
COMPLEX*16 V( 2 ) |
Line 315
|
Line 315
|
* |
* |
ITMAX = 30 * MAX( 10, NH ) |
ITMAX = 30 * MAX( 10, NH ) |
* |
* |
|
* KDEFL counts the number of iterations since a deflation |
|
* |
|
KDEFL = 0 |
|
* |
* The main loop begins here. I is the loop index and decreases from |
* The main loop begins here. I is the loop index and decreases from |
* IHI to ILO in steps of 1. Each iteration of the loop works |
* IHI to ILO in steps of 1. Each iteration of the loop works |
* with the active submatrix in rows and columns L to I. |
* with the active submatrix in rows and columns L to I. |
Line 374
|
Line 378
|
* |
* |
IF( L.GE.I ) |
IF( L.GE.I ) |
$ GO TO 140 |
$ GO TO 140 |
|
KDEFL = KDEFL + 1 |
* |
* |
* Now the active submatrix is in rows and columns L to I. If |
* Now the active submatrix is in rows and columns L to I. If |
* eigenvalues only are being computed, only the active submatrix |
* eigenvalues only are being computed, only the active submatrix |
Line 384
|
Line 389
|
I2 = I |
I2 = I |
END IF |
END IF |
* |
* |
IF( ITS.EQ.10 ) THEN |
IF( MOD(KDEFL,2*KEXSH).EQ.0 ) THEN |
* |
* |
* Exceptional shift. |
* Exceptional shift. |
* |
* |
S = DAT1*ABS( DBLE( H( L+1, L ) ) ) |
S = DAT1*ABS( DBLE( H( I, I-1 ) ) ) |
T = S + H( L, L ) |
T = S + H( I, I ) |
ELSE IF( ITS.EQ.20 ) THEN |
ELSE IF( MOD(KDEFL,KEXSH).EQ.0 ) THEN |
* |
* |
* Exceptional shift. |
* Exceptional shift. |
* |
* |
S = DAT1*ABS( DBLE( H( I, I-1 ) ) ) |
S = DAT1*ABS( DBLE( H( L+1, L ) ) ) |
T = S + H( I, I ) |
T = S + H( L, L ) |
ELSE |
ELSE |
* |
* |
* Wilkinson's shift. |
* Wilkinson's shift. |
Line 557
|
Line 562
|
* H(I,I-1) is negligible: one eigenvalue has converged. |
* H(I,I-1) is negligible: one eigenvalue has converged. |
* |
* |
W( I ) = H( I, I ) |
W( I ) = H( I, I ) |
|
* reset deflation counter |
|
KDEFL = 0 |
* |
* |
* return to start of the main loop with new value of I. |
* return to start of the main loop with new value of I. |
* |
* |