*     E04FYF Example Program Text.
*     Mark 19 Revised. NAG Copyright 1999.
*     .. Parameters ..
      INTEGER          N, M, NT, LW
      PARAMETER        (N=3,M=15,NT=3,LW=7*N+N*N+2*M*N+3*M+N*(N-1)/2)
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
*     .. Local Scalars ..
      DOUBLE PRECISION FSUMSQ
      INTEGER          I, IFAIL, J, K
*     .. Local Arrays ..
      DOUBLE PRECISION T(M,NT), USER(M+M*NT), W(LW), X(N), Y(M)
      INTEGER          IUSER(1)
*     .. External Subroutines ..
      EXTERNAL         E04FYF, LSFUN1
*     .. Executable Statements ..
      WRITE (NOUT,*) 'E04FYF Example Program Results'
*     Skip heading in data file
      READ (NIN,*)
*
*     Observations of TJ (J = 1, 2, 3) are held in T(I, J)
*     (I = 1, 2, . . . , 15)
*
      IUSER(1) = NT
      K = M
      DO 40 I = 1, M
         READ (NIN,*) Y(I), (T(I,J),J=1,NT)
         USER(I) = Y(I)
         DO 20 J = 1, NT
            USER(K+J) = T(I,J)
   20    CONTINUE
         K = K + NT
   40 CONTINUE
*
      X(1) = 0.5D0
      X(2) = 1.0D0
      X(3) = 1.5D0
*
      IFAIL = 1
*
      CALL E04FYF(M,N,LSFUN1,X,FSUMSQ,W,LW,IUSER,USER,IFAIL)
*
      IF (IFAIL.NE.0) THEN
         WRITE (NOUT,*)
         WRITE (NOUT,99999) 'Error exit type', IFAIL,
     +     ' - see routine document'
      END IF
*
      IF (IFAIL.NE.1) THEN
         WRITE (NOUT,*)
         WRITE (NOUT,99998) 'On exit, the sum of squares is', FSUMSQ
         WRITE (NOUT,99998) 'at the point', (X(J),J=1,N)
      END IF
      STOP
*
99999 FORMAT (1X,A,I3,A)
99998 FORMAT (1X,A,3F12.4)
      END
*
      SUBROUTINE LSFUN1(M,N,XC,FVECC,IUSER,USER)
*     .. Scalar Arguments ..
      INTEGER           M, N
*     .. Array Arguments ..
      DOUBLE PRECISION  FVECC(M), USER(*), XC(N)
      INTEGER           IUSER(*)
*     .. Local Scalars ..
      INTEGER           I, K
*     .. Executable Statements ..
      K = M
      DO 20 I = 1, M
         FVECC(I) = XC(1) + USER(K+1)/(XC(2)*USER(K+2)+XC(3)*USER(K+3))
     +              - USER(I)
         K = K + IUSER(1)
   20 CONTINUE
      RETURN
      END