297 SUBROUTINE zhseqr( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
298 $ WORK, LWORK, INFO )
305 INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
309 COMPLEX*16 H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
320 parameter( ntiny = 15 )
331 parameter( zero = ( 0.0d0, 0.0d0 ),
332 $ one = ( 1.0d0, 0.0d0 ) )
333 DOUBLE PRECISION RZERO
334 parameter( rzero = 0.0d0 )
337 COMPLEX*16 HL( NL, NL ), WORKL( NL )
341 LOGICAL INITZ, LQUERY, WANTT, WANTZ
346 EXTERNAL ilaenv, lsame
352 INTRINSIC dble, dcmplx, max, min
358 wantt = lsame( job,
'S' )
359 initz = lsame( compz,
'I' )
360 wantz = initz .OR. lsame( compz,
'V' )
361 work( 1 ) = dcmplx( dble( max( 1, n ) ), rzero )
365 IF( .NOT.lsame( job,
'E' ) .AND. .NOT.wantt )
THEN
367 ELSE IF( .NOT.lsame( compz,
'N' ) .AND. .NOT.wantz )
THEN
369 ELSE IF( n.LT.0 )
THEN
371 ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) )
THEN
373 ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n )
THEN
375 ELSE IF( ldh.LT.max( 1, n ) )
THEN
377 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.max( 1, n ) ) )
THEN
379 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
387 CALL xerbla(
'ZHSEQR', -info )
390 ELSE IF( n.EQ.0 )
THEN
396 ELSE IF( lquery )
THEN
400 CALL zlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi, z,
401 $ ldz, work, lwork, info )
404 work( 1 ) = dcmplx( max( dble( work( 1 ) ), dble( max( 1,
413 $
CALL zcopy( ilo-1, h, ldh+1, w, 1 )
415 $
CALL zcopy( n-ihi, h( ihi+1, ihi+1 ), ldh+1, w( ihi+1 ), 1 )
420 $
CALL zlaset(
'A', n, n, zero, one, z, ldz )
424 IF( ilo.EQ.ihi )
THEN
425 w( ilo ) = h( ilo, ilo )
431 nmin = ilaenv( 12,
'ZHSEQR', job( : 1 ) // compz( : 1 ), n,
433 nmin = max( ntiny, nmin )
438 CALL zlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
439 $ z, ldz, work, lwork, info )
444 CALL zlahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
459 CALL zlaqr0( wantt, wantz, n, ilo, kbot, h, ldh, w,
460 $ ilo, ihi, z, ldz, work, lwork, info )
469 CALL zlacpy(
'A', n, n, h, ldh, hl, nl )
471 CALL zlaset(
'A', nl, nl-n, zero, zero, hl( 1, n+1 ),
473 CALL zlaqr0( wantt, wantz, nl, ilo, kbot, hl, nl, w,
474 $ ilo, ihi, z, ldz, workl, nl, info )
475 IF( wantt .OR. info.NE.0 )
476 $
CALL zlacpy(
'A', n, n, hl, nl, h, ldh )
483 IF( ( wantt .OR. info.NE.0 ) .AND. n.GT.2 )
484 $
CALL zlaset(
'L', n-2, n-2, zero, zero, h( 3, 1 ), ldh )
489 work( 1 ) = dcmplx( max( dble( max( 1, n ) ),
490 $ dble( work( 1 ) ) ), rzero )
subroutine xerbla(srname, info)
subroutine zcopy(n, zx, incx, zy, incy)
ZCOPY
subroutine zhseqr(job, compz, n, ilo, ihi, h, ldh, w, z, ldz, work, lwork, info)
ZHSEQR
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
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,...
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...
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.