* E04LYF Example Program Text * Mark 18 Release. NAG Copyright 1997. * .. Parameters .. INTEGER N, LIW, LW PARAMETER (N=4,LIW=N+2,LW=N*(N+7)) INTEGER NOUT PARAMETER (NOUT=6) * .. Local Scalars .. DOUBLE PRECISION F INTEGER IBOUND, IFAIL, J * .. Local Arrays .. DOUBLE PRECISION BL(N), BU(N), G(N), RUSER(1), W(LW), X(N) INTEGER IUSER(1), IW(LIW) * .. External Subroutines .. EXTERNAL E04LYF, FUNCT2, HESS2 * .. Executable Statements .. WRITE (NOUT,*) 'E04LYF Example Program Results' X(1) = 3.0D0 X(2) = -1.0D0 X(3) = 0.0D0 X(4) = 1.0D0 IBOUND = 0 BL(1) = 1.0D0 BU(1) = 3.0D0 BL(2) = -2.0D0 BU(2) = 0.0D0 * * X(3) is unconstrained, so we set BL(3) to a large negative * number and BU(3) to a large positive number. * BL(3) = -1.0D6 BU(3) = 1.0D6 BL(4) = 1.0D0 BU(4) = 3.0D0 IFAIL = 1 * CALL E04LYF(N,IBOUND,FUNCT2,HESS2,BL,BU,X,F,G,IW,LIW,W,LW,IUSER, + RUSER,IFAIL) * IF (IFAIL.LT.0) THEN WRITE (NOUT,*) WRITE (NOUT,99996) ' ** E04LYF returned with IFAIL = ', IFAIL ELSE 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) 'Function value on exit is ', F WRITE (NOUT,99998) 'at the point', (X(J),J=1,N) WRITE (NOUT,*) + 'The corresponding (machine dependent) gradient is' WRITE (NOUT,99997) (G(J),J=1,N) END IF END IF * 99999 FORMAT (1X,A,I3,A) 99998 FORMAT (1X,A,4F9.4) 99997 FORMAT (13X,4E12.4) 99996 FORMAT (1X,A,I5) END * SUBROUTINE FUNCT2(N,XC,FC,GC,IUSER,RUSER) * Routine to evaluate objective function and its 1st derivatives. * .. Scalar Arguments .. DOUBLE PRECISION FC INTEGER N * .. Array Arguments .. DOUBLE PRECISION GC(N), RUSER(*), XC(N) INTEGER IUSER(*) * .. Local Scalars .. DOUBLE PRECISION X1, X2, X3, X4 * .. Executable Statements .. X1 = XC(1) X2 = XC(2) X3 = XC(3) X4 = XC(4) FC = (X1+10.0D0*X2)**2 + 5.0D0*(X3-X4)**2 + (X2-2.0D0*X3)**4 + + 10.0D0*(X1-X4)**4 GC(1) = 2.0D0*(X1+10.0D0*X2) + 40.0D0*(X1-X4)**3 GC(2) = 20.0D0*(X1+10.0D0*X2) + 4.0D0*(X2-2.0D0*X3)**3 GC(3) = 10.0D0*(X3-X4) - 8.0D0*(X2-2.0D0*X3)**3 GC(4) = -10.0D0*(X3-X4) - 40.0D0*(X1-X4)**3 RETURN END * SUBROUTINE HESS2(N,XC,HESLC,LH,HESDC,IUSER,RUSER) * Routine to evaluate 2nd derivatives. * .. Scalar Arguments .. INTEGER LH, N * .. Array Arguments .. DOUBLE PRECISION HESDC(N), HESLC(LH), RUSER(1), XC(N) INTEGER IUSER(1) * .. Local Scalars .. DOUBLE PRECISION X1, X2, X3, X4 * .. Executable Statements .. X1 = XC(1) X2 = XC(2) X3 = XC(3) X4 = XC(4) HESDC(1) = 2.0D0 + 120.0D0*(X1-X4)**2 HESDC(2) = 200.0D0 + 12.0D0*(X2-2.0D0*X3)**2 HESDC(3) = 10.0D0 + 48.0D0*(X2-2.0D0*X3)**2 HESDC(4) = 10.0D0 + 120.0D0*(X1-X4)**2 HESLC(1) = 20.0D0 HESLC(2) = 0.0D0 HESLC(3) = -24.0D0*(X2-2.0D0*X3)**2 HESLC(4) = -120.0D0*(X1-X4)**2 HESLC(5) = 0.0D0 HESLC(6) = -10.0D0 RETURN END