284 SUBROUTINE cgeevx( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL,
285 $ ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde,
286 $ rcondv, work, lwork, rwork, info )
294 CHARACTER balanc, jobvl, jobvr, sense
295 INTEGER ihi, ilo, info, lda, ldvl, ldvr, lwork, n
299 REAL rconde( * ), rcondv( * ), rwork( * ),
301 COMPLEX a( lda, * ), vl( ldvl, * ), vr( ldvr, * ),
309 parameter( zero = 0.0e0, one = 1.0e0 )
312 LOGICAL lquery, scalea, wantvl, wantvr, wntsnb, wntsne,
315 INTEGER hswork, i, icond, ierr, itau, iwrk, k, maxwrk,
317 REAL anrm, bignum, cscale, eps, scl, smlnum
336 INTRINSIC aimag, cmplx, conjg, max,
REAL, sqrt
343 lquery = ( lwork.EQ.-1 )
344 wantvl =
lsame( jobvl,
'V' )
345 wantvr =
lsame( jobvr,
'V' )
346 wntsnn =
lsame( sense,
'N' )
347 wntsne =
lsame( sense,
'E' )
348 wntsnv =
lsame( sense,
'V' )
349 wntsnb =
lsame( sense,
'B' )
350 IF( .NOT.(
lsame( balanc,
'N' ) .OR.
lsame( balanc,
'S' ) .OR.
351 $
lsame( balanc,
'P' ) .OR.
lsame( balanc,
'B' ) ) )
THEN
353 ELSE IF( ( .NOT.wantvl ) .AND. ( .NOT.
lsame( jobvl,
'N' ) ) )
THEN
355 ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.
lsame( jobvr,
'N' ) ) )
THEN
357 ELSE IF( .NOT.( wntsnn .OR. wntsne .OR. wntsnb .OR. wntsnv ) .OR.
358 $ ( ( wntsne .OR. wntsnb ) .AND. .NOT.( wantvl .AND.
361 ELSE IF( n.LT.0 )
THEN
363 ELSE IF( lda.LT.max( 1, n ) )
THEN
365 ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) )
THEN
367 ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) )
THEN
387 maxwrk = n + n*
ilaenv( 1,
'CGEHRD',
' ', n, 1, n, 0 )
390 CALL
chseqr(
'S',
'V', n, 1, n, a, lda, w, vl, ldvl,
392 ELSE IF( wantvr )
THEN
393 CALL
chseqr(
'S',
'V', n, 1, n, a, lda, w, vr, ldvr,
397 CALL
chseqr(
'E',
'N', n, 1, n, a, lda, w, vr, ldvr,
400 CALL
chseqr(
'S',
'N', n, 1, n, a, lda, w, vr, ldvr,
406 IF( ( .NOT.wantvl ) .AND. ( .NOT.wantvr ) )
THEN
408 IF( .NOT.( wntsnn .OR. wntsne ) )
409 $ minwrk = max( minwrk, n*n + 2*n )
410 maxwrk = max( maxwrk, hswork )
411 IF( .NOT.( wntsnn .OR. wntsne ) )
412 $ maxwrk = max( maxwrk, n*n + 2*n )
415 IF( .NOT.( wntsnn .OR. wntsne ) )
416 $ minwrk = max( minwrk, n*n + 2*n )
417 maxwrk = max( maxwrk, hswork )
418 maxwrk = max( maxwrk, n + ( n - 1 )*
ilaenv( 1,
'CUNGHR',
419 $
' ', n, 1, n, -1 ) )
420 IF( .NOT.( wntsnn .OR. wntsne ) )
421 $ maxwrk = max( maxwrk, n*n + 2*n )
422 maxwrk = max( maxwrk, 2*n )
424 maxwrk = max( maxwrk, minwrk )
428 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
434 CALL
xerbla(
'CGEEVX', -info )
436 ELSE IF( lquery )
THEN
449 bignum = one / smlnum
450 CALL
slabad( smlnum, bignum )
451 smlnum = sqrt( smlnum ) / eps
452 bignum = one / smlnum
457 anrm =
clange(
'M', n, n, a, lda, dum )
459 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
462 ELSE IF( anrm.GT.bignum )
THEN
467 $ CALL
clascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
471 CALL
cgebal( balanc, n, a, lda, ilo, ihi, scale, ierr )
472 abnrm =
clange(
'1', n, n, a, lda, dum )
475 CALL
slascl(
'G', 0, 0, cscale, anrm, 1, 1, dum, 1, ierr )
485 CALL
cgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
486 $ lwork-iwrk+1, ierr )
494 CALL
clacpy(
'L', n, n, a, lda, vl, ldvl )
500 CALL
cunghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
501 $ lwork-iwrk+1, ierr )
508 CALL
chseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vl, ldvl,
509 $ work( iwrk ), lwork-iwrk+1, info )
517 CALL
clacpy(
'F', n, n, vl, ldvl, vr, ldvr )
520 ELSE IF( wantvr )
THEN
526 CALL
clacpy(
'L', n, n, a, lda, vr, ldvr )
532 CALL
cunghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
533 $ lwork-iwrk+1, ierr )
540 CALL
chseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vr, ldvr,
541 $ work( iwrk ), lwork-iwrk+1, info )
558 CALL
chseqr( job,
'N', n, ilo, ihi, a, lda, w, vr, ldvr,
559 $ work( iwrk ), lwork-iwrk+1, info )
567 IF( wantvl .OR. wantvr )
THEN
573 CALL
ctrevc( side,
'B',
SELECT, n, a, lda, vl, ldvl, vr, ldvr,
574 $ n, nout, work( iwrk ), rwork, ierr )
581 IF( .NOT.wntsnn )
THEN
582 CALL
ctrsna( sense,
'A',
SELECT, n, a, lda, vl, ldvl, vr, ldvr,
583 $ rconde, rcondv, n, nout, work( iwrk ), n, rwork,
591 CALL
cgebak( balanc,
'L', n, ilo, ihi, scale, n, vl, ldvl,
597 scl = one /
scnrm2( n, vl( 1, i ), 1 )
598 CALL
csscal( n, scl, vl( 1, i ), 1 )
600 rwork( k ) =
REAL( VL( K, I ) )**2 +
601 $ aimag( vl( k, i ) )**2
604 tmp = conjg( vl( k, i ) ) / sqrt( rwork( k ) )
605 CALL
cscal( n, tmp, vl( 1, i ), 1 )
606 vl( k, i ) = cmplx(
REAL( VL( K, I ) ), zero )
614 CALL
cgebak( balanc,
'R', n, ilo, ihi, scale, n, vr, ldvr,
620 scl = one /
scnrm2( n, vr( 1, i ), 1 )
621 CALL
csscal( n, scl, vr( 1, i ), 1 )
623 rwork( k ) =
REAL( VR( K, I ) )**2 +
624 $ aimag( vr( k, i ) )**2
627 tmp = conjg( vr( k, i ) ) / sqrt( rwork( k ) )
628 CALL
cscal( n, tmp, vr( 1, i ), 1 )
629 vr( k, i ) = cmplx(
REAL( VR( K, I ) ), zero )
637 CALL
clascl(
'G', 0, 0, cscale, anrm, n-info, 1, w( info+1 ),
638 $ max( n-info, 1 ), ierr )
640 IF( ( wntsnv .OR. wntsnb ) .AND. icond.EQ.0 )
641 $ CALL
slascl(
'G', 0, 0, cscale, anrm, n, 1, rcondv, n,
644 CALL
clascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, w, n, ierr )