CTREVC  -  compute  some  or  all of the right and/or left
       eigenvectors of a complex upper triangular matrix T


SYNOPSIS

       SUBROUTINE CTREVC( SIDE, HOWMNY, SELECT, N,  T,  LDT,  VL,
                          LDVL,  VR,  LDVR,  MM,  M, WORK, RWORK,
                          INFO )

           CHARACTER      HOWMNY, SIDE

           INTEGER        INFO, LDT, LDVL, LDVR, M, MM, N

           LOGICAL        SELECT( * )

           REAL           RWORK( * )

           COMPLEX        T( LDT, * ), VL( LDVL, * ), VR( LDVR, *
                          ), WORK( * )


PURPOSE

       CTREVC  computes  some  or  all  of  the right and/or left
       eigenvectors of a complex upper triangular matrix T.   The
       right eigenvector x and the left eigenvector y of T corre­
       sponding to an eigenvalue w are defined by:

                    T*x = w*x,     y'*T = w*y'

       where y' denotes the conjugate transpose of the vector  y.

       If  all eigenvectors are requested, the routine may either
       return the matrices X and/or Y of right or left  eigenvec­
       tors  of  T, or the products Q*X and/or Q*Y, where Q is an
       input unitary
       matrix. If T was obtained from the Schur factorization  of
       an  original  matrix  A = Q*T*Q', then Q*X and Q*Y are the
       matrices of right or left eigenvectors of A.


ARGUMENTS

       SIDE    (input) CHARACTER*1
               = 'R':  compute right eigenvectors only;
               = 'L':  compute left eigenvectors only;
               = 'B':  compute both right and left  eigenvectors.

       HOWMNY  (input) CHARACTER*1
               =  'A':   compute  all right and/or left eigenvec­
               tors;
               = 'B':  compute all right  and/or  left  eigenvec­
               tors,  and  backtransform  them  using  the  input
               matrices supplied in VR and/or VL; = 'S':  compute
               selected right and/or left eigenvectors, specified
               by the logical array SELECT.

               If HOWMNY = 'S', SELECT specifies the eigenvectors
               to be computed.  If HOWMNY = 'A' or 'B', SELECT is
               not referenced.  To select the eigenvector  corre­
               sponding to the j-th eigenvalue, SELECT(j) must be
               set to .TRUE..

       N       (input) INTEGER
               The order of the matrix T. N >= 0.

       T       (input/output) COMPLEX array, dimension (LDT,N)
               The upper triangular matrix T.  T is modified, but
               restored on exit.

       LDT     (input) INTEGER
               The  leading  dimension  of  the  array  T. LDT >=
               max(1,N).

       VL      (input/output) COMPLEX array, dimension (LDVL,MM)
               On entry, if SIDE = 'L' or 'B' and HOWMNY  =  'B',
               VL  must  contain  an N-by-N matrix Q (usually the
               unitary matrix Q  of  Schur  vectors  returned  by
               CHSEQR).   On  exit, if SIDE = 'L' or 'B', VL con­
               tains: if HOWMNY =  'A',  the  matrix  Y  of  left
               eigenvectors  of T; VL is lower triangular. The i-
               th column VL(i) of VL is  the  eigenvector  corre­
               sponding  to  T(i,i).  if HOWMNY = 'B', the matrix
               Q*Y; if HOWMNY = 'S', the left eigenvectors  of  T
               specified  by  SELECT, stored consecutively in the
               columns of VL, in the same order as  their  eigen­
               values.  If SIDE = 'R', VL is not referenced.

       LDVL    (input) INTEGER
               The  leading  dimension  of the array VL.  LDVL >=
               max(1,N) if SIDE = 'L' or 'B'; LDVL  >=  1  other­
               wise.

       VR      (input/output) COMPLEX array, dimension (LDVR,MM)
               On  entry,  if SIDE = 'R' or 'B' and HOWMNY = 'B',
               VR must contain an N-by-N matrix  Q  (usually  the
               unitary  matrix  Q  of  Schur  vectors returned by
               CHSEQR).  On exit, if SIDE = 'R' or 'B',  VR  con­
               tains:  if  HOWMNY  =  'A',  the matrix X of right
               eigenvectors of T; VR is upper triangular. The  i-
               th  column  VR(i)  of VR is the eigenvector corre­
               sponding to T(i,i).  if HOWMNY = 'B',  the  matrix
               Q*X;  if HOWMNY = 'S', the right eigenvectors of T
               specified by SELECT, stored consecutively  in  the
               columns  of  VR, in the same order as their eigen­
               values.  If SIDE = 'L', VR is not referenced.

       LDVR    (input) INTEGER
               The leading dimension of the array  VR.   LDVR  >=
               max(1,N)   if  SIDE  =  'R'  or  'B';  LDVR  >=  1


       MM      (input) INTEGER
               The number of columns in the arrays VL and/or  VR.
               MM >= M.

       M       (output) INTEGER
               The  number  of columns in the arrays VL and/or VR
               actually  used  to  store  the  eigenvectors.   If
               HOWMNY = 'A' or 'B', M is set to N.  Each selected
               eigenvector occupies one column.

       WORK    (workspace) COMPLEX array, dimension (2*N)

       RWORK   (workspace) REAL array, dimension (N)

       INFO    (output) INTEGER
               = 0:  successful exit
               < 0:  if INFO = -i, the i-th argument had an ille­
               gal value


FURTHER DETAILS

       The  algorithm  used in this program is basically backward
       (forward) substitution, with scaling to make the the  code
       robust against possible overflow.

       Each  eigenvector  is  normalized  so  that the element of
       largest magnitude has magnitude 1; here the magnitude of a
       complex number (x,y) is taken to be |x| + |y|.


Man(1) output converted with man2html