*     E04GZF Example Program Text
*     Mark 19 Revised. NAG Copyright 1999.
*     .. Parameters ..
      INTEGER          M, N, NT, LW
      PARAMETER        (M=15,N=3,NT=3,LW=8*N+2*N*N+2*M*N+3*M)
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
*     .. Local Scalars ..
      DOUBLE PRECISION FSUMSQ
      INTEGER          I, IFAIL, J, K
*     .. Local Arrays ..
      DOUBLE PRECISION RUSER(M+M*NT), T(M,NT), W(LW), X(N), Y(M)
      INTEGER          IUSER(1)
*     .. External Subroutines ..
      EXTERNAL         E04GZF, LSFUN3
*     .. Executable Statements ..
      WRITE (NOUT,*) 'E04GZF 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)
         RUSER(I) = Y(I)
         DO 20 J = 1, NT
            RUSER(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 E04GZF(M,N,LSFUN3,X,FSUMSQ,W,LW,IUSER,RUSER,IFAIL)
*
      IF (IFAIL.LT.0) THEN
         WRITE (NOUT,*)
         WRITE (NOUT,99997) ' ** E04GZF returned with IFAIL = ', IFAIL
      ELSE
         IF (IFAIL.NE.0) THEN
            WRITE (NOUT,*)
            WRITE (NOUT,99999) 'Error exit type', IFAIL,
     +        ' - see routine document'
         END IF
         IF (IFAIL.NE.1 .AND. IFAIL.NE.9) 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
      END IF
*
99999 FORMAT (1X,A,I3,A)
99998 FORMAT (1X,A,3F12.4)
99997 FORMAT (1X,A,I5)
      END
*
      SUBROUTINE LSFUN3(M,N,XC,FVEC,FJAC,LDFJAC,IUSER,RUSER)
*     Routine to evaluate the residuals and their 1st derivatives.
*      DOUBLE PRECISION  T(MDEC,NT), Y(MDEC)
*     .. Scalar Arguments ..
      INTEGER          LDFJAC, M, N
*     .. Array Arguments ..
      DOUBLE PRECISION FJAC(LDFJAC,N), FVEC(M), RUSER(*), XC(N)
      INTEGER          IUSER(*)
*     .. Local Scalars ..
      DOUBLE PRECISION DENOM, DUMMY
      INTEGER          I, K
*     .. Executable Statements ..
      K = M
      DO 20 I = 1, M
         DENOM = XC(2)*RUSER(K+2) + XC(3)*RUSER(K+3)
         FVEC(I) = XC(1) + RUSER(K+1)/DENOM - RUSER(I)
         FJAC(I,1) = 1.0D0
         DUMMY = -1.0D0/(DENOM*DENOM)
         FJAC(I,2) = RUSER(K+1)*RUSER(K+2)*DUMMY
         FJAC(I,3) = RUSER(K+1)*RUSER(K+3)*DUMMY
         K = K + IUSER(1)
   20 CONTINUE
      RETURN
      END