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 )
350 parameter ( nl = 49 )
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 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 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 slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
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 shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR