297 SUBROUTINE chseqr( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
298 $ WORK, LWORK, INFO )
305 INTEGER IHI, ILO, INFO, LDH, , LWORK, N
309 COMPLEX H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
320 parameter( ntiny = 15 )
331 parameter( zero = ( 0.0e0, 0.0e0 ),
332 $ one = ( 1.0e0, 0.0e0 ) )
334 parameter( rzero = 0.0e0 )
337 COMPLEX HL( NL, NL ), WORKL( NL )
341 LOGICAL INITZ, LQUERY, WANTT, WANTZ
346 EXTERNAL ilaenv, lsame
358 wantt = lsame( job,
'S' )
359 initz = lsame( compz,
'I' )
360 wantz = initz .OR. lsame( compz,
'V' )
361 work( 1 ) =
cmplx( real(
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(
'CHSEQR', -info )
390 ELSE IF( n.EQ.0 )
THEN
396 ELSE IF( lquery )
THEN
400 CALL claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi, z,
401 $ ldz, work, lwork, info )
404 work( 1 ) =
cmplx(
max( real( work( 1 ) ), real(
max( 1,
413 $
CALL ccopy( ilo-1, h, ldh+1, w, 1 )
415 $
CALL ccopy( n-ihi, h( ihi+1, ihi+1 ), ldh+1, w( ihi+1 ), 1 )
420 $
CALL claset(
'A', n, n, zero, one, z, ldz )
424 IF( ilo.EQ.ihi )
THEN
425 w( ilo ) = h( ilo, ilo )
431 nmin = ilaenv( 12,
'CHSEQR', job( : 1 ) // compz( : 1 ), n,
433 nmin =
max( ntiny, nmin )
438 CALL claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
439 $ z, ldz, work, lwork, info )
444 CALL clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
459 CALL claqr0( wantt, wantz, n, ilo, kbot, h, ldh, w,
460 $ ilo, ihi, z, ldz, work, lwork, info )
469 CALL clacpy(
'A', n, n, h, ldh, hl, nl )
471 CALL claset(
'A', nl, nl-n, zero, zero, hl( 1, n+1 ),
473 CALL claqr0( 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 clacpy(
'A', n, n, hl, nl, h, ldh )
483 IF( ( wantt .OR. info.NE.0 ) .AND. n.GT.2 )
484 $
CALL claset(
'L', n-2, n-2, zero, zero, h( 3, 1 ), ldh )
490 $ real( work( 1 ) ) ), rzero )
subroutine clahqr(wantt, wantz, n, ilo, ihi, h, ldh, w, iloz, ihiz, z, ldz, info)
CLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix,...
subroutine claqr0(wantt, wantz, n, ilo, ihi, h, ldh, w, iloz, ihiz, z, ldz, work, lwork, info)
CLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur de...