*     F12FGF Example Program Text
*     Mark 21 Release. NAG Copyright 2004.
*     .. Parameters ..
      INTEGER          LICOMM, NIN, NOUT
      PARAMETER        (LICOMM=134,NIN=5,NOUT=6)
      INTEGER          MAXBDW, MAXN, MAXNCV, LDAB, LDV
      PARAMETER        (MAXBDW=50,MAXN=1000,MAXNCV=50,LDAB=MAXBDW,
     +                 LDV=MAXN)
      INTEGER          LCOMM
      PARAMETER        (LCOMM=60)
      DOUBLE PRECISION ONE, ZERO
      PARAMETER        (ONE=1.0D+0,ZERO=0.0D+0)
*     .. Local Scalars ..
      DOUBLE PRECISION H2, SIGMA
      INTEGER          I, IDIAG, IFAIL, IFAIL1, ISUB, ISUP, J, KL, KU,
     +                 LO, N, NCONV, NCV, NEV, NX
*     .. Local Arrays ..
      DOUBLE PRECISION AB(LDAB,MAXN), AX(MAXN), COMM(LCOMM),
     +                 D(MAXNCV,2), MB(1), RESID(MAXN), V(LDV,MAXNCV)
      INTEGER          ICOMM(LICOMM)
*     .. External Functions ..
      DOUBLE PRECISION DNRM2
      EXTERNAL         DNRM2
*     .. External Subroutines ..
      EXTERNAL         DAXPY, DGBMV, F06QHF, F12FFF, F12FGF, X04ABF,
     +                 X04CAF
*     .. Intrinsic Functions ..
*
      INTRINSIC        DABS
*     .. Executable Statements ..
      WRITE (NOUT,*) 'F12FGF Example Program Results'
      WRITE (NOUT,*)
*     Skip heading in data file
      READ (NIN,*)
      READ (NIN,*) NX, NEV, NCV
      N = NX*NX
      IF (N.LT.1 .OR. N.GT.MAXN) THEN
         WRITE (NOUT,99999) 'N is out of range: N = ', N
      ELSE IF (NCV.GT.MAXNCV) THEN
         WRITE (NOUT,99999) 'NCV is out of range: NCV = ', NCV
      ELSE
         IFAIL = 0
*     Initialize communication arrays.
         CALL F12FFF(N,NEV,NCV,ICOMM,LICOMM,COMM,LCOMM,IFAIL)
*
*     Construct the matrix A in banded form and store in AB.
*     Zero out AB.
         CALL F06QHF('G',LDAB,N,ZERO,ZERO,AB,LDAB)
*     KU, KL are number of superdiagonals and subdiagonals within the
*     band of matrices A and M.
         KL = NX
         KU = NX
*     Main diagonal of A.
         H2 = ONE/((NX+1)*(NX+1))
         IDIAG = KL + KU + 1
         DO 20 J = 1, N
            AB(IDIAG,J) = 4.0D+0/H2
   20    CONTINUE
*     First subdiagonal and superdiagonal of A.
         ISUP = KL + KU
         ISUB = KL + KU + 2
         DO 60 I = 1, NX
            LO = (I-1)*NX
            DO 40 J = LO + 1, LO + NX - 1
               AB(ISUP,J+1) = -ONE/H2
               AB(ISUB,J) = -ONE/H2
   40       CONTINUE
   60    CONTINUE
*     KL-th subdiagonal and KU-th super-diagonal.
         ISUP = KL + 1
         ISUB = 2*KL + KU + 1
         DO 100 I = 1, NX - 1
            LO = (I-1)*NX
            DO 80 J = LO + 1, LO + NX
               AB(ISUP,NX+J) = -ONE/H2
               AB(ISUB,J) = -ONE/H2
   80       CONTINUE
  100    CONTINUE
*
*     Find eigenvalues of largest magnitude and the corresponding
*     eigenvectors.
         IFAIL = 1
         CALL F12FGF(KL,KU,AB,LDAB,MB,1,SIGMA,NCONV,D,V,LDV,RESID,V,LDV,
     +               COMM,ICOMM,IFAIL)
         IF (IFAIL.EQ.0) THEN
*        Compute the residual norm  ||A*x - lambda*x||.
            DO 120 J = 1, NCONV
               CALL DGBMV('NoTranspose',N,N,KL,KU,ONE,AB(KL+1,1),LDAB,
     +                    V(1,J),1,ZERO,AX,1)
               CALL DAXPY(N,-D(J,1),V(1,J),1,AX,1)
               D(J,2) = DNRM2(N,AX,1)
               D(J,2) = D(J,2)/DABS(D(J,1))
  120       CONTINUE
            WRITE (NOUT,*)
            CALL X04ABF(1,NOUT)
            CALL X04CAF('G','N',NCONV,2,D,MAXNCV,
     +                  ' Ritz values and residuals',IFAIL1)
         ELSE
            WRITE (NOUT,99998) IFAIL
         END IF
      END IF
*
99999 FORMAT (1X,A,I5)
99998 FORMAT (1X,' NAG Routine F12FGF Returned with IFAIL = ',I6)
      END