*     E04WEF Example Program Text
*     Mark 21 Release. NAG Copyright 2004.
      IMPLICIT         NONE
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          NMAX, NCLMAX, NCNMAX
      PARAMETER        (NMAX=10,NCLMAX=10,NCNMAX=10)
      INTEGER          LDA, LDCJ, LDH
      PARAMETER        (LDA=NCLMAX,LDCJ=NCNMAX,LDH=NMAX)
      INTEGER          LENIW, LENRW
      PARAMETER        (LENIW=600,LENRW=600)
*     .. Local Scalars ..
      DOUBLE PRECISION BNDINF, FEATOL, OBJF
      INTEGER          ELMODE, I, IFAIL, J, MAJITS, N, NCLIN, NCNLN
*     .. Local Arrays ..
      DOUBLE PRECISION A(LDA,NMAX), BL(NMAX+NCLMAX+NCNMAX),
     +                 BU(NMAX+NCLMAX+NCNMAX), CCON(NCNMAX),
     +                 CJAC(LDCJ,NMAX), CLAMDA(NMAX+NCLMAX+NCNMAX),
     +                 GRAD(NMAX), HESS(LDH,NMAX), RUSER(1), RW(LENRW),
     +                 X(NMAX)
      INTEGER          ISTATE(NMAX+NCLMAX+NCNMAX), IUSER(1), IW(LENIW)
*     .. External Subroutines ..
      EXTERNAL         CONFUN, E04WCF, E04WDF, E04WEF, E04WFF, E04WGF,
     +                 E04WHF, E04WKF, E04WLF, OBJFUN
*     .. Executable Statements ..
      WRITE (NOUT,*) 'E04WEF Example Program Results'
*
*     This program demonstrates the use of routines to set and
*     get values of optional parameters associated with E04WDF.
*
*     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)
*
*        Call E04WCF to initialise E04WDF.
         IFAIL = -1
         CALL E04WCF(IW,LENIW,RW,LENRW,IFAIL)
*
*        By default E04WDF does not print monitoring information.
*        Use E04WGF to set the integer-valued option 'Print file'
*        unit number to get information.
         CALL E04WGF('Print file',NOUT,IW,RW,IFAIL)
*
*        Use E04WEF to read some options from the end of the input
*        data file.
         CALL E04WEF(NIN,IW,RW,IFAIL)
         WRITE (NOUT,*)
*
*        Use E04WKF to find the value of integer-valued option
*        'Elastic mode'.
         CALL E04WKF('Elastic mode',ELMODE,IW,RW,IFAIL)
         WRITE (NOUT,99999) ELMODE
*
*        Use E04WHF to set the value of real-valued option
*        'Infinite bound size'.
         BNDINF = 1.0D10
         CALL E04WHF('Infinite bound size',BNDINF,IW,RW,IFAIL)
*
*        Use E04WLF to find the value of real-valued option
*        'Feasibility tolerance'.
         CALL E04WLF('Feasibility tolerance',FEATOL,IW,RW,IFAIL)
         WRITE (NOUT,99998) FEATOL
*
*        Use E04WFF to set the option 'Major iterations limit'.
         CALL E04WFF('Major iterations limit 50',IW,RW,IFAIL)
*
*        Solve the problem.
         IFAIL = -1
         CALL E04WDF(N,NCLIN,NCNLN,LDA,LDCJ,LDH,A,BL,BU,CONFUN,OBJFUN,
     +               MAJITS,ISTATE,CCON,CJAC,CLAMDA,OBJF,GRAD,HESS,X,IW,
     +               LENIW,RW,LENRW,IUSER,RUSER,IFAIL)
*
         WRITE (NOUT,*)
         WRITE (NOUT,99997) IFAIL
         IF (IFAIL.EQ.0) THEN
            WRITE (NOUT,99996) OBJF
            WRITE (NOUT,99995) (X(I),I=1,N)
         END IF
*
      END IF
      STOP
*
99999 FORMAT (1X,'Option ''Elastic mode'' has the value ',I3,'.')
99998 FORMAT (1X,'Option ''Feasibility tolerance'' has the value ',1P,
     +       E13.5,'.')
99997 FORMAT (1X,'On exit from E04WDF, IFAIL = ',I5)
99996 FORMAT (1X,'Final objective value = ',F11.3)
99995 FORMAT (1X,'Optimal X = ',7F9.2)
      END

      SUBROUTINE OBJFUN(MODE,N,X,OBJF,GRAD,NSTATE,IUSER,RUSER)
*     Routine to evaluate objective function and its 1st derivatives.
*     .. Parameters ..
      DOUBLE PRECISION  ONE, TWO
      PARAMETER         (ONE=1.0D0,TWO=2.0D0)
*     .. Scalar Arguments ..
      DOUBLE PRECISION  OBJF
      INTEGER           MODE, N, NSTATE
*     .. Array Arguments ..
      DOUBLE PRECISION  GRAD(N), RUSER(*), X(N)
      INTEGER           IUSER(*)
*     .. Executable Statements ..
      IF (MODE.EQ.0 .OR. MODE.EQ.2) OBJF = X(1)*X(4)*(X(1)+X(2)+X(3)) +
     +    X(3)
*
      IF (MODE.EQ.1 .OR. MODE.EQ.2) THEN
         GRAD(1) = X(4)*(TWO*X(1)+X(2)+X(3))
         GRAD(2) = X(1)*X(4)
         GRAD(3) = X(1)*X(4) + ONE
         GRAD(4) = X(1)*(X(1)+X(2)+X(3))
      END IF
*
      RETURN
      END
*
      SUBROUTINE CONFUN(MODE,NCNLN,N,LDCJ,NEEDC,X,CCON,CJAC,NSTATE,
     +                  IUSER,RUSER)
*     Routine to evaluate the nonlinear constraints and their 1st
*     derivatives.
*     .. Parameters ..
      DOUBLE PRECISION  ZERO, TWO
      PARAMETER         (ZERO=0.0D0,TWO=2.0D0)
*     .. Scalar Arguments ..
      INTEGER           LDCJ, MODE, N, NCNLN, NSTATE
*     .. Array Arguments ..
      DOUBLE PRECISION  CCON(*), CJAC(LDCJ,*), RUSER(*), X(N)
      INTEGER           IUSER(*), NEEDC(*)
*     .. Local Scalars ..
      INTEGER           I, J
*     .. Executable Statements ..
      IF (NSTATE.EQ.1) THEN
*        First call to CONFUN.  Set all 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
      END IF
*
      IF (NEEDC(1).GT.0) THEN
         IF (MODE.EQ.0 .OR. MODE.EQ.2) CCON(1) = X(1)**2 + X(2)**2 +
     +       X(3)**2 + X(4)**2
         IF (MODE.EQ.1 .OR. MODE.EQ.2) 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
      END IF
*
      IF (NEEDC(2).GT.0) THEN
         IF (MODE.EQ.0 .OR. MODE.EQ.2) CCON(2) = X(1)*X(2)*X(3)*X(4)
         IF (MODE.EQ.1 .OR. MODE.EQ.2) 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
*
      RETURN
      END