316 SUBROUTINE dhseqr( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z,
317 $ ldz, work, lwork, info )
325 INTEGER ihi, ilo, info, ldh, ldz, lwork, n
329 DOUBLE PRECISION h( ldh, * ), wi( * ), work( * ), wr( * ),
341 parameter( ntiny = 11 )
351 DOUBLE PRECISION zero, one
352 parameter( zero = 0.0d0, one = 1.0d0 )
355 DOUBLE PRECISION hl( nl, nl ), workl( nl )
358 INTEGER i, kbot, nmin
359 LOGICAL initz, lquery, wantt, wantz
370 INTRINSIC dble, max, min
376 wantt =
lsame( job,
'S' )
377 initz =
lsame( compz,
'I' )
378 wantz = initz .OR.
lsame( compz,
'V' )
379 work( 1 ) = dble( max( 1, n ) )
383 IF( .NOT.
lsame( job,
'E' ) .AND. .NOT.wantt )
THEN
385 ELSE IF( .NOT.
lsame( compz,
'N' ) .AND. .NOT.wantz )
THEN
387 ELSE IF( n.LT.0 )
THEN
389 ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) )
THEN
391 ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n )
THEN
393 ELSE IF( ldh.LT.max( 1, n ) )
THEN
395 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.max( 1, n ) ) )
THEN
397 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
405 CALL
xerbla(
'DHSEQR', -info )
408 ELSE IF( n.EQ.0 )
THEN
414 ELSE IF( lquery )
THEN
418 CALL
dlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi, ilo,
419 $ ihi, z, ldz, work, lwork, info )
422 work( 1 ) = max( dble( max( 1, n ) ), work( 1 ) )
441 $ CALL
dlaset(
'A', n, n, zero, one, z, ldz )
445 IF( ilo.EQ.ihi )
THEN
446 wr( ilo ) = h( ilo, ilo )
453 nmin =
ilaenv( 12,
'DHSEQR', job( : 1 ) // compz( : 1 ), n,
455 nmin = max( ntiny, nmin )
460 CALL
dlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi, ilo,
461 $ ihi, z, ldz, work, lwork, info )
466 CALL
dlahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi, ilo,
467 $ ihi, z, ldz, info )
481 CALL
dlaqr0( wantt, wantz, n, ilo, kbot, h, ldh, wr,
482 $ wi, ilo, ihi, z, ldz, work, lwork, info )
491 CALL
dlacpy(
'A', n, n, h, ldh, hl, nl )
493 CALL
dlaset(
'A', nl, nl-n, zero, zero, hl( 1, n+1 ),
495 CALL
dlaqr0( wantt, wantz, nl, ilo, kbot, hl, nl, wr,
496 $ wi, ilo, ihi, z, ldz, workl, nl, info )
497 IF( wantt .OR. info.NE.0 )
498 $ CALL
dlacpy(
'A', n, n, hl, nl, h, ldh )
505 IF( ( wantt .OR. info.NE.0 ) .AND. n.GT.2 )
506 $ CALL
dlaset(
'L', n-2, n-2, zero, zero, h( 3, 1 ), ldh )
511 work( 1 ) = max( dble( max( 1, n ) ), work( 1 ) )
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
LOGICAL function lsame(CA, CB)
LSAME
subroutine dlaqr0(WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO)
DLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur de...
subroutine dlahqr(WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILOZ, IHIZ, Z, LDZ, INFO)
DLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm.
subroutine xerbla(SRNAME, INFO)
XERBLA
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...