* E04UFF Example Program Text * Mark 18 Release. NAG Copyright 1997. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NMAX, NCLMAX, NCNMAX PARAMETER (NMAX=10,NCLMAX=10,NCNMAX=10) INTEGER LDA, LDCJ, LDR PARAMETER (LDA=NCLMAX,LDCJ=NCNMAX,LDR=NMAX) INTEGER LIWORK, LWORK PARAMETER (LIWORK=100,LWORK=1000) DOUBLE PRECISION ZERO, ONE, TWO PARAMETER (ZERO=0.0D+0,ONE=1.0D+0,TWO=2.0D+0) * .. Local Scalars .. DOUBLE PRECISION OBJF INTEGER I, IFAIL, IREVCM, ITER, J, N, NCLIN, NCNLN * .. Local Arrays .. DOUBLE PRECISION A(LDA,NMAX), BL(NMAX+NCLMAX+NCNMAX), + BU(NMAX+NCLMAX+NCNMAX), C(NCNMAX), + CJAC(LDCJ,NMAX), CLAMDA(NMAX+NCLMAX+NCNMAX), + OBJGRD(NMAX), R(LDR,NMAX), WORK(LWORK), X(NMAX) INTEGER ISTATE(NMAX+NCLMAX+NCNMAX), IWORK(LIWORK), + NEEDC(NCNMAX) * .. External Subroutines .. EXTERNAL E04UFF * .. Executable Statements .. WRITE (NOUT,*) 'E04UFF Example Program Results' * Skip heading in data file. READ (NIN,*) READ (NIN,*) N, NCLIN, NCNLN IF (N.LE.NMAX .AND. NCLIN.LE.NCLMAX .AND. NCNLN.LE.NCNMAX) THEN * * Read A, BL, BU and X from data file. * IF (NCLIN.GT.0) READ (NIN,*) ((A(I,J),J=1,N),I=1,NCLIN) READ (NIN,*) (BL(I),I=1,N+NCLIN+NCNLN) READ (NIN,*) (BU(I),I=1,N+NCLIN+NCNLN) READ (NIN,*) (X(I),I=1,N) * * Set all constraint Jacobian elements to zero. * Note that this will only work when 'Derivative Level = 3' * (the default; see Section 11.2). * DO 40 J = 1, N DO 20 I = 1, NCNLN CJAC(I,J) = ZERO 20 CONTINUE 40 CONTINUE * * Solve the problem. * IFAIL = 1 IREVCM = 0 * 60 CONTINUE * CALL E04UFF(IREVCM,N,NCLIN,NCNLN,LDA,LDCJ,LDR,A,BL,BU,ITER, + ISTATE,C,CJAC,CLAMDA,OBJF,OBJGRD,R,X,NEEDC,IWORK, + LIWORK,WORK,LWORK,IFAIL) * IF (IREVCM.GT.0) THEN IF (IREVCM.EQ.1 .OR. IREVCM.EQ.3) THEN * Evaluate the objective function. OBJF = X(1)*X(4)*(X(1)+X(2)+X(3)) + X(3) END IF IF (IREVCM.EQ.2 .OR. IREVCM.EQ.3) THEN * Evaluate the objective gradient. OBJGRD(1) = X(4)*(TWO*X(1)+X(2)+X(3)) OBJGRD(2) = X(1)*X(4) OBJGRD(3) = X(1)*X(4) + ONE OBJGRD(4) = X(1)*(X(1)+X(2)+X(3)) END IF * IF (IREVCM.EQ.4 .OR. IREVCM.EQ.6) THEN * Evaluate the nonlinear constraint functions. IF (NEEDC(1).GT.0) C(1) = X(1)**2 + X(2)**2 + X(3)**2 + + X(4)**2 IF (NEEDC(2).GT.0) C(2) = X(1)*X(2)*X(3)*X(4) END IF IF (IREVCM.EQ.5 .OR. IREVCM.EQ.6) THEN * Evaluate the constraint Jacobian. IF (NEEDC(1).GT.0) THEN CJAC(1,1) = TWO*X(1) CJAC(1,2) = TWO*X(2) CJAC(1,3) = TWO*X(3) CJAC(1,4) = TWO*X(4) END IF IF (NEEDC(2).GT.0) THEN CJAC(2,1) = X(2)*X(3)*X(4) CJAC(2,2) = X(1)*X(3)*X(4) CJAC(2,3) = X(1)*X(2)*X(4) CJAC(2,4) = X(1)*X(2)*X(3) END IF END IF GO TO 60 ELSE IF (IFAIL.NE.0) THEN WRITE (NOUT,99999) IFAIL END IF ELSE WRITE (NOUT,99998) END IF * 99999 FORMAT (1X,/1X,' ** E04UFF returned with IFAIL = ',I5) 99998 FORMAT (1X,' At least one of N, NCLIN or NCNLN is too large') END