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 )
332 parameter ( nl = 49 )
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 ) )
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 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.
subroutine xerbla(SRNAME, INFO)
XERBLA
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 chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
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 clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY