297 SUBROUTINE chseqr( 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 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
352 INTRINSIC cmplx, max, min, real
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 )
489 work( 1 ) = cmplx( max( real( max( 1, n ) ),
490 $ real( work( 1 ) ) ), rzero )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
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...
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 clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR