*     E04HYF 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         E04HYF, LSFUN3, LSHES3
*     .. Executable Statements ..
      WRITE (NOUT,*) 'E04HYF 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 E04HYF(M,N,LSFUN3,LSHES3,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.
*     .. 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
*
      SUBROUTINE LSHES3(M,N,FVECC,XC,B,LB,IUSER,USER)
*     Routine to compute the lower triangle of the matrix B
*     (stored by rows in the array B).
*     .. Scalar Arguments ..
      INTEGER           LB, M, N
*     .. Array Arguments ..
      DOUBLE PRECISION  B(LB), FVECC(M), USER(*), XC(N)
      INTEGER           IUSER(*)
*     .. Local Scalars ..
      DOUBLE PRECISION  DUMMY, SUM22, SUM32, SUM33
      INTEGER           I, K
*     .. Executable Statements ..
      B(1) = 0.0D0
      B(2) = 0.0D0
      SUM22 = 0.0D0
      SUM32 = 0.0D0
      SUM33 = 0.0D0
      K = M
      DO 20 I = 1, M
         DUMMY = 2.0D0*USER(K+1)/(XC(2)*USER(K+2)+XC(3)*USER(K+3))**3
         SUM22 = SUM22 + FVECC(I)*DUMMY*USER(K+2)**2
         SUM32 = SUM32 + FVECC(I)*DUMMY*USER(K+2)*USER(K+3)
         SUM33 = SUM33 + FVECC(I)*DUMMY*USER(K+3)**2
         K = K + IUSER(1)
   20 CONTINUE
      B(3) = SUM22
      B(4) = 0.0D0
      B(5) = SUM32
      B(6) = SUM33
      RETURN
      END