*     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 T(M,NT), USER(M+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)
         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 E04GZF(M,N,LSFUN3,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 .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
      STOP
*
99999 FORMAT (1X,A,I3,A)
99998 FORMAT (1X,A,3F12.4)
      END
*
      SUBROUTINE LSFUN3(M,N,XC,FVECC,FJACC,LJC,IUSER,USER)
*     Routine to evaluate the residuals and their 1st derivatives.
*      DOUBLE PRECISION  T(MDEC,NT), Y(MDEC)
*     .. Scalar Arguments ..
      INTEGER           LJC, M, N
*     .. Array Arguments ..
      DOUBLE PRECISION  FJACC(LJC,N), FVECC(M), USER(*), 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)*USER(K+2) + XC(3)*USER(K+3)
         FVECC(I) = XC(1) + USER(K+1)/DENOM - USER(I)
         FJACC(I,1) = 1.0D0
         DUMMY = -1.0D0/(DENOM*DENOM)
         FJACC(I,2) = USER(K+1)*USER(K+2)*DUMMY
         FJACC(I,3) = USER(K+1)*USER(K+3)*DUMMY
         K = K + IUSER(1)
   20 CONTINUE
      RETURN
      END
