*     E04YCF Example Program Text
*     Mark 20 Revised. NAG Copyright 2001.
*     .. Parameters ..
      INTEGER          MDEC, NDEC, LUSER, LW
      PARAMETER        (MDEC=15,NDEC=3,LUSER=MDEC*(NDEC+1),
     +                 LW=7*NDEC+NDEC*NDEC+2*MDEC*NDEC+3*MDEC+NDEC*
     +                 (NDEC-1)/2)
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
*     .. Local Scalars ..
      DOUBLE PRECISION FSUMSQ
      INTEGER          I, IFAIL, J, M, N, NS, NV
*     .. Local Arrays ..
      DOUBLE PRECISION CJ(NDEC), USER(LUSER), W(LW), X(NDEC)
      INTEGER          IUSER(1)
*     .. External Subroutines ..
      EXTERNAL         E04FYF, E04YCF, LSFUN1
*     .. Intrinsic Functions ..
      INTRINSIC        MAX
*     .. Executable Statements ..
      WRITE (NOUT,*) 'E04YCF Example Program Results'
*     Skip heading in data file
      READ (NIN,*)
      M = MDEC
      N = NDEC
*
*     For I = 1, 2, ..., M
*     The measurements Y(I) are stored in USER (I)
*     Observations T(I,1) are stored in USER(1*M+I)
*     Observations T(I,2) are stored in USER(2*M+I)
*     Observations T(I,3) are stored in USER(3*M+I)
*
      DO 20 I = 1, M
         READ (NIN,*) USER(I), (USER(J*M+I),J=1,N)
   20 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 from E04FYF. IFAIL = ', IFAIL
         WRITE (NOUT,*) '- 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,*) 'at the point'
         WRITE (NOUT,99997) (X(J),J=1,N)
*
*        Compute estimates of the variances of the sample regression
*        coefficients at the final point.
*        Since NS is greater than N we can use the first N elements
*        of W for the parameter WORK.
*
         NS = 6*N + 2*M + M*N + 1 + MAX(1,(N*(N-1))/2)
         NV = NS + N
         IFAIL = 1
*
         CALL E04YCF(0,M,N,FSUMSQ,W(NS),W(NV),N,CJ,W,IFAIL)
*
         IF (IFAIL.NE.0) THEN
            WRITE (NOUT,*)
            WRITE (NOUT,99999) 'Error exit from E04YCF.  IFAIL = ',
     +        IFAIL
            WRITE (NOUT,*) '- see routine document'
         END IF
         IF ((IFAIL.NE.1) .AND. (IFAIL.NE.2)) THEN
            WRITE (NOUT,*)
            WRITE (NOUT,*)
     +        'and estimates of the variances of the sample'
            WRITE (NOUT,*) 'regression coefficients are'
            WRITE (NOUT,99997) (CJ(J),J=1,N)
         END IF
      END IF
      STOP
*
99999 FORMAT (1X,A,I3)
99998 FORMAT (1X,A,F12.4)
99997 FORMAT (1X,3F12.4)
      END
*
      SUBROUTINE LSFUN1(M,N,XC,FVECC,IUSER,USER)
*     Routine to evaluate the residuals
*     .. Scalar Arguments ..
      INTEGER           M, N
*     .. Array Arguments ..
      DOUBLE PRECISION  FVECC(M), USER(M*(N+1)), XC(N)
      INTEGER           IUSER(1)
*     .. Local Scalars ..
      INTEGER           I
*     .. Executable Statements ..
      DO 20 I = 1, M
         FVECC(I) = XC(1) + USER(I+M)/(XC(2)*USER(I+M*2)+XC(3)
     +              *USER(I+M*3)) - USER(I)
   20 CONTINUE
      RETURN
      END