* E04DJF Example Program Text * Mark 16 Release. NAG Copyright 1993. * .. Parameters .. INTEGER NMAX PARAMETER (NMAX=10) INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) * .. Local Scalars .. DOUBLE PRECISION OBJF INTEGER I, IFAIL, INFORM, ITER, N, OUTCHN * .. Local Arrays .. DOUBLE PRECISION OBJGRD(NMAX), RUSER(5*NMAX), WORK(13*NMAX), + X(NMAX) INTEGER IUSER(NMAX), IWORK(NMAX+1) * .. External Subroutines .. EXTERNAL E04DGF, E04DJF, E04DKF, OBJFN1, X04ABF * .. Executable Statements .. WRITE (NOUT,*) 'E04DJF Example Program Results' OUTCHN = NOUT * Skip heading in data file READ (NIN,*) READ (NIN,*) N IF (N.LE.NMAX) THEN * * Read X from data file * READ (NIN,*) (X(I),I=1,N) * * Set two options using E04DKF * CALL E04DKF(' Verify Level = -1 ') * CALL E04DKF(' Maximum Step Length = 100.0 ') * * Set the unit number for advisory messages to OUTCHN * CALL X04ABF(1,OUTCHN) * * Read the options file for the remaining options * CALL E04DJF(NIN,INFORM) * IF (INFORM.NE.0) THEN WRITE (NOUT,99999) 'E04DJF terminated with INFORM = ', + INFORM GO TO 20 END IF * * Solve the problem * IFAIL = 1 * CALL E04DGF(N,OBJFN1,ITER,OBJF,OBJGRD,X,IWORK,WORK,IUSER,RUSER, + IFAIL) IF (IFAIL.NE.0) THEN WRITE (NOUT,*) WRITE (NOUT,99999) ' ** E04DGF returned with IFAIL = ', + IFAIL END IF * END IF 20 CONTINUE * 99999 FORMAT (1X,A,I5) END * SUBROUTINE OBJFN1(MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,RUSER) * Routine to evaluate F(x) and approximate its 1st derivatives * .. Scalar Arguments .. DOUBLE PRECISION OBJF INTEGER MODE, N, NSTATE * .. Array Arguments .. DOUBLE PRECISION OBJGRD(N), RUSER(*), X(N) INTEGER IUSER(*) * .. Local Scalars .. DOUBLE PRECISION EPSRF INTEGER I, IFAIL, IMODE, IWARN, LHES, MSGLVL * .. Local Arrays .. DOUBLE PRECISION USE(1) INTEGER IUSE(1) * .. External Subroutines .. EXTERNAL E04XAF, OBJFN2 * .. Executable Statements .. IF (MODE.EQ.0) THEN * Evaluate F(x) only CALL OBJFN2(MODE,N,X,OBJF,OBJGRD,NSTATE,IUSE,USE) * ELSE IF (MODE.EQ.2) THEN * Evaluate F(x) and approximate its 1st derivatives MSGLVL = 0 EPSRF = 0.0D0 IMODE = 0 LHES = N DO 20 I = 1, N RUSER(I) = 0.0D0 RUSER(4*N+I) = X(I) 20 CONTINUE IFAIL = 1 * CALL E04XAF(MSGLVL,N,EPSRF,RUSER(4*N+1),IMODE,OBJFN2,LHES, + RUSER(1),OBJF,OBJGRD,RUSER(N+1),RUSER(2*N+1),IWARN, + RUSER(3*N+1),IUSE,USE,IUSER,IFAIL) * END IF * RETURN END SUBROUTINE OBJFN2(MODE,N,X,OBJF,OBJGRD,NSTATE,IUSE,USE) * Routine to evaluate F(x) * .. Scalar Arguments .. DOUBLE PRECISION OBJF INTEGER MODE, N, NSTATE * .. Array Arguments .. DOUBLE PRECISION OBJGRD(N), USE(*), X(N) INTEGER IUSE(*) * .. Local Scalars .. DOUBLE PRECISION X1, X2 * .. Intrinsic Functions .. INTRINSIC EXP * .. Executable Statements .. X1 = X(1) X2 = X(2) * OBJF = EXP(X1)*(4.0D0*X1**2+2.0D0*X2**2+4.0D0*X1*X2+2.0D0*X2+ + 1.0D0) * RETURN END