*     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, OUTCHN
      LOGICAL          LMOK
      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 Functions ..
      LOGICAL          A00ACF
      EXTERNAL         A00ACF
*     .. External Subroutines ..
      EXTERNAL         E04UGF, E04UGM, E04UHF, E04UJF, OBJFUN, X04ABF
*     .. Executable Statements ..
      WRITE (NOUT,*) 'E04UHF Example Program Results'
      OUTCHN = NOUT
*     Skip heading in data file.
      READ (NIN,*)
      READ (NIN,*) N, M
      LMOK = A00ACF()
      IF ( .NOT. LMOK) THEN
         WRITE (NOUT,*)
         WRITE (NOUT,*) ' ** A valid licence key was not found'
      ELSE IF (N.GT.NMAX .OR. M.GT.MMAX) THEN
         WRITE (NOUT,*)
         WRITE (NOUT,*) ' ** At least one of N or M is too large'
      ELSE
*
*        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 OUTCHN.
*
         CALL X04ABF(1,OUTCHN)
*
*        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
            GO TO 40
         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)
*
         IF (IFAIL.NE.0) THEN
            WRITE (NOUT,99999) ' ** E04UGF returned with IFAIL = ',
     +        IFAIL
         END IF
      END IF
   40 CONTINUE
*
99999 FORMAT (1X,A,I5)
      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