CGEGV  -  routine  is  deprecated and has been replaced by
       routine CGGEV


SYNOPSIS

       SUBROUTINE CGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB,  ALPHA,
                         BETA,  VL,  LDVL, VR, LDVR, WORK, LWORK,
                         RWORK, INFO )

           CHARACTER     JOBVL, JOBVR

           INTEGER       INFO, LDA, LDB, LDVL, LDVR, LWORK, N

           REAL          RWORK( * )

           COMPLEX       A( LDA, * ), ALPHA( * ), B(  LDB,  *  ),
                         BETA( * ), VL( LDVL, * ), VR( LDVR, * ),
                         WORK( * )


PURPOSE

       This routine is deprecated and has been replaced  by  rou­
       tine  CGGEV.   CGEGV computes for a pair of N-by-N complex
       nonsymmetric matrices A and B, the generalized eigenvalues
       (alpha,  beta), and optionally, the left and/or right gen­
       eralized eigenvectors (VL and VR).

       A generalized eigenvalue for a pair of matrices (A,B)  is,
       roughly  speaking,  a scalar w or a ratio  alpha/beta = w,
       such that  A - w*B is singular.  It is usually represented
       as  the pair (alpha,beta), as there is a reasonable inter­
       pretation for beta=0, and even for  both  being  zero.   A
       good  beginning  reference  is  the book, "Matrix Computa­
       tions", by G. Golub & C. van Loan (Johns Hopkins U. Press)

       A  right generalized eigenvector corresponding to a gener­
       alized eigenvalue  w  for a pair of matrices  (A,B)  is  a
       vector   r   such that  (A - w B) r = 0 .  A left general­
       ized eigenvector is a vector l such that l**H * (A - w  B)
       = 0, where l**H is the
       conjugate-transpose of l.

       Note: this routine performs "full balancing" on A and B --
       see "Further Details", below.


