Annotation of rpl/lapack/lapack/zggev3.f, revision 1.4

1.1       bertrand    1: *> \brief <b> ZGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm)</b>
                      2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
                      5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
                      7: *
                      8: *> \htmlonly
                      9: *> Download ZGGEV3 + dependencies
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zggev3.f">
                     11: *> [TGZ]</a>
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zggev3.f">
                     13: *> [ZIP]</a>
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zggev3.f">
                     15: *> [TXT]</a>
                     16: *> \endhtmlonly
                     17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
                     22: *                          VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO )
                     23: *
                     24: *       .. Scalar Arguments ..
                     25: *       CHARACTER          JOBVL, JOBVR
                     26: *       INTEGER            INFO, LDA, LDB, LDVL, LDVR, LWORK, N
                     27: *       ..
                     28: *       .. Array Arguments ..
                     29: *       DOUBLE PRECISION   RWORK( * )
                     30: *       COMPLEX*16         A( LDA, * ), ALPHA( * ), B( LDB, * ),
                     31: *      $                   BETA( * ), VL( LDVL, * ), VR( LDVR, * ),
                     32: *      $                   WORK( * )
                     33: *       ..
                     34: *
                     35: *
                     36: *> \par Purpose:
                     37: *  =============
                     38: *>
                     39: *> \verbatim
                     40: *>
                     41: *> ZGGEV3 computes for a pair of N-by-N complex nonsymmetric matrices
                     42: *> (A,B), the generalized eigenvalues, and optionally, the left and/or
                     43: *> right generalized eigenvectors.
                     44: *>
                     45: *> A generalized eigenvalue for a pair of matrices (A,B) is a scalar
                     46: *> lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
                     47: *> singular. It is usually represented as the pair (alpha,beta), as
                     48: *> there is a reasonable interpretation for beta=0, and even for both
                     49: *> being zero.
                     50: *>
                     51: *> The right generalized eigenvector v(j) corresponding to the
                     52: *> generalized eigenvalue lambda(j) of (A,B) satisfies
                     53: *>
                     54: *>              A * v(j) = lambda(j) * B * v(j).
                     55: *>
                     56: *> The left generalized eigenvector u(j) corresponding to the
                     57: *> generalized eigenvalues lambda(j) of (A,B) satisfies
                     58: *>
                     59: *>              u(j)**H * A = lambda(j) * u(j)**H * B
                     60: *>
                     61: *> where u(j)**H is the conjugate-transpose of u(j).
                     62: *> \endverbatim
                     63: *
                     64: *  Arguments:
                     65: *  ==========
                     66: *
                     67: *> \param[in] JOBVL
                     68: *> \verbatim
                     69: *>          JOBVL is CHARACTER*1
                     70: *>          = 'N':  do not compute the left generalized eigenvectors;
                     71: *>          = 'V':  compute the left generalized eigenvectors.
                     72: *> \endverbatim
                     73: *>
                     74: *> \param[in] JOBVR
                     75: *> \verbatim
                     76: *>          JOBVR is CHARACTER*1
                     77: *>          = 'N':  do not compute the right generalized eigenvectors;
                     78: *>          = 'V':  compute the right generalized eigenvectors.
                     79: *> \endverbatim
                     80: *>
                     81: *> \param[in] N
                     82: *> \verbatim
                     83: *>          N is INTEGER
                     84: *>          The order of the matrices A, B, VL, and VR.  N >= 0.
                     85: *> \endverbatim
                     86: *>
                     87: *> \param[in,out] A
                     88: *> \verbatim
                     89: *>          A is COMPLEX*16 array, dimension (LDA, N)
                     90: *>          On entry, the matrix A in the pair (A,B).
                     91: *>          On exit, A has been overwritten.
                     92: *> \endverbatim
                     93: *>
                     94: *> \param[in] LDA
                     95: *> \verbatim
                     96: *>          LDA is INTEGER
                     97: *>          The leading dimension of A.  LDA >= max(1,N).
                     98: *> \endverbatim
                     99: *>
                    100: *> \param[in,out] B
                    101: *> \verbatim
                    102: *>          B is COMPLEX*16 array, dimension (LDB, N)
                    103: *>          On entry, the matrix B in the pair (A,B).
                    104: *>          On exit, B has been overwritten.
                    105: *> \endverbatim
                    106: *>
                    107: *> \param[in] LDB
                    108: *> \verbatim
                    109: *>          LDB is INTEGER
                    110: *>          The leading dimension of B.  LDB >= max(1,N).
                    111: *> \endverbatim
                    112: *>
                    113: *> \param[out] ALPHA
                    114: *> \verbatim
                    115: *>          ALPHA is COMPLEX*16 array, dimension (N)
                    116: *> \endverbatim
                    117: *>
                    118: *> \param[out] BETA
                    119: *> \verbatim
                    120: *>          BETA is COMPLEX*16 array, dimension (N)
                    121: *>          On exit, ALPHA(j)/BETA(j), j=1,...,N, will be the
                    122: *>          generalized eigenvalues.
                    123: *>
                    124: *>          Note: the quotients ALPHA(j)/BETA(j) may easily over- or
                    125: *>          underflow, and BETA(j) may even be zero.  Thus, the user
                    126: *>          should avoid naively computing the ratio alpha/beta.
                    127: *>          However, ALPHA will be always less than and usually
                    128: *>          comparable with norm(A) in magnitude, and BETA always less
                    129: *>          than and usually comparable with norm(B).
                    130: *> \endverbatim
                    131: *>
                    132: *> \param[out] VL
                    133: *> \verbatim
                    134: *>          VL is COMPLEX*16 array, dimension (LDVL,N)
                    135: *>          If JOBVL = 'V', the left generalized eigenvectors u(j) are
                    136: *>          stored one after another in the columns of VL, in the same
                    137: *>          order as their eigenvalues.
                    138: *>          Each eigenvector is scaled so the largest component has
                    139: *>          abs(real part) + abs(imag. part) = 1.
                    140: *>          Not referenced if JOBVL = 'N'.
                    141: *> \endverbatim
                    142: *>
                    143: *> \param[in] LDVL
                    144: *> \verbatim
                    145: *>          LDVL is INTEGER
                    146: *>          The leading dimension of the matrix VL. LDVL >= 1, and
                    147: *>          if JOBVL = 'V', LDVL >= N.
                    148: *> \endverbatim
                    149: *>
                    150: *> \param[out] VR
                    151: *> \verbatim
                    152: *>          VR is COMPLEX*16 array, dimension (LDVR,N)
                    153: *>          If JOBVR = 'V', the right generalized eigenvectors v(j) are
                    154: *>          stored one after another in the columns of VR, in the same
                    155: *>          order as their eigenvalues.
                    156: *>          Each eigenvector is scaled so the largest component has
                    157: *>          abs(real part) + abs(imag. part) = 1.
                    158: *>          Not referenced if JOBVR = 'N'.
                    159: *> \endverbatim
                    160: *>
                    161: *> \param[in] LDVR
                    162: *> \verbatim
                    163: *>          LDVR is INTEGER
                    164: *>          The leading dimension of the matrix VR. LDVR >= 1, and
                    165: *>          if JOBVR = 'V', LDVR >= N.
                    166: *> \endverbatim
                    167: *>
                    168: *> \param[out] WORK
                    169: *> \verbatim
                    170: *>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
                    171: *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
                    172: *> \endverbatim
                    173: *>
                    174: *> \param[in] LWORK
                    175: *> \verbatim
                    176: *>          LWORK is INTEGER
                    177: *>          The dimension of the array WORK.
                    178: *>
                    179: *>          If LWORK = -1, then a workspace query is assumed; the routine
                    180: *>          only calculates the optimal size of the WORK array, returns
                    181: *>          this value as the first entry of the WORK array, and no error
                    182: *>          message related to LWORK is issued by XERBLA.
                    183: *> \endverbatim
                    184: *>
                    185: *> \param[out] RWORK
                    186: *> \verbatim
                    187: *>          RWORK is DOUBLE PRECISION array, dimension (8*N)
                    188: *> \endverbatim
                    189: *>
                    190: *> \param[out] INFO
                    191: *> \verbatim
                    192: *>          INFO is INTEGER
                    193: *>          = 0:  successful exit
                    194: *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
                    195: *>          =1,...,N:
                    196: *>                The QZ iteration failed.  No eigenvectors have been
                    197: *>                calculated, but ALPHA(j) and BETA(j) should be
                    198: *>                correct for j=INFO+1,...,N.
                    199: *>          > N:  =N+1: other then QZ iteration failed in DHGEQZ,
                    200: *>                =N+2: error return from DTGEVC.
                    201: *> \endverbatim
                    202: *
                    203: *  Authors:
                    204: *  ========
                    205: *
                    206: *> \author Univ. of Tennessee
                    207: *> \author Univ. of California Berkeley
                    208: *> \author Univ. of Colorado Denver
                    209: *> \author NAG Ltd.
                    210: *
                    211: *> \date January 2015
                    212: *
                    213: *> \ingroup complex16GEeigen
                    214: *
                    215: *  =====================================================================
                    216:       SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
                    217:      $                   VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO )
                    218: *
