ZGGESX - compute for a pair of N-by-N complex nonsymmetric
       matrices (A,B), the generalized eigenvalues,  the  complex
       Schur form (S,T),


SYNOPSIS

       SUBROUTINE ZGGESX( JOBVSL, JOBVSR, SORT, DELCTG, SENSE, N,
                          A, LDA, B, LDB, SDIM, ALPHA, BETA, VSL,
                          LDVSL,   VSR,  LDVSR,  RCONDE,  RCONDV,
                          WORK,  LWORK,  RWORK,  IWORK,   LIWORK,
                          BWORK, INFO )

           CHARACTER      JOBVSL, JOBVSR, SENSE, SORT

           INTEGER        INFO,  LDA,  LDB, LDVSL, LDVSR, LIWORK,
                          LWORK, N, SDIM

           LOGICAL        BWORK( * )

           INTEGER        IWORK( * )

           DOUBLE         PRECISION RCONDE( 2  ),  RCONDV(  2  ),
                          RWORK( * )

           COMPLEX*16     A(  LDA,  * ), ALPHA( * ), B( LDB, * ),
                          BETA( * ), VSL( LDVSL, * ), VSR( LDVSR,
                          * ), WORK( * )

           LOGICAL        DELCTG

           EXTERNAL       DELCTG


PURPOSE

       ZGGESX  computes for a pair of N-by-N complex nonsymmetric
       matrices (A,B), the generalized eigenvalues,  the  complex
       Schur  form  (S,T), and, optionally, the left and/or right
       matrices of Schur vectors (VSL and VSR).  This  gives  the
       generalized Schur factorization

            (A,B) = ( (VSL) S (VSR)**H, (VSL) T (VSR)**H )

       where (VSR)**H is the conjugate-transpose of VSR.

       Optionally,  it  also  orders  the  eigenvalues  so that a
       selected cluster of eigenvalues  appears  in  the  leading
       diagonal  blocks  of the upper triangular matrix S and the
       upper triangular matrix T; computes a reciprocal condition
       number   for  the  average  of  the  selected  eigenvalues
       (RCONDE); and computes a reciprocal condition  number  for
       the  right  and  left deflating subspaces corresponding to
       the selected eigenvalues (RCONDV). The leading columns  of
       VSL  and VSR then form an orthonormal basis for the corre­
       sponding left and right eigenspaces (deflating subspaces).

       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 interpretation  for
       beta=0 or for both being zero.

       A  pair  of matrices (S,T) is in generalized complex Schur
       form if T is upper triangular with  non-negative  diagonal
       and S is upper triangular.