ARGUMENTS

       JOBVL   (input) CHARACTER*1
               = 'N':  do not compute the left generalized eigen­
               vectors;
               = 'V':  compute the left generalized eigenvectors.

       JOBVR   (input) CHARACTER*1
               = 'N':   do  not  compute  the  right  generalized
               eigenvectors;
               =    'V':     compute    the   right   generalized


       N       (input) INTEGER
               The order of the matrices A, B, VL, and VR.  N  >=
               0.

       A       (input/output) COMPLEX array, dimension (LDA, N)
               On  entry, the first of the pair of matrices whose
               generalized eigenvalues and (optionally)  general­
               ized  eigenvectors  are  to be computed.  On exit,
               the contents will have  been  destroyed.   (For  a
               description  of  the  contents  of  A on exit, see
               "Further Details", below.)

       LDA     (input) INTEGER
               The leading dimension of A.  LDA >= max(1,N).

       B       (input/output) COMPLEX array, dimension (LDB, N)
               On entry, the second of the pair of matrices whose
               generalized  eigenvalues and (optionally) general­
               ized eigenvectors are to be  computed.   On  exit,
               the  contents  will  have  been destroyed.  (For a
               description of the contents  of  B  on  exit,  see
               "Further Details", below.)

       LDB     (input) INTEGER
               The leading dimension of B.  LDB >= max(1,N).

       ALPHA   (output) COMPLEX array, dimension (N)
               BETA     (output)  COMPLEX array, dimension (N) On
               exit, ALPHA(j)/BETA(j),  j=1,...,N,  will  be  the
               generalized eigenvalues.

               Note:  the  quotients  ALPHA(j)/BETA(j) may easily
               over- or underflow, and BETA(j) may even be  zero.
               Thus,  the user should avoid naively computing the
               ratio alpha/beta.  However, ALPHA will  be  always
               less  than  and usually comparable with norm(A) in
               magnitude, and BETA always less than  and  usually
               comparable with norm(B).

       VL      (output) COMPLEX array, dimension (LDVL,N)
               If JOBVL = 'V', the left generalized eigenvectors.
               (See "Purpose", above.)  Each eigenvector will  be
               scaled so the largest component will have abs(real
               part) + abs(imag. part) =  1,  *except*  that  for
               eigenvalues  with alpha=beta=0, a zero vector will
               be returned as the corresponding eigenvector.  Not
               referenced if JOBVL = 'N'.

       LDVL    (input) INTEGER
               The leading dimension of the matrix VL. LDVL >= 1,
               and if JOBVL = 'V', LDVL >= N.

               If JOBVR = 'V', the  right  generalized  eigenvec­
               tors.   (See  "Purpose", above.)  Each eigenvector
               will be scaled so the largest component will  have
               abs(real  part)  +  abs(imag.  part) = 1, *except*
               that for eigenvalues  with  alpha=beta=0,  a  zero
               vector  will  be  returned  as  the  corresponding
               eigenvector.  Not referenced if JOBVR = 'N'.

       LDVR    (input) INTEGER
               The leading dimension of the matrix VR. LDVR >= 1,
               and if JOBVR = 'V', LDVR >= N.

       WORK    (workspace/output) COMPLEX array, dimension
               (LWORK)
               On exit, if INFO = 0, WORK(1) returns the  optimal
               LWORK.

       LWORK   (input) INTEGER
               The   dimension  of  the  array  WORK.   LWORK  >=
               max(1,2*N).  For good performance, LWORK must gen­
               erally be larger.  To compute the optimal value of
               LWORK, call ILAENV to get blocksizes (for  CGEQRF,
               CUNMQR,  and CUNGQR.)  Then compute: NB  -- MAX of
               the blocksizes for CGEQRF, CUNMQR, and CUNGQR; The
               optimal LWORK is  MAX( 2*N, N*(NB+1) ).

               If  LWORK = -1, then a workspace query is assumed;
               the routine only calculates the  optimal  size  of
               the  WORK  array,  returns this value as the first
               entry of the WORK  array,  and  no  error  message
               related to LWORK is issued by XERBLA.

       RWORK   (workspace/output) REAL array, dimension (8*N)

       INFO    (output) INTEGER
               = 0:  successful exit
               < 0:  if INFO = -i, the i-th argument had an ille­
               gal value.
               =1,...,N: The QZ iteration failed.   No  eigenvec­
               tors   have  been  calculated,  but  ALPHA(j)  and
               BETA(j) should be correct for  j=INFO+1,...,N.   >
               N:  errors that usually indicate LAPACK problems:
               =N+1: error return from CGGBAL
               =N+2: error return from CGEQRF
               =N+3: error return from CUNMQR
               =N+4: error return from CUNGQR
               =N+5: error return from CGGHRD
               =N+6:  error return from CHGEQZ (other than failed
               iteration) =N+7: error return from CTGEVC
               =N+8: error return from CGGBAK (computing VL)
               =N+9: error return from CGGBAK (computing VR)
               =N+10: error return from CLASCL (various calls)

       Balancing
       ---------

       This driver calls CGGBAL to both permute  and  scale  rows
       and  columns  of  A and B.  The permutations PL and PR are
       chosen so that PL*A*PR and PL*B*R will be upper triangular
       except  for the diagonal blocks A(i:j,i:j) and B(i:j,i:j),
       with i and j as close together as possible.  The  diagonal
       scaling  matrices  DL  and  DR are chosen so that the pair
       DL*PL*A*PR*DR, DL*PL*B*PR*DR have elements  close  to  one
       (except for the elements that start out zero.)

       After  the  eigenvalues  and  eigenvectors of the balanced
       matrices have been computed, CGGBAK transforms the  eigen­
       vectors  back  to  what  they  would have been (in perfect
       arithmetic) if they had not been balanced.

       Contents of A and B on Exit
       -------- -- - --- - -- ----

       If any eigenvectors  are  computed  (either  JOBVL='V'  or
       JOBVR='V'  or  both), then on exit the arrays A and B will
       contain the complex Schur form[*] of the  "balanced"  ver­
       sions  of  A and B.  If no eigenvectors are computed, then
       only the diagonal blocks will be correct.

       [*] In other words, upper triangular form.


Man(1) output converted with man2html