*     D02HAF Example Program Text
*     Mark 14 Revised. NAG Copyright 1989.
*     .. Parameters ..
*     N.B the definition of SDW must be changed for N.GT.11
      INTEGER          NOUT
      PARAMETER        (NOUT=6)
      INTEGER          N, SDW, M1
      PARAMETER        (N=3,SDW=3*N+17+11,M1=6)
*     .. Local Scalars ..
      DOUBLE PRECISION A, B, TOL
      INTEGER          I, IFAIL, J, L, OUTCHN
*     .. Local Arrays ..
      DOUBLE PRECISION SOLN(N,M1), U(N,2), V(N,2), W(N,SDW)
*     .. External Subroutines ..
      EXTERNAL         D02HAF, FCN, X04ABF
*     .. Executable Statements ..
      WRITE (NOUT,*) 'D02HAF Example Program Results'
      OUTCHN = NOUT
      CALL X04ABF(1,OUTCHN)
      DO 40 L = 3, 4
         TOL = 5.0D0*10.0D0**(-L)
         WRITE (NOUT,*)
         U(1,1) = 0.0D0
         V(1,1) = 0.0D0
         U(1,2) = 0.0D0
         V(1,2) = 0.0D0
         U(2,1) = 0.5D0
         V(2,1) = 0.0D0
         U(2,2) = 0.46D0
         V(2,2) = 1.0D0
         U(3,1) = 1.15D0
         V(3,1) = 1.0D0
         U(3,2) = -1.2D0
         V(3,2) = 1.0D0
         A = 0.0D0
         B = 5.0D0
*        * Set IFAIL to 111 to obtain monitoring information *
         IFAIL = 1
*
         CALL D02HAF(U,V,N,A,B,TOL,FCN,SOLN,M1,W,SDW,IFAIL)
*
         IF (IFAIL.GE.0) THEN
            WRITE (NOUT,99999) 'Results with TOL = ', TOL
            WRITE (NOUT,*)
            IF (IFAIL.EQ.0) THEN
               WRITE (NOUT,*) ' X-value and final solution'
               DO 20 I = 1, M1
                  WRITE (NOUT,99998) I - 1, (SOLN(J,I),J=1,N)
   20          CONTINUE
            ELSE
               WRITE (NOUT,99997) ' IFAIL =', IFAIL
            END IF
         ELSE
            WRITE (NOUT,99996) IFAIL
            GO TO 60
         END IF
   40 CONTINUE
   60 CONTINUE
*
99999 FORMAT (1X,A,E10.3)
99998 FORMAT (1X,I3,3F10.4)
99997 FORMAT (1X,A,I4)
99996 FORMAT (1X,/1X,' ** D02HAF returned with IFAIL = ',I5)
      END
*
      SUBROUTINE FCN(X,Z,G)
*     .. Parameters ..
      INTEGER          N
      PARAMETER        (N=3)
*     .. Scalar Arguments ..
      DOUBLE PRECISION X
*     .. Array Arguments ..
      DOUBLE PRECISION G(N), Z(N)
*     .. Intrinsic Functions ..
      INTRINSIC        COS, TAN
*     .. Executable Statements ..
      G(1) = TAN(Z(3))
      G(2) = -0.032D0*TAN(Z(3))/Z(2) - 0.02D0*Z(2)/COS(Z(3))
      G(3) = -0.032D0/Z(2)**2
      RETURN
      END