|
version 1.16, 2017/06/17 10:53:53
|
version 1.20, 2023/08/07 08:38:54
|
|
Line 150
|
Line 150
|
| *> \param[out] INFO |
*> \param[out] INFO |
| *> \verbatim |
*> \verbatim |
| *> INFO is INTEGER |
*> INFO is INTEGER |
| *> = 0: successful exit |
*> = 0: successful exit |
| *> .GT. 0: If INFO = i, DLAHQR failed to compute all the |
*> > 0: If INFO = i, DLAHQR failed to compute all the |
| *> eigenvalues ILO to IHI in a total of 30 iterations |
*> eigenvalues ILO to IHI in a total of 30 iterations |
| *> per eigenvalue; elements i+1:ihi of WR and WI |
*> per eigenvalue; elements i+1:ihi of WR and WI |
| *> contain those eigenvalues which have been |
*> contain those eigenvalues which have been |
| *> successfully computed. |
*> successfully computed. |
| *> |
*> |
| *> If INFO .GT. 0 and WANTT is .FALSE., then on exit, |
*> If INFO > 0 and WANTT is .FALSE., then on exit, |
| *> the remaining unconverged eigenvalues are the |
*> the remaining unconverged eigenvalues are the |
| *> eigenvalues of the upper Hessenberg matrix rows |
*> eigenvalues of the upper Hessenberg matrix rows |
| *> and columns ILO thorugh INFO of the final, output |
*> and columns ILO through INFO of the final, output |
| *> value of H. |
*> value of H. |
| *> |
*> |
| *> If INFO .GT. 0 and WANTT is .TRUE., then on exit |
*> If INFO > 0 and WANTT is .TRUE., then on exit |
| *> (*) (initial value of H)*U = U*(final value of H) |
*> (*) (initial value of H)*U = U*(final value of H) |
| *> where U is an orthognal matrix. The final |
*> where U is an orthogonal matrix. The final |
| *> value of H is upper Hessenberg and triangular in |
*> value of H is upper Hessenberg and triangular in |
| *> rows and columns INFO+1 through IHI. |
*> rows and columns INFO+1 through IHI. |
| *> |
*> |
| *> If INFO .GT. 0 and WANTZ is .TRUE., then on exit |
*> If INFO > 0 and WANTZ is .TRUE., then on exit |
| *> (final value of Z) = (initial value of Z)*U |
*> (final value of Z) = (initial value of Z)*U |
| *> where U is the orthogonal matrix in (*) |
*> where U is the orthogonal matrix in (*) |
| *> (regardless of the value of WANTT.) |
*> (regardless of the value of WANTT.) |
|
Line 183
|
Line 183
|
| *> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
| *> \author NAG Ltd. |
*> \author NAG Ltd. |
| * |
* |
| *> \date December 2016 |
|
| * |
|
| *> \ingroup doubleOTHERauxiliary |
*> \ingroup doubleOTHERauxiliary |
| * |
* |
| *> \par Further Details: |
*> \par Further Details: |
|
Line 206
|
Line 204
|
| * ===================================================================== |
* ===================================================================== |
| SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, |
SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, |
| $ ILOZ, IHIZ, Z, LDZ, INFO ) |
$ ILOZ, 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 227
|
Line 225
|
| PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0, TWO = 2.0d0 ) |
PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0, TWO = 2.0d0 ) |
| DOUBLE PRECISION DAT1, DAT2 |
DOUBLE PRECISION DAT1, DAT2 |
| PARAMETER ( DAT1 = 3.0d0 / 4.0d0, DAT2 = -0.4375d0 ) |
PARAMETER ( DAT1 = 3.0d0 / 4.0d0, DAT2 = -0.4375d0 ) |
| |
INTEGER KEXSH |
| |
PARAMETER ( KEXSH = 10 ) |
| * .. |
* .. |
| * .. Local Scalars .. |
* .. Local Scalars .. |
| DOUBLE PRECISION AA, AB, BA, BB, CS, DET, H11, H12, H21, H21S, |
DOUBLE PRECISION AA, AB, BA, BB, CS, DET, H11, H12, H21, H21S, |
| $ H22, RT1I, RT1R, RT2I, RT2R, RTDISC, S, SAFMAX, |
$ H22, RT1I, RT1R, RT2I, RT2R, RTDISC, S, SAFMAX, |
| $ SAFMIN, SMLNUM, SN, SUM, T1, T2, T3, TR, TST, |
$ SAFMIN, SMLNUM, SN, SUM, T1, T2, T3, TR, TST, |
| $ ULP, V2, V3 |
$ ULP, V2, V3 |
| INTEGER I, I1, I2, ITS, ITMAX, J, K, L, M, NH, NR, NZ |
INTEGER I, I1, I2, ITS, ITMAX, J, K, L, M, NH, NR, NZ, |
| |
$ KDEFL |
| * .. |
* .. |
| * .. Local Arrays .. |
* .. Local Arrays .. |
| DOUBLE PRECISION V( 3 ) |
DOUBLE PRECISION V( 3 ) |
|
Line 294
|
Line 295
|
| * |
* |
| 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 or 2. Each iteration of the loop works |
* IHI to ILO in steps of 1 or 2. 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 353
|
Line 358
|
| * |
* |
| IF( L.GE.I-1 ) |
IF( L.GE.I-1 ) |
| $ GO TO 150 |
$ GO TO 150 |
| |
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 363
|
Line 369
|
| 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 = ABS( H( L+1, L ) ) + ABS( H( L+2, L+1 ) ) |
S = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) ) |
| H11 = DAT1*S + H( L, L ) |
H11 = DAT1*S + H( I, I ) |
| H12 = DAT2*S |
H12 = DAT2*S |
| H21 = S |
H21 = S |
| H22 = H11 |
H22 = H11 |
| ELSE IF( ITS.EQ.20 ) THEN |
ELSE IF( MOD(KDEFL,KEXSH).EQ.0 ) THEN |
| * |
* |
| * Exceptional shift. |
* Exceptional shift. |
| * |
* |
| S = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) ) |
S = ABS( H( L+1, L ) ) + ABS( H( L+2, L+1 ) ) |
| H11 = DAT1*S + H( I, I ) |
H11 = DAT1*S + H( L, L ) |
| H12 = DAT2*S |
H12 = DAT2*S |
| H21 = S |
H21 = S |
| H22 = H11 |
H22 = H11 |
|
Line 599
|
Line 605
|
| CALL DROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, SN ) |
CALL DROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, SN ) |
| END IF |
END IF |
| END IF |
END IF |
| |
* 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. |
| * |
* |
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlahqr.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack