280 SUBROUTINE dgeesx( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
281 $ WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
282 $ IWORK, LIWORK, BWORK, INFO )
290 CHARACTER JOBVS, SENSE, SORT
291 INTEGER INFO, LDA, LDVS, LIWORK, LWORK, N, SDIM
292 DOUBLE PRECISION RCONDE, RCONDV
297 DOUBLE PRECISION A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
308 DOUBLE PRECISION ZERO, ONE
309 PARAMETER ( ZERO = 0.0d0, one = 1.0d0 )
312 LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTSB,
313 $ WANTSE, WANTSN, WANTST, WANTSV, WANTVS
314 INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
315 $ IHI, ILO, INXT, IP, ITAU, IWRK, LIWRK, LWRK,
317 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SMLNUM
320 DOUBLE PRECISION DUM( 1 )
329 DOUBLE PRECISION DLAMCH, DLANGE
330 EXTERNAL lsame, ilaenv,
dlabad, dlamch, dlange
340 wantvs = lsame( jobvs,
'V' )
341 wantst = lsame( sort,
'S' )
342 wantsn = lsame( sense,
'N' )
343 wantse = lsame( sense,
'E' )
344 wantsv = lsame( sense,
'V' )
345 wantsb = lsame( sense,
'B' )
346 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
348 IF( ( .NOT.wantvs ) .AND. ( .NOT.lsame( jobvs,
'N' ) ) )
THEN
350 ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort,
'N' ) ) )
THEN
352 ELSE IF( .NOT.( wantsn .OR. wantse .OR. wantsv .OR. wantsb ) .OR.
353 $ ( .NOT.wantst .AND. .NOT.wantsn ) )
THEN
355 ELSE IF( n.LT.0 )
THEN
357 ELSE IF( lda.LT.max( 1, n ) )
THEN
359 ELSE IF( ldvs.LT.1 .OR. ( wantvs .AND. ldvs.LT.n ) )
THEN
383 maxwrk = 2*n + n*ilaenv( 1,
'DGEHRD',
' ', n, 1, n, 0 )
386 CALL dhseqr(
'S', jobvs, n, 1, n, a, lda, wr, wi, vs, ldvs,
390 IF( .NOT.wantvs )
THEN
391 maxwrk = max( maxwrk, n + hswork )
393 maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
394 $
'DORGHR',
' ', n, 1, n, -1 ) )
395 maxwrk = max( maxwrk, n + hswork )
399 $ lwrk = max( lwrk, n + ( n*n )/2 )
400 IF( wantsv .OR. wantsb )
406 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
408 ELSE IF( liwork.LT.1 .AND. .NOT.lquery )
THEN
414 CALL xerbla(
'DGEESX', -info )
416 ELSE IF( lquery )
THEN
430 smlnum = dlamch(
'S' )
431 bignum = one / smlnum
432 CALL dlabad( smlnum, bignum )
433 smlnum = sqrt( smlnum ) / eps
434 bignum = one / smlnum
438 anrm = dlange(
'M', n, n, a, lda, dum )
440 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
443 ELSE IF( anrm.GT.bignum )
THEN
448 $
CALL dlascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
454 CALL dgebal(
'P', n, a, lda, ilo, ihi, work( ibal ), ierr )
461 CALL dgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
462 $ lwork-iwrk+1, ierr )
468 CALL dlacpy(
'L', n, n, a, lda, vs, ldvs )
473 CALL dorghr( n, ilo, ihi, vs, ldvs, work( itau ), work( iwrk ),
474 $ lwork-iwrk+1, ierr )
483 CALL dhseqr(
'S', jobvs, n, ilo, ihi, a, lda, wr, wi, vs, ldvs,
484 $ work( iwrk ), lwork-iwrk+1, ieval )
490 IF( wantst .AND. info.EQ.0 )
THEN
492 CALL dlascl(
'G', 0, 0, cscale, anrm, n, 1, wr, n, ierr )
493 CALL dlascl(
'G', 0, 0, cscale, anrm, n, 1, wi, n, ierr )
496 bwork( i ) =
SELECT( wr( i ), wi( i ) )
506 CALL dtrsen( sense, jobvs, bwork, n, a, lda, vs, ldvs, wr, wi,
507 $ sdim, rconde, rcondv, work( iwrk ), lwork-iwrk+1,
508 $ iwork, liwork, icond )
510 $ maxwrk = max( maxwrk, n+2*sdim*( n-sdim ) )
511 IF( icond.EQ.-15 )
THEN
516 ELSE IF( icond.EQ.-17 )
THEN
521 ELSE IF( icond.GT.0 )
THEN
534 CALL dgebak(
'P',
'R', n, ilo, ihi, work( ibal ), n, vs, ldvs,
542 CALL dlascl(
'H', 0, 0, cscale, anrm, n, n, a, lda, ierr )
543 CALL dcopy( n, a, lda+1, wr, 1 )
544 IF( ( wantsv .OR. wantsb ) .AND. info.EQ.0 )
THEN
546 CALL dlascl(
'G', 0, 0, cscale, anrm, 1, 1, dum, 1, ierr )
549 IF( cscale.EQ.smlnum )
THEN
555 IF( ieval.GT.0 )
THEN
558 CALL dlascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, wi, n,
560 ELSE IF( wantst )
THEN
571 IF( wi( i ).EQ.zero )
THEN
574 IF( a( i+1, i ).EQ.zero )
THEN
577 ELSE IF( a( i+1, i ).NE.zero .AND. a( i, i+1 ).EQ.
582 $
CALL dswap( i-1, a( 1, i ), 1, a( 1, i+1 ), 1 )
584 $
CALL dswap( n-i-1, a( i, i+2 ), lda,
585 $ a( i+1, i+2 ), lda )
587 CALL dswap( n, vs( 1, i ), 1, vs( 1, i+1 ), 1 )
589 a( i, i+1 ) = a( i+1, i )
596 CALL dlascl(
'G', 0, 0, cscale, anrm, n-ieval, 1,
597 $ wi( ieval+1 ), max( n-ieval, 1 ), ierr )
600 IF( wantst .AND. info.EQ.0 )
THEN
609 cursl =
SELECT( wr( i ), wi( i ) )
610 IF( wi( i ).EQ.zero )
THEN
614 IF( cursl .AND. .NOT.lastsl )
621 cursl = cursl .OR. lastsl
626 IF( cursl .AND. .NOT.lst2sl )
641 IF( wantsv .OR. wantsb )
THEN
642 iwork( 1 ) = max( 1, sdim*( n-sdim ) )