ARGUMENTS

       JOBVSL  (input) CHARACTER*1
               = 'N':  do not compute the left Schur vectors;
               = 'V':  compute the left Schur vectors.

       JOBVSR  (input) CHARACTER*1
               = 'N':  do not compute the right Schur vectors;
               = 'V':  compute the right Schur vectors.

       SORT    (input) CHARACTER*1
               Specifies  whether or not to order the eigenvalues
               on the diagonal of the generalized Schur form.   =
               'N':  Eigenvalues are not ordered;
               = 'S':  Eigenvalues are ordered (see DELZTG).

       DELZTG  (input) LOGICAL FUNCTION of two COMPLEX*16 argu­
               ments
               DELZTG must be declared EXTERNAL  in  the  calling
               subroutine.   If  SORT = 'N', DELZTG is not refer­
               enced.  If SORT = 'S', DELZTG is  used  to  select
               eigenvalues  to  sort to the top left of the Schur
               form.  Note that a selected complex eigenvalue may
               no   longer   satisfy  DELZTG(ALPHA(j),BETA(j))  =
               .TRUE. after ordering, since ordering  may  change
               the  value  of  complex eigenvalues (especially if
               the eigenvalue is ill-conditioned), in  this  case
               INFO is set to N+3 see INFO below).

       SENSE   (input) CHARACTER
               Determines  which reciprocal condition numbers are
               computed.  = 'N' : None are computed;
               = 'E' : Computed for average of selected eigenval­
               ues only;
               =  'V' : Computed for selected deflating subspaces
               only;
               = 'B' : Computed for both.  If SENSE =  'E',  'V',
               or 'B', SORT must equal 'S'.

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

               N)
               On  entry,  the first of the pair of matrices.  On
               exit, A has been overwritten  by  its  generalized
               Schur form S.

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

       B       (input/output) COMPLEX*16 array, dimension (LDB,
               N)
               On entry, the second of the pair of matrices.   On
               exit,  B  has  been overwritten by its generalized
               Schur form T.

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

       SDIM    (output) INTEGER
               If SORT = 'N', SDIM = 0.  If SORT =  'S',  SDIM  =
               number  of  eigenvalues  (after sorting) for which
               DELZTG is true.

       ALPHA   (output) COMPLEX*16 array, dimension (N)
               BETA    (output) COMPLEX*16 array,  dimension  (N)
               On  exit, ALPHA(j)/BETA(j), j=1,...,N, will be the
               generalized     eigenvalues.      ALPHA(j)     and
               BETA(j),j=1,...,N   are  the diagonals of the com­
               plex Schur form (S,T).  BETA(j) will be  non-nega­
               tive real.

               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).

       VSL     (output) COMPLEX*16 array, dimension (LDVSL,N)
               If  JOBVSL  = 'V', VSL will contain the left Schur
               vectors.  Not referenced if JOBVSL = 'N'.

       LDVSL   (input) INTEGER
               The leading dimension of  the  matrix  VSL.  LDVSL
               >=1, and if JOBVSL = 'V', LDVSL >= N.

       VSR     (output) COMPLEX*16 array, dimension (LDVSR,N)
               If  JOBVSR = 'V', VSR will contain the right Schur
               vectors.  Not referenced if JOBVSR = 'N'.

       LDVSR   (input) INTEGER
               The leading dimension of the matrix VSR. LDVSR  >=
               1, and if JOBVSR = 'V', LDVSR >= N.

               If  SENSE  =  'E'  or 'B', RCONDE(1) and RCONDE(2)
               contain the reciprocal condition numbers  for  the
               average  of  the selected eigenvalues.  Not refer­
               enced if SENSE = 'N' or 'V'.

       RCONDV  (output) DOUBLE PRECISION array, dimension ( 2 )
               If SENSE = 'V' or  'B',  RCONDV(1)  and  RCONDV(2)
               contain  the  reciprocal  condition number for the
               selected deflating subspaces.  Not  referenced  if
               SENSE = 'N' or 'E'.

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

       LWORK   (input) INTEGER
               The  dimension  of  the array WORK.  LWORK >= 2*N.
               If SENSE = 'E', 'V', or  'B',  LWORK  >=  MAX(2*N,
               2*SDIM*(N-SDIM)).

       RWORK   (workspace) DOUBLE PRECISION array, dimension (
               8*N )
               Real workspace.

       IWORK   (workspace/output) INTEGER array, dimension
               (LIWORK)
               Not referenced if SENSE = 'N'.  On exit, if INFO =
               0, IWORK(1) returns the optimal LIWORK.

       LIWORK  (input) INTEGER
               The dimension of the array WORK. LIWORK >= N+2.

       BWORK   (workspace) LOGICAL array, dimension (N)
               Not referenced if SORT = '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.  (A,B) are not
               in Schur form, but ALPHA(j) and BETA(j) should  be
               correct  for  j=INFO+1,...,N.   >  N:  =N+1: other
               than QZ iteration failed in ZHGEQZ
               =N+2: after reordering, roundoff changed values of
               some complex eigenvalues so that leading eigenval­
               ues in the Generalized Schur form no  longer  sat­
               isfy  DELZTG=.TRUE.  This could also be caused due
               to scaling.  =N+3: reordering failed in ZTGSEN.


Man(1) output converted with man2html