* 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