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 )
332 parameter ( nl = 49 )
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 zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
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 xerbla(SRNAME, INFO)
XERBLA
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 zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
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...