* 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) 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