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
364 EXTERNAL ilaenv, lsame
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...
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.