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 )
350 parameter ( nl = 49 )
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
364 EXTERNAL ilaenv, lsame
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 dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
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 dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
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...