*     E04MZF Example Program Text
*     Mark 21 Release. NAG Copyright 2004.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          MAXN, MAXM, MAXNE
      PARAMETER        (MAXN=10000,MAXM=10000,MAXNE=100000)
      INTEGER          LENCW, LENIW, LENRW
      PARAMETER        (LENCW=600,LENIW=600,LENRW=600)
      DOUBLE PRECISION ZERO, XBLDEF, XBUDEF
      PARAMETER        (ZERO=0.0D+0,XBLDEF=ZERO,XBUDEF=1.0D+20)
*     .. Local Scalars ..
      DOUBLE PRECISION OBJ, OBJADD, SINF
      INTEGER          I, IFAIL, INFILE, IOBJ, LENC, M, N, NCOLH, NE,
     +                 NINF, NNAME, NS
      LOGICAL          MPSLST
      CHARACTER        START
      CHARACTER*8      KBLANK, PROB
*     .. Local Arrays ..
      DOUBLE PRECISION ACOL(MAXNE), BL(MAXN+MAXM), BU(MAXN+MAXM), C(1),
     +                 PI(MAXM), RC(MAXM+MAXN), RUSER(1), RW(LENRW),
     +                 XS(MAXN+MAXM)
      INTEGER          HELAST(MAXN+MAXM), INDA(MAXNE),
     +                 ISTATE(MAXN+MAXM), IUSER(1), IW(LENIW),
     +                 LOCA(MAXN+1)
      CHARACTER*8      CRNAME(MAXN+MAXM), CUSER(1), CW(LENCW),
     +                 NAMES(5)
*     .. External Subroutines ..
      EXTERNAL         E04MZF, E04NPF, E04NQF, E04NTF, QPHX, X04ABF
*     .. Data statements ..
      DATA             KBLANK/'        '/
*     .. Executable Statements ..
      WRITE (NOUT,*) 'E04MZF Example Program Results'
*     Skip heading in data file.
      READ (NIN,*)
*
*     Initialize parameters.
*
      INFILE = NIN
      MPSLST = .FALSE.
      DO 20 I = 1, 5
         NAMES(I) = KBLANK
   20 CONTINUE
*
*     Convert the MPSX data file for use by E04NKF.
*
      IFAIL = 0
*
      CALL E04MZF(INFILE,MAXN,MAXM,MAXNE,XBLDEF,XBUDEF,MPSLST,N,M,NE,
     +            IOBJ,NCOLH,ACOL,INDA,LOCA,BL,BU,START,NAMES,NNAME,
     +            CRNAME,XS,ISTATE,IFAIL)
*
      IF (IFAIL.EQ.0) THEN
*
*        Set the unit number for advisory messages to NOUT.
*
         CALL X04ABF(1,NOUT)
*
*        Reset the value of NCOLH.
*
         NCOLH = 5
*
*        Call E04NPF to initialise E04NQF.
         IFAIL = -1
         CALL E04NPF(CW,LENCW,IW,LENIW,RW,LENRW,IFAIL)
         CALL E04NTF('Print file',NOUT,CW,IW,RW,IFAIL)
*
*        We have no explicit objective vector so set LENC = 0; the
*        objective vector is stored in row IOBJ of ACOL.
         LENC = 0
         OBJADD = 0.0D0
         PROB = ' '
*
*        Do not allow any elastic variables (i.e. they cannot be
*        infeasible).
         DO 40 I = 1, N + M
            HELAST(I) = 0
   40    CONTINUE
*
*        Solve the QP problem.
         IFAIL = -1
         CALL E04NQF(START,QPHX,M,N,NE,NNAME,LENC,NCOLH,IOBJ,OBJADD,
     +               PROB,ACOL,INDA,LOCA,BL,BU,C,CRNAME,HELAST,ISTATE,
     +               XS,PI,RC,NS,NINF,SINF,OBJ,CW,LENCW,IW,LENIW,RW,
     +               LENRW,CUSER,IUSER,RUSER,IFAIL)


      END IF
*
      STOP
*
99999 FORMAT (1X,A,I3)
      END
*
      SUBROUTINE QPHX(NCOLH,X,HX,NSTATE,CUSER,IUSER,RUSER)
*
*     Routine to compute H*x. (In this version of QPHX, the Hessian
*     matrix H is not referenced explicitly.)
*
*     .. Parameters ..
      INTEGER         NOUT
      PARAMETER       (NOUT=6)
      DOUBLE PRECISION TWO
      PARAMETER       (TWO=2.0D+0)
*     .. Scalar Arguments ..
      INTEGER         NCOLH, NSTATE
*     .. Array Arguments ..
      DOUBLE PRECISION HX(NCOLH), RUSER(*), X(NCOLH)
      INTEGER         IUSER(*)
      CHARACTER*8     CUSER(*)
*     .. Executable Statements ..
      IF (NSTATE.EQ.1) THEN
*
*        First entry.
*
         WRITE (NOUT,99999) NCOLH
*
      END IF
*
*     Normal entry.
*
      HX(1) = TWO*X(1) + X(2) + X(3) + X(4) + X(5)
      HX(2) = X(1) + TWO*X(2) + X(3) + X(4) + X(5)
      HX(3) = X(1) + X(2) + TWO*X(3) + X(4) + X(5)
      HX(4) = X(1) + X(2) + X(3) + TWO*X(4) + X(5)
      HX(5) = X(1) + X(2) + X(3) + X(4) + TWO*X(5)
*
      IF (NSTATE.GE.2) THEN
*
*        Final entry.
*
         WRITE (NOUT,99998)
*
      END IF
*
      RETURN
*
99999 FORMAT (/' This is the E04MZF example.   NCOLH =',I4,'.')
99998 FORMAT (/' Finished the E04MZF example.')
      END
