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,
349 INTEGER ILAENV, ISAMAX
350 REAL SLAMCH, SLANGE, SLAPY2, SNRM2
351 EXTERNAL lsame, ilaenv, isamax, slamch, slange, slapy2,
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
466 smlnum = slamch(
'S' )
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
611 scl = one / slapy2( snrm2( n, vl( 1, i ), 1 ),
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
618 k = isamax( n, work, 1 )
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
640 scl = one / slapy2( snrm2( n, vr( 1, i ), 1 ),
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
647 k = isamax( n, work, 1 )
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
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.
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.
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT