215 SUBROUTINE zggev( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
216 $ VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO )
223 CHARACTER JOBVL, JOBVR
224 INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
227 DOUBLE PRECISION RWORK( * )
228 COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
229 $ beta( * ), vl( ldvl, * ), vr( ldvr, * ),
236 DOUBLE PRECISION ZERO, ONE
237 parameter( zero = 0.0d0, one = 1.0d0 )
238 COMPLEX*16 CZERO, CONE
239 parameter( czero = ( 0.0d0, 0.0d0 ),
240 $ cone = ( 1.0d0, 0.0d0 ) )
243 LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
245 INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
246 $ in, iright, irows, irwrk, itau, iwrk, jc, jr,
248 DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
263 DOUBLE PRECISION DLAMCH, ZLANGE
264 EXTERNAL lsame, ilaenv, dlamch, zlange
267 INTRINSIC abs, dble, dimag, max, sqrt
270 DOUBLE PRECISION ABS1
273 abs1( x ) = abs( dble( x ) ) + abs( dimag( x ) )
279 IF( lsame( jobvl,
'N' ) )
THEN
282 ELSE IF( lsame( jobvl,
'V' ) )
THEN
290 IF( lsame( jobvr,
'N' ) )
THEN
293 ELSE IF( lsame( jobvr,
'V' ) )
THEN
305 lquery = ( lwork.EQ.-1 )
306 IF( ijobvl.LE.0 )
THEN
308 ELSE IF( ijobvr.LE.0 )
THEN
310 ELSE IF( n.LT.0 )
THEN
312 ELSE IF( lda.LT.max( 1, n ) )
THEN
314 ELSE IF( ldb.LT.max( 1, n ) )
THEN
316 ELSE IF( ldvl.LT.1 .OR. ( ilvl .AND. ldvl.LT.n ) )
THEN
318 ELSE IF( ldvr.LT.1 .OR. ( ilvr .AND. ldvr.LT.n ) )
THEN
331 lwkmin = max( 1, 2*n )
332 lwkopt = max( 1, n + n*ilaenv( 1,
'ZGEQRF',
' ', n, 1, n, 0 ) )
333 lwkopt = max( lwkopt, n +
334 $ n*ilaenv( 1,
'ZUNMQR',
' ', n, 1, n, 0 ) )
336 lwkopt = max( lwkopt, n +
337 $ n*ilaenv( 1,
'ZUNGQR',
' ', n, 1, n, -1 ) )
341 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
346 CALL xerbla(
'ZGGEV ', -info )
348 ELSE IF( lquery )
THEN
359 eps = dlamch(
'E' )*dlamch(
'B' )
360 smlnum = dlamch(
'S' )
361 bignum = one / smlnum
362 CALL dlabad( smlnum, bignum )
363 smlnum = sqrt( smlnum ) / eps
364 bignum = one / smlnum
368 anrm = zlange(
'M', n, n, a, lda, rwork )
370 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
373 ELSE IF( anrm.GT.bignum )
THEN
378 $
CALL zlascl(
'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
382 bnrm = zlange(
'M', n, n, b, ldb, rwork )
384 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN
387 ELSE IF( bnrm.GT.bignum )
THEN
392 $
CALL zlascl(
'G', 0, 0, bnrm, bnrmto, n, n, b, ldb, ierr )
400 CALL zggbal(
'P', n, a, lda, b, ldb, ilo, ihi, rwork( ileft ),
401 $ rwork( iright ), rwork( irwrk ), ierr )
406 irows = ihi + 1 - ilo
414 CALL zgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
415 $ work( iwrk ), lwork+1-iwrk, ierr )
420 CALL zunmqr(
'L',
'C', irows, icols, irows, b( ilo, ilo ), ldb,
421 $ work( itau ), a( ilo, ilo ), lda, work( iwrk ),
422 $ lwork+1-iwrk, ierr )
428 CALL zlaset(
'Full', n, n, czero, cone, vl, ldvl )
429 IF( irows.GT.1 )
THEN
430 CALL zlacpy(
'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
431 $ vl( ilo+1, ilo ), ldvl )
433 CALL zungqr( irows, irows, irows, vl( ilo, ilo ), ldvl,
434 $ work( itau ), work( iwrk ), lwork+1-iwrk, ierr )
440 $
CALL zlaset(
'Full', n, n, czero, cone, vr, ldvr )
448 CALL zgghrd( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
449 $ ldvl, vr, ldvr, ierr )
451 CALL zgghrd(
'N',
'N', irows, 1, irows, a( ilo, ilo ), lda,
452 $ b( ilo, ilo ), ldb, vl, ldvl, vr, ldvr, ierr )
466 CALL zhgeqz( chtemp, jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb,
467 $ alpha, beta, vl, ldvl, vr, ldvr, work( iwrk ),
468 $ lwork+1-iwrk, rwork( irwrk ), ierr )
470 IF( ierr.GT.0 .AND. ierr.LE.n )
THEN
472 ELSE IF( ierr.GT.n .AND. ierr.LE.2*n )
THEN
495 CALL ztgevc( chtemp,
'B', ldumma, n, a, lda, b, ldb, vl, ldvl,
496 $ vr, ldvr, n, in, work( iwrk ), rwork( irwrk ),
507 CALL zggbak(
'P',
'L', n, ilo, ihi, rwork( ileft ),
508 $ rwork( iright ), n, vl, ldvl, ierr )
512 temp = max( temp, abs1( vl( jr, jc ) ) )
518 vl( jr, jc ) = vl( jr, jc )*temp
523 CALL zggbak(
'P',
'R', n, ilo, ihi, rwork( ileft ),
524 $ rwork( iright ), n, vr, ldvr, ierr )
528 temp = max( temp, abs1( vr( jr, jc ) ) )
534 vr( jr, jc ) = vr( jr, jc )*temp
545 $
CALL zlascl(
'G', 0, 0, anrmto, anrm, n, 1, alpha, n, ierr )
548 $
CALL zlascl(
'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
ZGGBAL
subroutine zggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
ZGGBAK
subroutine ztgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
ZTGEVC
subroutine zhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, INFO)
ZHGEQZ
subroutine zggev(JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
ZGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine zungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGQR
subroutine zgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
ZGGHRD
subroutine zunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMQR
subroutine zgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
ZGEQRF VARIANT: left-looking Level 3 BLAS of the algorithm.