282 SUBROUTINE cgegv( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
283 $ vl, ldvl, vr, ldvr, work, lwork, rwork, info )
291 CHARACTER JOBVL, JOBVR
292 INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
296 COMPLEX A( lda, * ), ALPHA( * ), B( ldb, * ),
297 $ beta( * ), vl( ldvl, * ), vr( ldvr, * ),
305 parameter ( zero = 0.0e0, one = 1.0e0 )
307 parameter ( czero = ( 0.0e0, 0.0e0 ),
308 $ cone = ( 1.0e0, 0.0e0 ) )
311 LOGICAL ILIMIT, ILV, ILVL, ILVR, LQUERY
313 INTEGER ICOLS, IHI, IINFO, IJOBVL, IJOBVR, ILEFT, ILO,
314 $ in, iright, irows, irwork, itau, iwork, jc, jr,
315 $ lopt, lwkmin, lwkopt, nb, nb1, nb2, nb3
316 REAL ABSAI, ABSAR, ABSB, ANRM, ANRM1, ANRM2, BNRM,
317 $ bnrm1, bnrm2, eps, safmax, safmin, salfai,
318 $ salfar, sbeta, scale, temp
332 EXTERNAL ilaenv, lsame, clange, slamch
335 INTRINSIC abs, aimag, cmplx, int, max, real
341 abs1( x ) = abs(
REAL( X ) ) + abs( AIMAG( x ) )
347 IF( lsame( jobvl,
'N' ) )
THEN
350 ELSE IF( lsame( jobvl,
'V' ) )
THEN
358 IF( lsame( jobvr,
'N' ) )
THEN
361 ELSE IF( lsame( jobvr,
'V' ) )
THEN
372 lwkmin = max( 2*n, 1 )
375 lquery = ( lwork.EQ.-1 )
377 IF( ijobvl.LE.0 )
THEN
379 ELSE IF( ijobvr.LE.0 )
THEN
381 ELSE IF( n.LT.0 )
THEN
383 ELSE IF( lda.LT.max( 1, n ) )
THEN
385 ELSE IF( ldb.LT.max( 1, n ) )
THEN
387 ELSE IF( ldvl.LT.1 .OR. ( ilvl .AND. ldvl.LT.n ) )
THEN
389 ELSE IF( ldvr.LT.1 .OR. ( ilvr .AND. ldvr.LT.n ) )
THEN
391 ELSE IF( lwork.LT.lwkmin .AND. .NOT.lquery )
THEN
396 nb1 = ilaenv( 1,
'CGEQRF',
' ', n, n, -1, -1 )
397 nb2 = ilaenv( 1,
'CUNMQR',
' ', n, n, n, -1 )
398 nb3 = ilaenv( 1,
'CUNGQR',
' ', n, n, n, -1 )
399 nb = max( nb1, nb2, nb3 )
400 lopt = max( 2*n, n*(nb+1) )
405 CALL xerbla(
'CGEGV ', -info )
407 ELSE IF( lquery )
THEN
418 eps = slamch(
'E' )*slamch(
'B' )
419 safmin = slamch(
'S' )
420 safmin = safmin + safmin
421 safmax = one / safmin
425 anrm = clange(
'M', n, n, a, lda, rwork )
428 IF( anrm.LT.one )
THEN
429 IF( safmax*anrm.LT.one )
THEN
435 IF( anrm.GT.zero )
THEN
436 CALL clascl(
'G', -1, -1, anrm, one, n, n, a, lda, iinfo )
437 IF( iinfo.NE.0 )
THEN
445 bnrm = clange(
'M', n, n, b, ldb, rwork )
448 IF( bnrm.LT.one )
THEN
449 IF( safmax*bnrm.LT.one )
THEN
455 IF( bnrm.GT.zero )
THEN
456 CALL clascl(
'G', -1, -1, bnrm, one, n, n, b, ldb, iinfo )
457 IF( iinfo.NE.0 )
THEN
469 CALL cggbal(
'P', n, a, lda, b, ldb, ilo, ihi, rwork( ileft ),
470 $ rwork( iright ), rwork( irwork ), iinfo )
471 IF( iinfo.NE.0 )
THEN
478 irows = ihi + 1 - ilo
486 CALL cgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
487 $ work( iwork ), lwork+1-iwork, iinfo )
489 $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
490 IF( iinfo.NE.0 )
THEN
495 CALL cunmqr(
'L',
'C', irows, icols, irows, b( ilo, ilo ), ldb,
496 $ work( itau ), a( ilo, ilo ), lda, work( iwork ),
497 $ lwork+1-iwork, iinfo )
499 $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
500 IF( iinfo.NE.0 )
THEN
506 CALL claset(
'Full', n, n, czero, cone, vl, ldvl )
507 CALL clacpy(
'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
508 $ vl( ilo+1, ilo ), ldvl )
509 CALL cungqr( irows, irows, irows, vl( ilo, ilo ), ldvl,
510 $ work( itau ), work( iwork ), lwork+1-iwork,
513 $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
514 IF( iinfo.NE.0 )
THEN
521 $
CALL claset(
'Full', n, n, czero, cone, vr, ldvr )
529 CALL cgghrd( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
530 $ ldvl, vr, ldvr, iinfo )
532 CALL cgghrd(
'N',
'N', irows, 1, irows, a( ilo, ilo ), lda,
533 $ b( ilo, ilo ), ldb, vl, ldvl, vr, ldvr, iinfo )
535 IF( iinfo.NE.0 )
THEN
548 CALL chgeqz( chtemp, jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb,
549 $ alpha, beta, vl, ldvl, vr, ldvr, work( iwork ),
550 $ lwork+1-iwork, rwork( irwork ), iinfo )
552 $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
553 IF( iinfo.NE.0 )
THEN
554 IF( iinfo.GT.0 .AND. iinfo.LE.n )
THEN
556 ELSE IF( iinfo.GT.n .AND. iinfo.LE.2*n )
THEN
578 CALL ctgevc( chtemp,
'B', ldumma, n, a, lda, b, ldb, vl, ldvl,
579 $ vr, ldvr, n, in, work( iwork ), rwork( irwork ),
581 IF( iinfo.NE.0 )
THEN
589 CALL cggbak(
'P',
'L', n, ilo, ihi, rwork( ileft ),
590 $ rwork( iright ), n, vl, ldvl, iinfo )
591 IF( iinfo.NE.0 )
THEN
598 temp = max( temp, abs1( vl( jr, jc ) ) )
604 vl( jr, jc ) = vl( jr, jc )*temp
609 CALL cggbak(
'P',
'R', n, ilo, ihi, rwork( ileft ),
610 $ rwork( iright ), n, vr, ldvr, iinfo )
611 IF( iinfo.NE.0 )
THEN
618 temp = max( temp, abs1( vr( jr, jc ) ) )
624 vr( jr, jc ) = vr( jr, jc )*temp
642 absar = abs(
REAL( ALPHA( JC ) ) )
643 absai = abs( aimag( alpha( jc ) ) )
644 absb = abs(
REAL( BETA( JC ) ) )
645 salfar = anrm*
REAL( ALPHA( JC ) )
646 salfai = anrm*aimag( alpha( jc ) )
647 sbeta = bnrm*
REAL( BETA( JC ) )
653 IF( abs( salfai ).LT.safmin .AND. absai.GE.
654 $ max( safmin, eps*absar, eps*absb ) )
THEN
656 scale = ( safmin / anrm1 ) / max( safmin, anrm2*absai )
661 IF( abs( salfar ).LT.safmin .AND. absar.GE.
662 $ max( safmin, eps*absai, eps*absb ) )
THEN
664 scale = max( scale, ( safmin / anrm1 ) /
665 $ max( safmin, anrm2*absar ) )
670 IF( abs( sbeta ).LT.safmin .AND. absb.GE.
671 $ max( safmin, eps*absar, eps*absai ) )
THEN
673 scale = max( scale, ( safmin / bnrm1 ) /
674 $ max( safmin, bnrm2*absb ) )
680 temp = ( scale*safmin )*max( abs( salfar ), abs( salfai ),
683 $ scale = scale / temp
691 salfar = ( scale*
REAL( ALPHA( JC ) ) )*anrm
692 salfai = ( scale*aimag( alpha( jc ) ) )*anrm
693 sbeta = ( scale*beta( jc ) )*bnrm
695 alpha( jc ) = cmplx( salfar, salfai )
subroutine cgegv(JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
CGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine cggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
CGGBAL
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR
subroutine cgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
CGGHRD
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine cgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRF
subroutine cggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
CGGBAK
subroutine chgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, INFO)
CHGEQZ
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ctgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
CTGEVC
subroutine cungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQR