216 SUBROUTINE dgees( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI,
217 $ vs, ldvs, work, lwork, bwork, info )
225 CHARACTER JOBVS, SORT
226 INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
230 DOUBLE PRECISION A( lda, * ), VS( ldvs, * ), WI( * ), WORK( * ),
241 DOUBLE PRECISION ZERO, ONE
242 parameter ( zero = 0.0d0, one = 1.0d0 )
245 LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTST,
247 INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
248 $ ihi, ilo, inxt, ip, itau, iwrk, maxwrk, minwrk
249 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, S, SEP, SMLNUM
253 DOUBLE PRECISION DUM( 1 )
262 DOUBLE PRECISION DLAMCH, DLANGE
263 EXTERNAL lsame, ilaenv, dlamch, dlange
273 lquery = ( lwork.EQ.-1 )
274 wantvs = lsame( jobvs,
'V' )
275 wantst = lsame( sort,
'S' )
276 IF( ( .NOT.wantvs ) .AND. ( .NOT.lsame( jobvs,
'N' ) ) )
THEN
278 ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort,
'N' ) ) )
THEN
280 ELSE IF( n.LT.0 )
THEN
282 ELSE IF( lda.LT.max( 1, n ) )
THEN
284 ELSE IF( ldvs.LT.1 .OR. ( wantvs .AND. ldvs.LT.n ) )
THEN
303 maxwrk = 2*n + n*ilaenv( 1,
'DGEHRD',
' ', n, 1, n, 0 )
306 CALL dhseqr(
'S', jobvs, n, 1, n, a, lda, wr, wi, vs, ldvs,
310 IF( .NOT.wantvs )
THEN
311 maxwrk = max( maxwrk, n + hswork )
313 maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
314 $
'DORGHR',
' ', n, 1, n, -1 ) )
315 maxwrk = max( maxwrk, n + hswork )
320 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
326 CALL xerbla(
'DGEES ', -info )
328 ELSE IF( lquery )
THEN
342 smlnum = dlamch(
'S' )
343 bignum = one / smlnum
344 CALL dlabad( smlnum, bignum )
345 smlnum = sqrt( smlnum ) / eps
346 bignum = one / smlnum
350 anrm = dlange(
'M', n, n, a, lda, dum )
352 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
355 ELSE IF( anrm.GT.bignum )
THEN
360 $
CALL dlascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
366 CALL dgebal(
'P', n, a, lda, ilo, ihi, work( ibal ), ierr )
373 CALL dgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
374 $ lwork-iwrk+1, ierr )
380 CALL dlacpy(
'L', n, n, a, lda, vs, ldvs )
385 CALL dorghr( n, ilo, ihi, vs, ldvs, work( itau ), work( iwrk ),
386 $ lwork-iwrk+1, ierr )
395 CALL dhseqr(
'S', jobvs, n, ilo, ihi, a, lda, wr, wi, vs, ldvs,
396 $ work( iwrk ), lwork-iwrk+1, ieval )
402 IF( wantst .AND. info.EQ.0 )
THEN
404 CALL dlascl(
'G', 0, 0, cscale, anrm, n, 1, wr, n, ierr )
405 CALL dlascl(
'G', 0, 0, cscale, anrm, n, 1, wi, n, ierr )
408 bwork( i ) =
SELECT( wr( i ), wi( i ) )
414 CALL dtrsen(
'N', jobvs, bwork, n, a, lda, vs, ldvs, wr, wi,
415 $ sdim, s, sep, work( iwrk ), lwork-iwrk+1, idum, 1,
426 CALL dgebak(
'P',
'R', n, ilo, ihi, work( ibal ), n, vs, ldvs,
434 CALL dlascl(
'H', 0, 0, cscale, anrm, n, n, a, lda, ierr )
435 CALL dcopy( n, a, lda+1, wr, 1 )
436 IF( cscale.EQ.smlnum )
THEN
442 IF( ieval.GT.0 )
THEN
445 CALL dlascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, wi,
446 $ max( ilo-1, 1 ), ierr )
447 ELSE IF( wantst )
THEN
458 IF( wi( i ).EQ.zero )
THEN
461 IF( a( i+1, i ).EQ.zero )
THEN
464 ELSE IF( a( i+1, i ).NE.zero .AND. a( i, i+1 ).EQ.
469 $
CALL dswap( i-1, a( 1, i ), 1, a( 1, i+1 ), 1 )
471 $
CALL dswap( n-i-1, a( i, i+2 ), lda,
472 $ a( i+1, i+2 ), lda )
474 CALL dswap( n, vs( 1, i ), 1, vs( 1, i+1 ), 1 )
476 a( i, i+1 ) = a( i+1, i )
486 CALL dlascl(
'G', 0, 0, cscale, anrm, n-ieval, 1,
487 $ wi( ieval+1 ), max( n-ieval, 1 ), ierr )
490 IF( wantst .AND. info.EQ.0 )
THEN
499 cursl =
SELECT( wr( i ), wi( i ) )
500 IF( wi( i ).EQ.zero )
THEN
504 IF( cursl .AND. .NOT.lastsl )
511 cursl = cursl .OR. lastsl
516 IF( cursl .AND. .NOT.lst2sl )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dtrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
DTRSEN
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine dgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DGEHRD
subroutine dorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DORGHR
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
DGEBAK
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine dgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, VS, LDVS, WORK, LWORK, BWORK, INFO)
DGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...