*     F08XSF Example Program Text
*     Mark 20 Release. NAG Copyright 2001.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          NMAX, LDA, LDB, LDQ, LDZ, LWORK
      PARAMETER        (NMAX=10,LDA=NMAX,LDB=NMAX,LDQ=1,LDZ=1,
     +                 LWORK=6*NMAX)
*     .. Local Scalars ..
      COMPLEX*16       E
      INTEGER          I, IFAIL, IHI, ILO, INFO, IROWS, J, JWORK, N
      CHARACTER        COMPQ, COMPZ, JOB
*     .. Local Arrays ..
      COMPLEX*16       A(LDA,NMAX), ALPHA(NMAX), B(LDB,NMAX),
     +                 BETA(NMAX), Q(LDQ,LDQ), TAU(NMAX), WORK(LWORK),
     +                 Z(LDZ,LDZ)
      DOUBLE PRECISION LSCALE(NMAX), RSCALE(NMAX), RWORK(6*NMAX)
      CHARACTER        CLABS(1), RLABS(1)
*     .. External Subroutines ..
      EXTERNAL         X04DBF, ZGEQRF, ZGGBAL, ZGGHRD, ZHGEQZ, ZUNMQR
*     .. Intrinsic Functions ..
      INTRINSIC        DBLE, DIMAG, NINT
*     .. Executable Statements ..
      WRITE (NOUT,*) 'F08XSF Example Program Results'
*
*     Skip heading in data file
*
      READ (NIN,*)
      READ (NIN,*) N
      IF (N.LE.NMAX) THEN
*
*        READ matrix A from data file
*
         READ (NIN,*) ((A(I,J),J=1,N),I=1,N)
*
*        READ matrix B from data file
*
         READ (NIN,*) ((B(I,J),J=1,N),I=1,N)
*
*        Balance matrix pair (A,B)
*
         JOB = 'B'
         CALL ZGGBAL(JOB,N,A,LDA,B,LDB,ILO,IHI,LSCALE,RSCALE,RWORK,INFO)
*
*        Matrix A after balancing
*
         IFAIL = 0
         CALL X04DBF('General',' ',N,N,A,LDA,'Bracketed','F7.4',
     +               'Matrix A after balancing','Integer',RLABS,
     +               'Integer',CLABS,80,0,IFAIL)
         WRITE (NOUT,*)
*
*        Matrix B after balancing
*
         IFAIL = 0
         CALL X04DBF('General',' ',N,N,B,LDB,'Bracketed','F7.4',
     +               'Matrix B after balancing','Integer',RLABS,
     +               'Integer',CLABS,80,0,IFAIL)
         WRITE (NOUT,*)
*
*        Reduce B to triangular form using QR
*
         IROWS = IHI + 1 - ILO
         CALL ZGEQRF(IROWS,IROWS,B(ILO,ILO),LDB,TAU,WORK,LWORK,INFO)
*
*        Apply the orthogonal transformation to A
*
         CALL ZUNMQR('L','C',IROWS,IROWS,IROWS,B(ILO,ILO),LDB,TAU,
     +               A(ILO,ILO),LDA,WORK,LWORK,INFO)
*
*        Compute the generalized Hessenberg form of (A,B)
*
         COMPQ = 'N'
         COMPZ = 'N'
         CALL ZGGHRD(COMPQ,COMPZ,IROWS,1,IROWS,A(ILO,ILO),LDA,B(ILO,ILO)
     +               ,LDB,Q,LDQ,Z,LDZ,INFO)
*
*        Matrix A in generalized Hessenberg form
*
         IFAIL = 0
         CALL X04DBF('General',' ',N,N,A,LDA,'Bracketed','F7.3',
     +               'Matrix A in Hessenberg form','Integer',RLABS,
     +               'Integer',CLABS,80,0,IFAIL)
         WRITE (NOUT,*)
*
*        Matrix B in generalized Hessenberg form
*
         IFAIL = 0
         CALL X04DBF('General',' ',N,N,B,LDB,'Bracketed','F7.3',
     +               'Matrix B is triangular','Integer',RLABS,'Integer',
     +               CLABS,80,0,IFAIL)
*
*        Routine ZHGEQZ
*        Workspace query: JWORK = -1
*
         JWORK = -1
         JOB = 'E'
         CALL ZHGEQZ(JOB,COMPQ,COMPZ,N,ILO,IHI,A,LDA,B,LDB,ALPHA,BETA,Q,
     +               LDQ,Z,LDZ,WORK,JWORK,RWORK,INFO)
         WRITE (NOUT,*)
         WRITE (NOUT,99999) NINT(DBLE(WORK(1)))
         WRITE (NOUT,99998) LWORK
         WRITE (NOUT,*)
         WRITE (NOUT,99997)
         WRITE (NOUT,99996)
*
*        Compute the generalized Schur form
*        if the workspace LWORK is adequate
*
         IF (NINT(DBLE(WORK(1))).LE.LWORK) THEN
            CALL ZHGEQZ(JOB,COMPQ,COMPZ,N,ILO,IHI,A,LDA,B,LDB,ALPHA,
     +                  BETA,Q,LDQ,Z,LDZ,WORK,LWORK,RWORK,INFO)
*
*        Print the generalized eigenvalues
*        Note: the actual values of beta are real and non-negative
*
            DO 20 I = 1, N
               IF (DBLE(BETA(I)).NE.0.0D0) THEN
                  E = ALPHA(I)/BETA(I)
                  WRITE (NOUT,99995) I, '(', DBLE(E), ',', DIMAG(E),
     +              ')'
               ELSE
                  WRITE (NOUT,99996) I
               END IF
   20       CONTINUE
         ELSE
            WRITE (NOUT,99994)
         END IF
      END IF
      STOP
*
99999 FORMAT (1X,'Minimal required LWORK = ',I6)
99998 FORMAT (1X,'Actual value of  LWORK = ',I6)
99997 FORMAT (1X,'Generalized eigenvalues')
99996 FORMAT (1X,I4,5X,'Infinite eigenvalue')
99995 FORMAT (1X,I4,5X,A,F7.3,A,F7.3,A)
99994 FORMAT (1X,'Insufficient workspace for array WORK',/' in F08XSF/',
     +       'ZHGEQZ')
      END