* E04UHF Example Program Text. * Mark 20 Revised. NAG Copyright 2001. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER MMAX, NMAX, LENIZ, LENZ PARAMETER (MMAX=100,NMAX=100,LENIZ=1000,LENZ=1000) * .. Local Scalars .. DOUBLE PRECISION OBJ, SINF INTEGER I, IFAIL, INFORM, IOBJ, J, M, MINIZ, MINZ, N, + NCNLN, NINF, NJNLN, NNAME, NNZ, NONLN, NS CHARACTER START * .. Local Arrays .. DOUBLE PRECISION A(1), BL(NMAX+MMAX), BU(NMAX+MMAX), + CLAMDA(NMAX+MMAX), USER(1), XS(NMAX+MMAX), + Z(LENZ) INTEGER HA(1), ISTATE(NMAX+MMAX), IUSER(1), IZ(LENIZ), + KA(NMAX+1) CHARACTER*8 NAMES(NMAX+MMAX) * .. External Subroutines .. EXTERNAL E04UGF, E04UGM, E04UHF, E04UJF, OBJFUN, X04ABF * .. Executable Statements .. WRITE (NOUT,*) 'E04UHF Example Program Results' * Skip heading in data file. READ (NIN,*) READ (NIN,*) N, M IF (N.LE.NMAX .AND. M.LE.MMAX) THEN * * Read NCNLN, NONLN and NJNLN from data file. * READ (NIN,*) NCNLN, NONLN, NJNLN * * Read START, NNAME and NAMES from data file. * READ (NIN,*) START, NNAME IF (NNAME.EQ.N+M) READ (NIN,*) (NAMES(I),I=1,N+M) * * Define the matrix A to contain a dummy `free' row that consists * of a single (zero) element subject to `infinite' upper and lowe * bounds. Set up KA. * NNZ = 1 IOBJ = -1 * KA(1) = 1 * A(1) = 0.0D+0 HA(1) = 1 * * Columns 2,3,...,N of A are empty. Set the corresponding element * of KA to 2. * DO 20 J = 2, N KA(J) = 2 20 CONTINUE * KA(N+1) = NNZ + 1 * * Read BL, BU, ISTATE and XS from data file. * READ (NIN,*) (BL(I),I=1,N+M) READ (NIN,*) (BU(I),I=1,N+M) IF (START.EQ.'C') THEN READ (NIN,*) (ISTATE(I),I=1,N) ELSE IF (START.EQ.'W') THEN READ (NIN,*) (ISTATE(I),I=1,N+M) END IF READ (NIN,*) (XS(I),I=1,N) * * Set three options using E04UJF. * CALL E04UJF(' Verify Level = -1 ') * CALL E04UJF(' Major Iteration Limit = 25 ') * CALL E04UJF(' Infinite Bound Size = 1.0D+25 ') * * Set the unit number for advisory messages to NOUT. * CALL X04ABF(1,NOUT) * * Read the options file for the remaining options. * CALL E04UHF(NIN,INFORM) * IF (INFORM.NE.0) THEN WRITE (NOUT,99999) 'E04UHF terminated with INFORM = ', + INFORM STOP END IF * * Solve the problem. * IFAIL = -1 * CALL E04UGF(E04UGM,OBJFUN,N,M,NCNLN,NONLN,NJNLN,IOBJ,NNZ,A,HA, + KA,BL,BU,START,NNAME,NAMES,NS,XS,ISTATE,CLAMDA, + MINIZ,MINZ,NINF,SINF,OBJ,IZ,LENIZ,Z,LENZ,IUSER, + USER,IFAIL) * END IF * STOP * 99999 FORMAT (1X,A,I3) END * SUBROUTINE OBJFUN(MODE,NONLN,X,OBJF,OBJGRD,NSTATE,IUSER,USER) * Computes the nonlinear part of the objective function and its * gradient * .. Scalar Arguments .. DOUBLE PRECISION OBJF INTEGER MODE, NONLN, NSTATE * .. Array Arguments .. DOUBLE PRECISION OBJGRD(NONLN), USER(*), X(NONLN) INTEGER IUSER(*) * .. Executable Statements .. * IF (MODE.EQ.0 .OR. MODE.EQ.2) OBJF = 2.0D+0 - X(1)*X(2)*X(3)*X(4) + *X(5)/120.0D+0 * IF (MODE.EQ.1 .OR. MODE.EQ.2) THEN OBJGRD(1) = -X(2)*X(3)*X(4)*X(5)/120.0D+0 OBJGRD(2) = -X(1)*X(3)*X(4)*X(5)/120.0D+0 OBJGRD(3) = -X(1)*X(2)*X(4)*X(5)/120.0D+0 OBJGRD(4) = -X(1)*X(2)*X(3)*X(5)/120.0D+0 OBJGRD(5) = -X(1)*X(2)*X(3)*X(4)/120.0D+0 END IF * END