316 SUBROUTINE shseqr( 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 REAL h( ldh, * ), wi( * ), work( * ), wr( * ),
341 parameter( ntiny = 11 )
352 parameter( zero = 0.0e0, one = 1.0e0 )
355 REAL hl( nl, nl ), workl( nl )
358 INTEGER i, kbot, nmin
359 LOGICAL initz, lquery, wantt, wantz
370 INTRINSIC max, min, real
376 wantt =
lsame( job,
'S' )
377 initz =
lsame( compz,
'I' )
378 wantz = initz .OR.
lsame( compz,
'V' )
379 work( 1 ) =
REAL( 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(
'SHSEQR', -info )
408 ELSE IF( n.EQ.0 )
THEN
414 ELSE IF( lquery )
THEN
418 CALL
slaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi, ilo,
419 $ ihi, z, ldz, work, lwork, info )
422 work( 1 ) = max(
REAL( MAX( 1, N ) ), work( 1 ) )
441 $ CALL
slaset(
'A', n, n, zero, one, z, ldz )
445 IF( ilo.EQ.ihi )
THEN
446 wr( ilo ) = h( ilo, ilo )
453 nmin =
ilaenv( 12,
'SHSEQR', job( : 1 ) // compz( : 1 ), n,
455 nmin = max( ntiny, nmin )
460 CALL
slaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi, ilo,
461 $ ihi, z, ldz, work, lwork, info )
466 CALL
slahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi, ilo,
467 $ ihi, z, ldz, info )
481 CALL
slaqr0( wantt, wantz, n, ilo, kbot, h, ldh, wr,
482 $ wi, ilo, ihi, z, ldz, work, lwork, info )
491 CALL
slacpy(
'A', n, n, h, ldh, hl, nl )
493 CALL
slaset(
'A', nl, nl-n, zero, zero, hl( 1, n+1 ),
495 CALL
slaqr0( 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
slacpy(
'A', n, n, hl, nl, h, ldh )
505 IF( ( wantt .OR. info.NE.0 ) .AND. n.GT.2 )
506 $ CALL
slaset(
'L', n-2, n-2, zero, zero, h( 3, 1 ), ldh )
511 work( 1 ) = max(
REAL( MAX( 1, N ) ), work( 1 ) )
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
LOGICAL function lsame(CA, CB)
LSAME
subroutine slaqr0(WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO)
SLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur de...
subroutine slahqr(WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILOZ, IHIZ, Z, LDZ, INFO)
SLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)