*     D02QZF Example Program Text
*     Mark 14 Revised. NAG Copyright 1989.
*     .. Parameters ..
      INTEGER          NOUT
      PARAMETER        (NOUT=6)
      INTEGER          NEQF, NEQG, LATOL, LRTOL, LRWORK, LIWORK
      PARAMETER        (NEQF=2,NEQG=0,LATOL=NEQF,LRTOL=NEQF,
     +                 LRWORK=23+23*NEQF+14*NEQG,LIWORK=21+4*NEQG)
      DOUBLE PRECISION TSTART, HMAX
      PARAMETER        (TSTART=0.0D0,HMAX=2.0D0)
*     .. Local Scalars ..
      DOUBLE PRECISION PI, T, TCRIT, TINC, TOUT, TWANT
      INTEGER          I, IFAIL, J, MAXSTP, NWANT
      LOGICAL          ALTERG, CRIT, ONESTP, ROOT, SOPHST, VECTOL
      CHARACTER        STATEF
*     .. Local Arrays ..
      DOUBLE PRECISION ATOL(LATOL), RTOL(LRTOL), RWORK(LRWORK), Y(NEQF),
     +                 YPWANT(NEQF), YWANT(NEQF)
      INTEGER          IWORK(LIWORK)
*     .. External Functions ..
      DOUBLE PRECISION D02QFZ, X01AAF
      EXTERNAL         D02QFZ, X01AAF
*     .. External Subroutines ..
      EXTERNAL         D02QFF, D02QWF, D02QZF, FTRY03
*     .. Intrinsic Functions ..
      INTRINSIC        DBLE
*     .. Executable Statements ..
      WRITE (NOUT,*) 'D02QZF Example Program Results'
      PI = X01AAF(0.0D0)
      STATEF = 'S'
      VECTOL = .TRUE.
      DO 20 I = 1, NEQF
         ATOL(I) = 1.0D-8
         RTOL(I) = 1.0D-4
   20 CONTINUE
      ONESTP = .TRUE.
      CRIT = .TRUE.
      TINC = 0.0625D0*PI
      TCRIT = 8.0D0*TINC
      TOUT = TCRIT
      MAXSTP = 500
      T = TSTART
      TWANT = TSTART + TINC
      NWANT = NEQF
      Y(1) = 0.0D0
      Y(2) = 1.0D0
      WRITE (NOUT,*)
      WRITE (NOUT,*) '  T         Y(1)     Y(2)'
      WRITE (NOUT,99999) T, Y(1), Y(2)
      IFAIL = -1
*
      CALL D02QWF(STATEF,NEQF,VECTOL,ATOL,LATOL,RTOL,LRTOL,ONESTP,CRIT,
     +            TCRIT,HMAX,MAXSTP,NEQG,ALTERG,SOPHST,RWORK,LRWORK,
     +            IWORK,LIWORK,IFAIL)
*
      J = 1
   40 IFAIL = -1
*
      CALL D02QFF(FTRY03,NEQF,T,Y,TOUT,D02QFZ,NEQG,ROOT,RWORK,LRWORK,
     +            IWORK,LIWORK,IFAIL)
*
      IF (IFAIL.EQ.0) THEN
   60    IF (TWANT.LE.T) THEN
            IFAIL = 0
*
            CALL D02QZF(NEQF,TWANT,NWANT,YWANT,YPWANT,RWORK,LRWORK,
     +                  IWORK,LIWORK,IFAIL)
*
            WRITE (NOUT,99999) TWANT, YWANT(1), YWANT(2)
            J = J + 1
            TWANT = TSTART + DBLE(J)*TINC
            GO TO 60
         END IF
         IF (T.LT.TOUT) GO TO 40
      END IF
      STOP
*
99999 FORMAT (1X,F6.4,3X,2(F7.4,2X))
      END
*
      SUBROUTINE FTRY03(NEQF,T,Y,YP)
*     .. Scalar Arguments ..
      DOUBLE PRECISION  T
      INTEGER           NEQF
*     .. Array Arguments ..
      DOUBLE PRECISION  Y(NEQF), YP(NEQF)
*     .. Executable Statements ..
      YP(1) = Y(2)
      YP(2) = -Y(1)
      RETURN
      END
