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 )
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
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 )
586 CALL
dswap( n, vs( 1, i ), 1, vs( 1, i+1 ), 1 )
587 a( i, i+1 ) = a( i+1, i )
594 CALL
dlascl(
'G', 0, 0, cscale, anrm, n-ieval, 1,
595 $ wi( ieval+1 ), max( n-ieval, 1 ), ierr )
598 IF( wantst .AND. info.EQ.0 )
THEN
607 cursl =
SELECT( wr( i ), wi( i ) )
608 IF( wi( i ).EQ.zero )
THEN
612 IF( cursl .AND. .NOT.lastsl )
619 cursl = cursl .OR. lastsl
624 IF( cursl .AND. .NOT.lst2sl )
639 IF( wantsv .OR. wantsb )
THEN
640 iwork( 1 ) = max( 1, sdim*( n-sdim ) )