278 SUBROUTINE dgeesx( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
279 $ WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
280 $ IWORK, LIWORK, BWORK, INFO )
287 CHARACTER JOBVS, SENSE, SORT
288 INTEGER INFO, LDA, LDVS, LIWORK, LWORK, N, SDIM
289 DOUBLE PRECISION RCONDE, RCONDV
294 DOUBLE PRECISION A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
305 DOUBLE PRECISION ZERO, ONE
306 PARAMETER ( ZERO = 0.0d0, one = 1.0d0 )
309 LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTSB,
310 $ WANTSE, WANTSN, WANTST, WANTSV, WANTVS
311 INTEGER HSWORK, I, , I2, IBAL, ICOND, IERR, IEVAL,
312 $ IHI, ILO, INXT, IP, ITAU, IWRK, LIWRK, LWRK,
314 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SMLNUM
317 DOUBLE PRECISION DUM( 1 )
326 DOUBLE PRECISION DLAMCH, DLANGE
327 EXTERNAL lsame, ilaenv,
dlabad, dlamch, dlange
337 wantvs = lsame( jobvs,
'V' )
338 wantst = lsame( sort,
'S' )
339 wantsn = lsame( sense,
'N' )
340 wantse = lsame( sense,
'E' )
341 wantsv = lsame( sense,
'V' )
342 wantsb = lsame( sense,
'B' )
343 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
345 IF( ( .NOT.wantvs ) .AND. ( .NOT.lsame( jobvs,
'N' ) ) )
THEN
347 ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort,
'N' ) ) )
THEN
349 ELSE IF( .NOT.( wantsn .OR. wantse .OR. wantsv .OR. wantsb ) .OR.
350 $ ( .NOT.wantst .AND. .NOT.wantsn ) )
THEN
352 ELSE IF( n.LT.0 )
THEN
354 ELSE IF( lda.LT.
max( 1, n ) )
THEN
356 ELSE IF( ldvs.LT.1 .OR. ( wantvs .AND. ldvs.LT.n ) )
THEN
380 maxwrk = 2*n + n*ilaenv( 1,
'DGEHRD',
' ', n, 1, n, 0 )
383 CALL dhseqr(
'S', jobvs, n, 1, n, a, lda, wr, wi, vs, ldvs,
387 IF( .NOT.wantvs )
THEN
388 maxwrk =
max( maxwrk, n + hswork )
390 maxwrk =
max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
391 $
'DORGHR',
' ', n, 1, n, -1 ) )
392 maxwrk =
max( maxwrk, n + hswork )
396 $ lwrk =
max( lwrk, n + ( n*n )/2 )
397 IF( wantsv .OR. wantsb )
403 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
405 ELSE IF( liwork.LT.1 .AND. .NOT.lquery )
THEN
411 CALL xerbla(
'DGEESX', -info )
413 ELSE IF( lquery )
THEN
427 smlnum = dlamch(
'S' )
428 bignum = one / smlnum
429 CALL dlabad( smlnum, bignum )
430 smlnum = sqrt( smlnum ) / eps
431 bignum = one / smlnum
435 anrm = dlange(
'M', n, n, a, lda, dum )
437 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
440 ELSE IF( anrm.GT.bignum )
THEN
445 $
CALL dlascl( 'g
', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
451 CALL DGEBAL( 'p
', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
458 CALL DGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
459 $ LWORK-IWRK+1, IERR )
465 CALL DLACPY( 'l
', N, N, A, LDA, VS, LDVS )
470 CALL DORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
471 $ LWORK-IWRK+1, IERR )
480 CALL DHSEQR( 's
', JOBVS, N, ILO, IHI, A, LDA, WR, WI, VS, LDVS,
481 $ WORK( IWRK ), LWORK-IWRK+1, IEVAL )
487.AND..EQ.
IF( WANTST INFO0 ) THEN
489 CALL DLASCL( 'g
', 0, 0, CSCALE, ANRM, N, 1, WR, N, IERR )
490 CALL DLASCL( 'g
', 0, 0, CSCALE, ANRM, N, 1, WI, N, IERR )
493 BWORK( I ) = SELECT( WR( I ), WI( I ) )
503 CALL DTRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, WI,
504 $ SDIM, RCONDE, RCONDV, WORK( IWRK ), LWORK-IWRK+1,
505 $ IWORK, LIWORK, ICOND )
507 $ MAXWRK = MAX( MAXWRK, N+2*SDIM*( N-SDIM ) )
508.EQ.
IF( ICOND-15 ) THEN
513.EQ.
ELSE IF( ICOND-17 ) THEN
518.GT.
ELSE IF( ICOND0 ) THEN
531 CALL DGEBAK( 'p
', 'r
', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS,
539 CALL DLASCL( 'h
', 0, 0, CSCALE, ANRM, N, N, A, LDA, IERR )
540 CALL DCOPY( N, A, LDA+1, WR, 1 )
541.OR..AND..EQ.
IF( ( WANTSV WANTSB ) INFO0 ) THEN
543 CALL DLASCL( 'g
', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR )
546.EQ.
IF( CSCALESMLNUM ) THEN
552.GT.
IF( IEVAL0 ) THEN
555 CALL DLASCL( 'g
', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
557 ELSE IF( WANTST ) THEN
568.EQ.
IF( WI( I )ZERO ) THEN
571.EQ.
IF( A( I+1, I )ZERO ) THEN
574.NE..AND..EQ.
ELSE IF( A( I+1, I )ZERO A( I, I+1 )
579 $ CALL DSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 )
581 $ CALL DSWAP( N-I-1, A( I, I+2 ), LDA,
582 $ A( I+1, I+2 ), LDA )
584 CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 )
586 A( I, I+1 ) = A( I+1, I )
593 CALL DLASCL( 'g
', 0, 0, CSCALE, ANRM, N-IEVAL, 1,
594 $ WI( IEVAL+1 ), MAX( N-IEVAL, 1 ), IERR )
597.AND..EQ.
IF( WANTST INFO0 ) THEN
606 CURSL = SELECT( WR( I ), WI( I ) )
607.EQ.
IF( WI( I )ZERO ) THEN
611.AND..NOT.
IF( CURSL LASTSL )
618.OR.
CURSL = CURSL LASTSL
623.AND..NOT.
IF( CURSL LST2SL )
638.OR.
IF( WANTSV WANTSB ) THEN
639 IWORK( 1 ) = MAX( 1, SDIM*( N-SDIM ) )
subroutine dlabad(small, large)
DLABAD
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.
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 xerbla(srname, info)
XERBLA
subroutine dgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
DGEHRD
subroutine dgebal(job, n, a, lda, ilo, ihi, scale, info)
DGEBAL
subroutine dgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
DGEBAK
subroutine dgeesx(jobvs, sort, select, sense, n, a, lda, sdim, wr, wi, vs, ldvs, rconde, rcondv, work, lwork, iwork, liwork, bwork, info)
DGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
subroutine dhseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
DHSEQR
subroutine dtrsen(job, compq, select, n, t, ldt, q, ldq, wr, wi, m, s, sep, work, lwork, iwork, liwork, info)
DTRSEN
subroutine dorghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
DORGHR
subroutine dswap(n, dx, incx, dy, incy)
DSWAP
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY