217 SUBROUTINE cggev( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
218 $ vl, ldvl, vr, ldvr, work, lwork, rwork, info )
226 CHARACTER JOBVL, JOBVR
227 INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
231 COMPLEX A( lda, * ), ALPHA( * ), B( ldb, * ),
232 $ beta( * ), vl( ldvl, * ), vr( ldvr, * ),
240 parameter( zero = 0.0e0, one = 1.0e0 )
242 parameter( czero = ( 0.0e0, 0.0e0 ),
243 $ cone = ( 1.0e0, 0.0e0 ) )
246 LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
248 INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
249 $ in, iright, irows, irwrk, itau, iwrk, jc, jr,
251 REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
267 EXTERNAL lsame, ilaenv, clange, slamch
270 INTRINSIC abs, aimag, max,
REAL, SQRT
276 abs1( x ) = abs(
REAL( X ) ) + abs( AIMAG( x ) )
282 IF( lsame( jobvl,
'N' ) )
THEN
285 ELSE IF( lsame( jobvl,
'V' ) )
THEN
293 IF( lsame( jobvr,
'N' ) )
THEN
296 ELSE IF( lsame( jobvr,
'V' ) )
THEN
308 lquery = ( lwork.EQ.-1 )
309 IF( ijobvl.LE.0 )
THEN
311 ELSE IF( ijobvr.LE.0 )
THEN
313 ELSE IF( n.LT.0 )
THEN
315 ELSE IF( lda.LT.max( 1, n ) )
THEN
317 ELSE IF( ldb.LT.max( 1, n ) )
THEN
319 ELSE IF( ldvl.LT.1 .OR. ( ilvl .AND. ldvl.LT.n ) )
THEN
321 ELSE IF( ldvr.LT.1 .OR. ( ilvr .AND. ldvr.LT.n ) )
THEN
334 lwkmin = max( 1, 2*n )
335 lwkopt = max( 1, n + n*ilaenv( 1,
'CGEQRF',
' ', n, 1, n, 0 ) )
336 lwkopt = max( lwkopt, n +
337 $ n*ilaenv( 1,
'CUNMQR',
' ', n, 1, n, 0 ) )
339 lwkopt = max( lwkopt, n +
340 $ n*ilaenv( 1,
'CUNGQR',
' ', n, 1, n, -1 ) )
344 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
349 CALL
xerbla(
'CGGEV ', -info )
351 ELSE IF( lquery )
THEN
362 eps = slamch(
'E' )*slamch(
'B' )
363 smlnum = slamch(
'S' )
364 bignum = one / smlnum
365 CALL
slabad( smlnum, bignum )
366 smlnum = sqrt( smlnum ) / eps
367 bignum = one / smlnum
371 anrm = clange(
'M', n, n, a, lda, rwork )
373 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
376 ELSE IF( anrm.GT.bignum )
THEN
381 $ CALL
clascl(
'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
385 bnrm = clange(
'M', n, n, b, ldb, rwork )
387 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN
390 ELSE IF( bnrm.GT.bignum )
THEN
395 $ CALL
clascl(
'G', 0, 0, bnrm, bnrmto, n, n, b, ldb, ierr )
403 CALL
cggbal(
'P', n, a, lda, b, ldb, ilo, ihi, rwork( ileft ),
404 $ rwork( iright ), rwork( irwrk ), ierr )
409 irows = ihi + 1 - ilo
417 CALL
cgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
418 $ work( iwrk ), lwork+1-iwrk, ierr )
423 CALL
cunmqr(
'L',
'C', irows, icols, irows, b( ilo, ilo ), ldb,
424 $ work( itau ), a( ilo, ilo ), lda, work( iwrk ),
425 $ lwork+1-iwrk, ierr )
431 CALL
claset(
'Full', n, n, czero, cone, vl, ldvl )
432 IF( irows.GT.1 )
THEN
433 CALL
clacpy(
'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
434 $ vl( ilo+1, ilo ), ldvl )
436 CALL
cungqr( irows, irows, irows, vl( ilo, ilo ), ldvl,
437 $ work( itau ), work( iwrk ), lwork+1-iwrk, ierr )
443 $ CALL
claset(
'Full', n, n, czero, cone, vr, ldvr )
451 CALL
cgghrd( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
452 $ ldvl, vr, ldvr, ierr )
454 CALL
cgghrd(
'N',
'N', irows, 1, irows, a( ilo, ilo ), lda,
455 $ b( ilo, ilo ), ldb, vl, ldvl, vr, ldvr, ierr )
469 CALL
chgeqz( chtemp, jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb,
470 $ alpha, beta, vl, ldvl, vr, ldvr, work( iwrk ),
471 $ lwork+1-iwrk, rwork( irwrk ), ierr )
473 IF( ierr.GT.0 .AND. ierr.LE.n )
THEN
475 ELSE IF( ierr.GT.n .AND. ierr.LE.2*n )
THEN
498 CALL
ctgevc( chtemp,
'B', ldumma, n, a, lda, b, ldb, vl, ldvl,
499 $ vr, ldvr, n, in, work( iwrk ), rwork( irwrk ),
510 CALL
cggbak(
'P',
'L', n, ilo, ihi, rwork( ileft ),
511 $ rwork( iright ), n, vl, ldvl, ierr )
515 temp = max( temp, abs1( vl( jr, jc ) ) )
521 vl( jr, jc ) = vl( jr, jc )*temp
526 CALL
cggbak(
'P',
'R', n, ilo, ihi, rwork( ileft ),
527 $ rwork( iright ), n, vr, ldvr, ierr )
531 temp = max( temp, abs1( vr( jr, jc ) ) )
537 vr( jr, jc ) = vr( jr, jc )*temp
548 $ CALL
clascl(
'G', 0, 0, anrmto, anrm, n, 1, alpha, n, ierr )
551 $ CALL
clascl(
'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
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 ctgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
CTGEVC
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 cggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
CGGBAK
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
CGGHRD
subroutine cgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRF
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 slabad(SMALL, LARGE)
SLABAD
subroutine cggev(JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
CGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine chgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, INFO)
CHGEQZ
subroutine cungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQR