302 SUBROUTINE sgeevx( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI,
303 $ vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm,
304 $ rconde, rcondv, work, lwork, iwork, info )
312 CHARACTER balanc, jobvl, jobvr, sense
313 INTEGER ihi, ilo, info, lda, ldvl, ldvr, lwork, n
318 REAL a( lda, * ), rconde( * ), rcondv( * ),
319 $ scale( * ), vl( ldvl, * ), vr( ldvr, * ),
320 $ wi( * ), work( * ), wr( * )
327 parameter( zero = 0.0e0, one = 1.0e0 )
330 LOGICAL lquery, scalea, wantvl, wantvr, wntsnb, wntsne,
333 INTEGER hswork, i, icond, ierr, itau, iwrk, k, maxwrk,
335 REAL anrm, bignum, cs, cscale, eps, r, scl, smlnum,
362 lquery = ( lwork.EQ.-1 )
363 wantvl =
lsame( jobvl,
'V' )
364 wantvr =
lsame( jobvr,
'V' )
365 wntsnn =
lsame( sense,
'N' )
366 wntsne =
lsame( sense,
'E' )
367 wntsnv =
lsame( sense,
'V' )
368 wntsnb =
lsame( sense,
'B' )
369 IF( .NOT.(
lsame( balanc,
'N' ) .OR.
lsame( balanc,
'S' ) .OR.
370 $
lsame( balanc,
'P' ) .OR.
lsame( balanc,
'B' ) ) )
THEN
372 ELSE IF( ( .NOT.wantvl ) .AND. ( .NOT.
lsame( jobvl,
'N' ) ) )
THEN
374 ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.
lsame( jobvr,
'N' ) ) )
THEN
376 ELSE IF( .NOT.( wntsnn .OR. wntsne .OR. wntsnb .OR. wntsnv ) .OR.
377 $ ( ( wntsne .OR. wntsnb ) .AND. .NOT.( wantvl .AND.
380 ELSE IF( n.LT.0 )
THEN
382 ELSE IF( lda.LT.max( 1, n ) )
THEN
384 ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) )
THEN
386 ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) )
THEN
405 maxwrk = n + n*
ilaenv( 1,
'SGEHRD',
' ', n, 1, n, 0 )
408 CALL
shseqr(
'S',
'V', n, 1, n, a, lda, wr, wi, vl, ldvl,
410 ELSE IF( wantvr )
THEN
411 CALL
shseqr(
'S',
'V', n, 1, n, a, lda, wr, wi, vr, ldvr,
415 CALL
shseqr(
'E',
'N', n, 1, n, a, lda, wr, wi, vr,
416 $ ldvr, work, -1, info )
418 CALL
shseqr(
'S',
'N', n, 1, n, a, lda, wr, wi, vr,
419 $ ldvr, work, -1, info )
424 IF( ( .NOT.wantvl ) .AND. ( .NOT.wantvr ) )
THEN
427 $ minwrk = max( minwrk, n*n+6*n )
428 maxwrk = max( maxwrk, hswork )
430 $ maxwrk = max( maxwrk, n*n + 6*n )
433 IF( ( .NOT.wntsnn ) .AND. ( .NOT.wntsne ) )
434 $ minwrk = max( minwrk, n*n + 6*n )
435 maxwrk = max( maxwrk, hswork )
436 maxwrk = max( maxwrk, n + ( n - 1 )*
ilaenv( 1,
'SORGHR',
437 $
' ', n, 1, n, -1 ) )
438 IF( ( .NOT.wntsnn ) .AND. ( .NOT.wntsne ) )
439 $ maxwrk = max( maxwrk, n*n + 6*n )
440 maxwrk = max( maxwrk, 3*n )
442 maxwrk = max( maxwrk, minwrk )
446 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
452 CALL
xerbla(
'SGEEVX', -info )
454 ELSE IF( lquery )
THEN
467 bignum = one / smlnum
468 CALL
slabad( smlnum, bignum )
469 smlnum = sqrt( smlnum ) / eps
470 bignum = one / smlnum
475 anrm =
slange(
'M', n, n, a, lda, dum )
477 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
480 ELSE IF( anrm.GT.bignum )
THEN
485 $ CALL
slascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
489 CALL
sgebal( balanc, n, a, lda, ilo, ihi, scale, ierr )
490 abnrm =
slange(
'1', n, n, a, lda, dum )
493 CALL
slascl(
'G', 0, 0, cscale, anrm, 1, 1, dum, 1, ierr )
502 CALL
sgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
503 $ lwork-iwrk+1, ierr )
511 CALL
slacpy(
'L', n, n, a, lda, vl, ldvl )
516 CALL
sorghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
517 $ lwork-iwrk+1, ierr )
523 CALL
shseqr(
'S',
'V', n, ilo, ihi, a, lda, wr, wi, vl, ldvl,
524 $ work( iwrk ), lwork-iwrk+1, info )
532 CALL
slacpy(
'F', n, n, vl, ldvl, vr, ldvr )
535 ELSE IF( wantvr )
THEN
541 CALL
slacpy(
'L', n, n, a, lda, vr, ldvr )
546 CALL
sorghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
547 $ lwork-iwrk+1, ierr )
553 CALL
shseqr(
'S',
'V', n, ilo, ihi, a, lda, wr, wi, vr, ldvr,
554 $ work( iwrk ), lwork-iwrk+1, info )
570 CALL
shseqr( job,
'N', n, ilo, ihi, a, lda, wr, wi, vr, ldvr,
571 $ work( iwrk ), lwork-iwrk+1, info )
579 IF( wantvl .OR. wantvr )
THEN
584 CALL
strevc( side,
'B',
SELECT, n, a, lda, vl, ldvl, vr, ldvr,
585 $ n, nout, work( iwrk ), ierr )
591 IF( .NOT.wntsnn )
THEN
592 CALL
strsna( sense,
'A',
SELECT, n, a, lda, vl, ldvl, vr, ldvr,
593 $ rconde, rcondv, n, nout, work( iwrk ), n, iwork,
601 CALL
sgebak( balanc,
'L', n, ilo, ihi, scale, n, vl, ldvl,
607 IF( wi( i ).EQ.zero )
THEN
608 scl = one /
snrm2( n, vl( 1, i ), 1 )
609 CALL
sscal( n, scl, vl( 1, i ), 1 )
610 ELSE IF( wi( i ).GT.zero )
THEN
612 $
snrm2( n, vl( 1, i+1 ), 1 ) )
613 CALL
sscal( n, scl, vl( 1, i ), 1 )
614 CALL
sscal( n, scl, vl( 1, i+1 ), 1 )
616 work( k ) = vl( k, i )**2 + vl( k, i+1 )**2
619 CALL
slartg( vl( k, i ), vl( k, i+1 ), cs, sn, r )
620 CALL
srot( n, vl( 1, i ), 1, vl( 1, i+1 ), 1, cs, sn )
630 CALL
sgebak( balanc,
'R', n, ilo, ihi, scale, n, vr, ldvr,
636 IF( wi( i ).EQ.zero )
THEN
637 scl = one /
snrm2( n, vr( 1, i ), 1 )
638 CALL
sscal( n, scl, vr( 1, i ), 1 )
639 ELSE IF( wi( i ).GT.zero )
THEN
641 $
snrm2( n, vr( 1, i+1 ), 1 ) )
642 CALL
sscal( n, scl, vr( 1, i ), 1 )
643 CALL
sscal( n, scl, vr( 1, i+1 ), 1 )
645 work( k ) = vr( k, i )**2 + vr( k, i+1 )**2
648 CALL
slartg( vr( k, i ), vr( k, i+1 ), cs, sn, r )
649 CALL
srot( n, vr( 1, i ), 1, vr( 1, i+1 ), 1, cs, sn )
659 CALL
slascl(
'G', 0, 0, cscale, anrm, n-info, 1, wr( info+1 ),
660 $ max( n-info, 1 ), ierr )
661 CALL
slascl(
'G', 0, 0, cscale, anrm, n-info, 1, wi( info+1 ),
662 $ max( n-info, 1 ), ierr )
664 IF( ( wntsnv .OR. wntsnb ) .AND. icond.EQ.0 )
665 $ CALL
slascl(
'G', 0, 0, cscale, anrm, n, 1, rcondv, n,
668 CALL
slascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, wr, n,
670 CALL
slascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, wi, n,
subroutine strsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, INFO)
STRSNA
LOGICAL function lsame(CA, CB)
LSAME
INTEGER function isamax(N, SX, INCX)
ISAMAX
REAL function slamch(CMACH)
SLAMCH
REAL function slapy2(X, Y)
SLAPY2 returns sqrt(x2+y2).
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
SGEBAK
subroutine shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR
subroutine sgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
SGEBAL
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
REAL function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine sgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, INFO)
SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine sorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SORGHR
subroutine strevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
STREVC
subroutine sgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SGEHRD
subroutine slartg(F, G, CS, SN, R)
SLARTG generates a plane rotation with real cosine and real sine.
REAL function snrm2(N, X, INCX)
SNRM2
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT