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 ) ) 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 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 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 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 ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR