299 SUBROUTINE zhseqr( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
300 $ work, lwork, info )
308 INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
312 COMPLEX*16 H( ldh, * ), W( * ), WORK( * ), Z( ldz, * )
323 parameter( ntiny = 11 )
334 parameter( zero = ( 0.0d0, 0.0d0 ),
335 $ one = ( 1.0d0, 0.0d0 ) )
336 DOUBLE PRECISION RZERO
337 parameter( rzero = 0.0d0 )
340 COMPLEX*16 HL( nl, nl ), WORKL( nl )
344 LOGICAL INITZ, LQUERY, WANTT, WANTZ
349 EXTERNAL ilaenv, lsame
355 INTRINSIC dble, dcmplx, max, min
361 wantt = lsame( job,
'S' )
362 initz = lsame( compz,
'I' )
363 wantz = initz .OR. lsame( compz,
'V' )
364 work( 1 ) = dcmplx( dble( max( 1, n ) ), rzero )
368 IF( .NOT.lsame( job,
'E' ) .AND. .NOT.wantt )
THEN
370 ELSE IF( .NOT.lsame( compz,
'N' ) .AND. .NOT.wantz )
THEN
372 ELSE IF( n.LT.0 )
THEN
374 ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) )
THEN
376 ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n )
THEN
378 ELSE IF( ldh.LT.max( 1, n ) )
THEN
380 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.max( 1, n ) ) )
THEN
382 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
390 CALL
xerbla(
'ZHSEQR', -info )
393 ELSE IF( n.EQ.0 )
THEN
399 ELSE IF( lquery )
THEN
403 CALL
zlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi, z,
404 $ ldz, work, lwork, info )
407 work( 1 ) = dcmplx( max( dble( work( 1 ) ), dble( max( 1,
416 $ CALL
zcopy( ilo-1, h, ldh+1, w, 1 )
418 $ CALL
zcopy( n-ihi, h( ihi+1, ihi+1 ), ldh+1, w( ihi+1 ), 1 )
423 $ CALL
zlaset(
'A', n, n, zero, one, z, ldz )
427 IF( ilo.EQ.ihi )
THEN
428 w( ilo ) = h( ilo, ilo )
434 nmin = ilaenv( 12,
'ZHSEQR', job( : 1 ) // compz( : 1 ), n,
436 nmin = max( ntiny, nmin )
441 CALL
zlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
442 $ z, ldz, work, lwork, info )
447 CALL
zlahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
462 CALL
zlaqr0( wantt, wantz, n, ilo, kbot, h, ldh, w,
463 $ ilo, ihi, z, ldz, work, lwork, info )
472 CALL
zlacpy(
'A', n, n, h, ldh, hl, nl )
474 CALL
zlaset(
'A', nl, nl-n, zero, zero, hl( 1, n+1 ),
476 CALL
zlaqr0( wantt, wantz, nl, ilo, kbot, hl, nl, w,
477 $ ilo, ihi, z, ldz, workl, nl, info )
478 IF( wantt .OR. info.NE.0 )
479 $ CALL
zlacpy(
'A', n, n, hl, nl, h, ldh )
486 IF( ( wantt .OR. info.NE.0 ) .AND. n.GT.2 )
487 $ CALL
zlaset(
'L', n-2, n-2, zero, zero, h( 3, 1 ), ldh )
492 work( 1 ) = dcmplx( max( dble( max( 1, n ) ),
493 $ dble( work( 1 ) ) ), rzero )
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zlahqr(WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, IHIZ, Z, LDZ, INFO)
ZLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm.
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zlaqr0(WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO)
ZLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur de...