299 SUBROUTINE chseqr( 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 H( ldh, * ), W( * ), WORK( * ), Z( ldz, * )
323 parameter( ntiny = 11 )
334 parameter( zero = ( 0.0e0, 0.0e0 ),
335 $ one = ( 1.0e0, 0.0e0 ) )
337 parameter( rzero = 0.0e0 )
340 COMPLEX HL( nl, nl ), WORKL( nl )
344 LOGICAL INITZ, LQUERY, WANTT, WANTZ
349 EXTERNAL ilaenv, lsame
355 INTRINSIC cmplx, max, min, real
361 wantt = lsame( job,
'S' )
362 initz = lsame( compz,
'I' )
363 wantz = initz .OR. lsame( compz,
'V' )
364 work( 1 ) = cmplx(
REAL( 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(
'CHSEQR', -info )
393 ELSE IF( n.EQ.0 )
THEN
399 ELSE IF( lquery )
THEN
403 CALL
claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi, z,
404 $ ldz, work, lwork, info )
407 work( 1 ) = cmplx( max(
REAL( WORK( 1 ) ),
REAL( MAX( 1,
$ N ) ) ), rzero )
415 $ CALL
ccopy( ilo-1, h, ldh+1, w, 1 )
417 $ CALL
ccopy( n-ihi, h( ihi+1, ihi+1 ), ldh+1, w( ihi+1 ), 1 )
422 $ CALL
claset(
'A', n, n, zero, one, z, ldz )
426 IF( ilo.EQ.ihi )
THEN
427 w( ilo ) = h( ilo, ilo )
433 nmin = ilaenv( 12,
'CHSEQR', job( : 1 ) // compz( : 1 ), n,
435 nmin = max( ntiny, nmin )
440 CALL
claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
441 $ z, ldz, work, lwork, info )
446 CALL
clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
461 CALL
claqr0( wantt, wantz, n, ilo, kbot, h, ldh, w,
462 $ ilo, ihi, z, ldz, work, lwork, info )
471 CALL
clacpy(
'A', n, n, h, ldh, hl, nl )
473 CALL
claset(
'A', nl, nl-n, zero, zero, hl( 1, n+1 ),
475 CALL
claqr0( wantt, wantz, nl, ilo, kbot, hl, nl, w,
476 $ ilo, ihi, z, ldz, workl, nl, info )
477 IF( wantt .OR. info.NE.0 )
478 $ CALL
clacpy(
'A', n, n, hl, nl, h, ldh )
485 IF( ( wantt .OR. info.NE.0 ) .AND. n.GT.2 )
486 $ CALL
claset(
'L', n-2, n-2, zero, zero, h( 3, 1 ), ldh )
491 work( 1 ) = cmplx( max(
REAL( MAX( 1, N ) ),
492 $
REAL( WORK( 1 ) ) ), rzero )
498 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 xerbla(SRNAME, INFO)
XERBLA
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
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
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, using the double-shift/single-shift QR algorithm.