1.2       bertrand  219: *  -- LAPACK driver routine (version 3.6.1) --
1.1       bertrand  220: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    221: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                    222: *     January 2015
                    223: *
                    224: *     .. Scalar Arguments ..
                    225:       CHARACTER          JOBVL, JOBVR
                    226:       INTEGER            INFO, LDA, LDB, LDVL, LDVR, LWORK, N
                    227: *     ..
                    228: *     .. Array Arguments ..
                    229:       DOUBLE PRECISION   RWORK( * )
                    230:       COMPLEX*16         A( LDA, * ), ALPHA( * ), B( LDB, * ),
                    231:      $                   BETA( * ), VL( LDVL, * ), VR( LDVR, * ),
                    232:      $                   WORK( * )
                    233: *     ..
                    234: *
                    235: *  =====================================================================
                    236: *
                    237: *     .. Parameters ..
                    238:       DOUBLE PRECISION   ZERO, ONE
                    239:       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
                    240:       COMPLEX*16         CZERO, CONE
                    241:       PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ),
                    242:      $                   CONE = ( 1.0D0, 0.0D0 ) )
                    243: *     ..
                    244: *     .. Local Scalars ..
                    245:       LOGICAL            ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
                    246:       CHARACTER          CHTEMP
                    247:       INTEGER            ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
                    248:      $                   IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR,
                    249:      $                   LWKOPT
                    250:       DOUBLE PRECISION   ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
                    251:      $                   SMLNUM, TEMP
                    252:       COMPLEX*16         X
                    253: *     ..
                    254: *     .. Local Arrays ..
                    255:       LOGICAL            LDUMMA( 1 )
                    256: *     ..
                    257: *     .. External Subroutines ..
                    258:       EXTERNAL           DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3,
                    259:      $                   ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR,
                    260:      $                   ZUNMQR
                    261: *     ..
                    262: *     .. External Functions ..
                    263:       LOGICAL            LSAME
                    264:       DOUBLE PRECISION   DLAMCH, ZLANGE
                    265:       EXTERNAL           LSAME, DLAMCH, ZLANGE
                    266: *     ..
                    267: *     .. Intrinsic Functions ..
                    268:       INTRINSIC          ABS, DBLE, DIMAG, MAX, SQRT
                    269: *     ..
                    270: *     .. Statement Functions ..
                    271:       DOUBLE PRECISION   ABS1
                    272: *     ..
                    273: *     .. Statement Function definitions ..
                    274:       ABS1( X ) = ABS( DBLE( X ) ) + ABS( DIMAG( X ) )
                    275: *     ..
                    276: *     .. Executable Statements ..
                    277: *
                    278: *     Decode the input arguments
                    279: *
                    280:       IF( LSAME( JOBVL, 'N' ) ) THEN
                    281:          IJOBVL = 1
                    282:          ILVL = .FALSE.
                    283:       ELSE IF( LSAME( JOBVL, 'V' ) ) THEN
                    284:          IJOBVL = 2
                    285:          ILVL = .TRUE.
                    286:       ELSE
                    287:          IJOBVL = -1
                    288:          ILVL = .FALSE.
                    289:       END IF
                    290: *
                    291:       IF( LSAME( JOBVR, 'N' ) ) THEN
                    292:          IJOBVR = 1
                    293:          ILVR = .FALSE.
                    294:       ELSE IF( LSAME( JOBVR, 'V' ) ) THEN
                    295:          IJOBVR = 2
                    296:          ILVR = .TRUE.
                    297:       ELSE
                    298:          IJOBVR = -1
                    299:          ILVR = .FALSE.
                    300:       END IF
                    301:       ILV = ILVL .OR. ILVR
                    302: *
                    303: *     Test the input arguments
                    304: *
                    305:       INFO = 0
                    306:       LQUERY = ( LWORK.EQ.-1 )
                    307:       IF( IJOBVL.LE.0 ) THEN
                    308:          INFO = -1
                    309:       ELSE IF( IJOBVR.LE.0 ) THEN
                    310:          INFO = -2
                    311:       ELSE IF( N.LT.0 ) THEN
                    312:          INFO = -3
                    313:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
                    314:          INFO = -5
                    315:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
                    316:          INFO = -7
                    317:       ELSE IF( LDVL.LT.1 .OR. ( ILVL .AND. LDVL.LT.N ) ) THEN
                    318:          INFO = -11
                    319:       ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
                    320:          INFO = -13
                    321:       ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
                    322:          INFO = -15
                    323:       END IF
                    324: *
                    325: *     Compute workspace
                    326: *
                    327:       IF( INFO.EQ.0 ) THEN
                    328:          CALL ZGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
                    329:          LWKOPT = MAX( 1,  N+INT( WORK( 1 ) ) )
                    330:          CALL ZUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK,
                    331:      $                -1, IERR )
                    332:          LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
                    333:          IF( ILVL ) THEN
                    334:             CALL ZUNGQR( N, N, N, VL, LDVL, WORK, WORK, -1, IERR )
                    335:             LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
                    336:          END IF
                    337:          IF( ILV ) THEN
                    338:             CALL ZGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL,
                    339:      $                   LDVL, VR, LDVR, WORK, -1, IERR )
                    340:             LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
                    341:             CALL ZHGEQZ( 'S', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
                    342:      $                   ALPHA, BETA, VL, LDVL, VR, LDVR, WORK, -1,
1.2       bertrand  343:      $                   RWORK, IERR )
1.1       bertrand  344:             LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
                    345:          ELSE
                    346:             CALL ZGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL,
                    347:      $                   LDVL, VR, LDVR, WORK, -1, IERR )
                    348:             LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
                    349:             CALL ZHGEQZ( 'E', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
                    350:      $                   ALPHA, BETA, VL, LDVL, VR, LDVR, WORK, -1,
1.2       bertrand  351:      $                   RWORK, IERR )
1.1       bertrand  352:             LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
                    353:          END IF
                    354:          WORK( 1 ) = DCMPLX( LWKOPT )
                    355:       END IF
                    356: *
                    357:       IF( INFO.NE.0 ) THEN
                    358:          CALL XERBLA( 'ZGGEV3 ', -INFO )
                    359:          RETURN
                    360:       ELSE IF( LQUERY ) THEN
                    361:          RETURN
                    362:       END IF
                    363: *
                    364: *     Quick return if possible
                    365: *
                    366:       IF( N.EQ.0 )
                    367:      $   RETURN
                    368: *
                    369: *     Get machine constants
                    370: *
                    371:       EPS = DLAMCH( 'E' )*DLAMCH( 'B' )
                    372:       SMLNUM = DLAMCH( 'S' )
                    373:       BIGNUM = ONE / SMLNUM
                    374:       CALL DLABAD( SMLNUM, BIGNUM )
                    375:       SMLNUM = SQRT( SMLNUM ) / EPS
                    376:       BIGNUM = ONE / SMLNUM
                    377: *
                    378: *     Scale A if max element outside range [SMLNUM,BIGNUM]
                    379: *
                    380:       ANRM = ZLANGE( 'M', N, N, A, LDA, RWORK )
                    381:       ILASCL = .FALSE.
                    382:       IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
                    383:          ANRMTO = SMLNUM
                    384:          ILASCL = .TRUE.
                    385:       ELSE IF( ANRM.GT.BIGNUM ) THEN
                    386:          ANRMTO = BIGNUM
                    387:          ILASCL = .TRUE.
                    388:       END IF
                    389:       IF( ILASCL )
                    390:      $   CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
                    391: *
                    392: *     Scale B if max element outside range [SMLNUM,BIGNUM]
                    393: *
                    394:       BNRM = ZLANGE( 'M', N, N, B, LDB, RWORK )
                    395:       ILBSCL = .FALSE.
                    396:       IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
                    397:          BNRMTO = SMLNUM
                    398:          ILBSCL = .TRUE.
                    399:       ELSE IF( BNRM.GT.BIGNUM ) THEN
                    400:          BNRMTO = BIGNUM
                    401:          ILBSCL = .TRUE.
                    402:       END IF
                    403:       IF( ILBSCL )
                    404:      $   CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
                    405: *
                    406: *     Permute the matrices A, B to isolate eigenvalues if possible
                    407: *
                    408:       ILEFT = 1
                    409:       IRIGHT = N + 1
                    410:       IRWRK = IRIGHT + N
                    411:       CALL ZGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, RWORK( ILEFT ),
                    412:      $             RWORK( IRIGHT ), RWORK( IRWRK ), IERR )
                    413: *
                    414: *     Reduce B to triangular form (QR decomposition of B)
                    415: *
                    416:       IROWS = IHI + 1 - ILO
                    417:       IF( ILV ) THEN
                    418:          ICOLS = N + 1 - ILO
                    419:       ELSE
                    420:          ICOLS = IROWS
                    421:       END IF
                    422:       ITAU = 1
                    423:       IWRK = ITAU + IROWS
                    424:       CALL ZGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
                    425:      $             WORK( IWRK ), LWORK+1-IWRK, IERR )
                    426: *
                    427: *     Apply the orthogonal transformation to matrix A
                    428: *
                    429:       CALL ZUNMQR( 'L', 'C', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
                    430:      $             WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
                    431:      $             LWORK+1-IWRK, IERR )
                    432: *
                    433: *     Initialize VL
                    434: *
                    435:       IF( ILVL ) THEN
                    436:          CALL ZLASET( 'Full', N, N, CZERO, CONE, VL, LDVL )
                    437:          IF( IROWS.GT.1 ) THEN
                    438:             CALL ZLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
                    439:      $                   VL( ILO+1, ILO ), LDVL )
                    440:          END IF
                    441:          CALL ZUNGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
                    442:      $                WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
                    443:       END IF
                    444: *
                    445: *     Initialize VR
                    446: *
                    447:       IF( ILVR )
                    448:      $   CALL ZLASET( 'Full', N, N, CZERO, CONE, VR, LDVR )
                    449: *
                    450: *     Reduce to generalized Hessenberg form
                    451: *
                    452:       IF( ILV ) THEN
                    453: *
                    454: *        Eigenvectors requested -- work on whole matrix.
                    455: *
                    456:          CALL ZGGHD3( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
                    457:      $                LDVL, VR, LDVR, WORK( IWRK ), LWORK+1-IWRK, IERR )
                    458:       ELSE
                    459:          CALL ZGGHD3( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
                    460:      $                B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR,
                    461:      $                WORK( IWRK ), LWORK+1-IWRK, IERR )
                    462:       END IF
                    463: *
                    464: *     Perform QZ algorithm (Compute eigenvalues, and optionally, the
                    465: *     Schur form and Schur vectors)
                    466: *
                    467:       IWRK = ITAU
                    468:       IF( ILV ) THEN
                    469:          CHTEMP = 'S'
                    470:       ELSE
                    471:          CHTEMP = 'E'
                    472:       END IF
                    473:       CALL ZHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
                    474:      $             ALPHA, BETA, VL, LDVL, VR, LDVR, WORK( IWRK ),
                    475:      $             LWORK+1-IWRK, RWORK( IRWRK ), IERR )
                    476:       IF( IERR.NE.0 ) THEN
                    477:          IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
                    478:             INFO = IERR
                    479:          ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
                    480:             INFO = IERR - N
                    481:          ELSE
                    482:             INFO = N + 1
                    483:          END IF
                    484:          GO TO 70
                    485:       END IF
                    486: *
                    487: *     Compute Eigenvectors
                    488: *
                    489:       IF( ILV ) THEN
                    490:          IF( ILVL ) THEN
                    491:             IF( ILVR ) THEN
                    492:                CHTEMP = 'B'
                    493:             ELSE
                    494:                CHTEMP = 'L'
                    495:             END IF
                    496:          ELSE
                    497:             CHTEMP = 'R'
                    498:          END IF
                    499: *
                    500:          CALL ZTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL,
                    501:      $                VR, LDVR, N, IN, WORK( IWRK ), RWORK( IRWRK ),
                    502:      $                IERR )
                    503:          IF( IERR.NE.0 ) THEN
                    504:             INFO = N + 2
                    505:             GO TO 70
                    506:          END IF
                    507: *
                    508: *        Undo balancing on VL and VR and normalization
                    509: *
                    510:          IF( ILVL ) THEN
                    511:             CALL ZGGBAK( 'P', 'L', N, ILO, IHI, RWORK( ILEFT ),
                    512:      $                   RWORK( IRIGHT ), N, VL, LDVL, IERR )
                    513:             DO 30 JC = 1, N
                    514:                TEMP = ZERO
                    515:                DO 10 JR = 1, N
                    516:                   TEMP = MAX( TEMP, ABS1( VL( JR, JC ) ) )
                    517:    10          CONTINUE
                    518:                IF( TEMP.LT.SMLNUM )
                    519:      $            GO TO 30
                    520:                TEMP = ONE / TEMP
                    521:                DO 20 JR = 1, N
                    522:                   VL( JR, JC ) = VL( JR, JC )*TEMP
                    523:    20          CONTINUE
                    524:    30       CONTINUE
                    525:          END IF
                    526:          IF( ILVR ) THEN
                    527:             CALL ZGGBAK( 'P', 'R', N, ILO, IHI, RWORK( ILEFT ),
                    528:      $                   RWORK( IRIGHT ), N, VR, LDVR, IERR )
                    529:             DO 60 JC = 1, N
                    530:                TEMP = ZERO
                    531:                DO 40 JR = 1, N
                    532:                   TEMP = MAX( TEMP, ABS1( VR( JR, JC ) ) )
                    533:    40          CONTINUE
                    534:                IF( TEMP.LT.SMLNUM )
                    535:      $            GO TO 60
                    536:                TEMP = ONE / TEMP
                    537:                DO 50 JR = 1, N
                    538:                   VR( JR, JC ) = VR( JR, JC )*TEMP
                    539:    50          CONTINUE
                    540:    60       CONTINUE
                    541:          END IF
                    542:       END IF
                    543: *
                    544: *     Undo scaling if necessary
                    545: *
                    546:    70 CONTINUE
                    547: *
                    548:       IF( ILASCL )
                    549:      $   CALL ZLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
                    550: *
                    551:       IF( ILBSCL )
                    552:      $   CALL ZLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
                    553: *
                    554:       WORK( 1 ) = DCMPLX( LWKOPT )
                    555:       RETURN
                    556: *
                    557: *     End of ZGGEV3
                    558: *
                    559:       END

CVSweb interface <joel.bertrand@systella.fr>