*     F11JDF Example Program Text
*     Mark 19 Revised. NAG Copyright 1999.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          NMAX, LA, LIWORK, LWORK
      PARAMETER        (NMAX=1000,LA=10000,LIWORK=NMAX+1,
     +                 LWORK=6*NMAX+120)
*     .. Local Scalars ..
      DOUBLE PRECISION ANORM, OMEGA, SIGERR, SIGMAX, SIGTOL, STPLHS,
     +                 STPRHS, TOL
      INTEGER          I, IFAIL, IFAIL1, IREVCM, ITERM, ITN, ITS,
     +                 LWNEED, MAXITN, MAXITS, MONIT, N, NNZ
      CHARACTER        CKJDF, CKXEF, NORM, PRECON, SIGCMP, WEIGHT
      CHARACTER*6      METHOD
*     .. Local Arrays ..
      DOUBLE PRECISION A(LA), B(NMAX), RDIAG(NMAX), WGT(NMAX),
     +                 WORK(LWORK), X(NMAX)
      INTEGER          ICOL(LA), IROW(LA), IWORK(LIWORK)
*     .. External Subroutines ..
      EXTERNAL         F11GDF, F11GEF, F11GFF, F11JDF, F11XEF
*     .. Executable Statements ..
      WRITE (NOUT,*) 'F11JDF Example Program Results'
*     Skip heading in data file
      READ (NIN,*)
*
*     Read algorithmic parameters
*
      READ (NIN,*) N
      IF (N.LE.NMAX) THEN
         READ (NIN,*) NNZ
         READ (NIN,*) METHOD
         READ (NIN,*) PRECON, SIGCMP, NORM, ITERM
         READ (NIN,*) TOL, MAXITN
         READ (NIN,*) ANORM, SIGMAX
         READ (NIN,*) SIGTOL, MAXITS
         READ (NIN,*) OMEGA
*
*        Read the matrix A
*
         DO 20 I = 1, NNZ
            READ (NIN,*) A(I), IROW(I), ICOL(I)
   20    CONTINUE
*
*        Read right-hand side vector b and initial approximate solution x
*
         READ (NIN,*) (B(I),I=1,N)
         READ (NIN,*) (X(I),I=1,N)
*
*        Call F11GDF to initialize solver
*
         WEIGHT = 'N'
         MONIT = 0
         IFAIL = 1
         CALL F11GDF(METHOD,PRECON,SIGCMP,NORM,WEIGHT,ITERM,N,TOL,
     +               MAXITN,ANORM,SIGMAX,SIGTOL,MAXITS,MONIT,LWNEED,
     +               WORK,LWORK,IFAIL)
         IF (IFAIL.NE.0) THEN
            WRITE (NOUT,99996) IFAIL
            GO TO 140
         END IF
*
*        Calculate reciprocal diagonal matrix elements.
*
         DO 40 I = 1, N
            IWORK(I) = 0
   40    CONTINUE
*
         DO 60 I = 1, NNZ
            IF (IROW(I).EQ.ICOL(I)) THEN
               IWORK(IROW(I)) = IWORK(IROW(I)) + 1
               IF (A(I).NE.0.0D0) THEN
                  RDIAG(IROW(I)) = 1.0D0/A(I)
               ELSE
                  WRITE (NOUT,*) 'Matrix has a zero diagonal element'
                  GO TO 140
               END IF
            END IF
   60    CONTINUE
*
         DO 80 I = 1, N
            IF (IWORK(I).EQ.0) THEN
               WRITE (NOUT,*) 'Matrix has a missing diagonal element'
               GO TO 140
            END IF
            IF (IWORK(I).GE.2) THEN
               WRITE (NOUT,*) 'Matrix has a multiple diagonal element'
               GO TO 140
            END IF
   80    CONTINUE
*
*        Call F11GEF to solve the linear system
*
         IFAIL = 1
         IREVCM = 0
         CKXEF = 'C'
         CKJDF = 'C'
*
  100    CONTINUE
*
         CALL F11GEF(IREVCM,X,B,WGT,WORK,LWORK,IFAIL)
*
         IF (IREVCM.NE.4) THEN
            IFAIL1 = -1
            IF (IREVCM.EQ.1) THEN
*
*              Compute matrix vector product
*
               CALL F11XEF(N,NNZ,A,IROW,ICOL,CKXEF,X,B,IFAIL1)
               CKXEF = 'N'
*
            ELSE IF (IREVCM.EQ.2) THEN
*
*              SSOR preconditioning
*
               CALL F11JDF(N,NNZ,A,IROW,ICOL,RDIAG,OMEGA,CKJDF,X,B,
     +                     IWORK,IFAIL1)
               CKJDF = 'N'
            END IF
            IF (IFAIL1.NE.0) IREVCM = 6
            GO TO 100
         ELSE IF (IFAIL.NE.0) THEN
            WRITE (NOUT,99995) IFAIL
            GO TO 140
         END IF
*
*        Termination
*
         CALL F11GFF(ITN,STPLHS,STPRHS,ANORM,SIGMAX,ITS,SIGERR,WORK,
     +               LWORK,IFAIL)
*
         WRITE (NOUT,99999) 'Converged in', ITN, ' iterations'
         WRITE (NOUT,99998) 'Final residual norm =', STPLHS
*
*        Output x
*
         DO 120 I = 1, N
            WRITE (NOUT,99997) X(I)
  120    CONTINUE
*
  140    CONTINUE
      END IF
*
99999 FORMAT (1X,A,I10,A)
99998 FORMAT (1X,A,1P,E16.3)
99997 FORMAT (1X,1P,E16.4)
99996 FORMAT (1X,/1X,' ** F11GDF returned with IFAIL = ',I5)
99995 FORMAT (1X,/1X,' ** F11GEF returned with IFAIL = ',I5)
      END