295 SUBROUTINE zhseqr( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
296 $ WORK, LWORK, INFO )
303 INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
307 COMPLEX*16 H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
318 parameter( ntiny = 15 )
329 parameter( zero = ( 0.0d0, 0.0d0 ),
330 $ one = ( 1.0d0, 0.0d0 ) )
331 DOUBLE PRECISION RZERO
332 parameter( rzero = 0.0d0 )
335 COMPLEX*16 HL( NL, NL ), WORKL( NL )
339 LOGICAL INITZ, LQUERY, WANTT, WANTZ
344 EXTERNAL ilaenv, lsame
351 INTRINSIC dble, dcmplx, max, min
357 wantt = lsame( job,
'S' )
358 initz = lsame( compz,
'I' )
359 wantz = initz .OR. lsame( compz,
'V' )
360 work( 1 ) = dcmplx( dble( max( 1, n ) ), rzero )
364 IF( .NOT.lsame( job,
'E' ) .AND. .NOT.wantt )
THEN
366 ELSE IF( .NOT.lsame( compz,
'N' ) .AND. .NOT.wantz )
THEN
368 ELSE IF( n.LT.0 )
THEN
370 ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) )
THEN
372 ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n )
THEN
374 ELSE IF( ldh.LT.max( 1, n ) )
THEN
376 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.max( 1, n ) ) )
THEN
378 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
386 CALL xerbla(
'ZHSEQR', -info )
389 ELSE IF( n.EQ.0 )
THEN
395 ELSE IF( lquery )
THEN
399 CALL zlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
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 ),
421 $
CALL zlaset(
'A', n, n, zero, one, z, ldz )
425 IF( ilo.EQ.ihi )
THEN
426 w( ilo ) = h( ilo, ilo )
432 nmin = ilaenv( 12,
'ZHSEQR', job( : 1 ) // compz( : 1 ), n,
434 nmin = max( ntiny, nmin )
439 CALL zlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo,
441 $ z, ldz, work, lwork, info )
446 CALL zlahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo,
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,
477 CALL zlaqr0( wantt, wantz, nl, ilo, kbot, hl, nl,
479 $ ilo, ihi, z, ldz, workl, nl, info )
480 IF( wantt .OR. info.NE.0 )
481 $
CALL zlacpy(
'A', n, n, hl, nl, h, ldh )
488 IF( ( wantt .OR. info.NE.0 ) .AND. n.GT.2 )
489 $
CALL zlaset(
'L', n-2, n-2, zero, zero, h( 3, 1 ), ldh )
494 work( 1 ) = dcmplx( max( dble( max( 1, n ) ),
495 $ dble( work( 1 ) ) ), rzero )
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...