*     E04MZF Example Program Text
*     Mark 21 Release. NAG Copyright 2004.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          MAXN, MAXM, MAXNNZ
      PARAMETER        (MAXN=10000,MAXM=10000,MAXNNZ=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, NINF,
     +                 NNAME, NNZ, NS, OUTCHN
      LOGICAL          MPSLST
      CHARACTER        START
      CHARACTER*8      KBLANK, PROB
*     .. Local Arrays ..
      DOUBLE PRECISION A(MAXNNZ), BL(MAXN+MAXM), BU(MAXN+MAXM), C(1),
     +                 PI(MAXM), RC(MAXM+MAXN), RUSER(1), RW(LENRW),
     +                 XS(MAXN+MAXM)
      INTEGER          HA(MAXNNZ), HELAST(MAXN+MAXM), ISTATE(MAXN+MAXM),
     +                 IUSER(1), IW(LENIW), KA(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'
      OUTCHN = NOUT
*
*     Initialize parameters.
*
      INFILE = NIN
      MPSLST = .FALSE.
      DO 20 I = 1, 5
         NAMES(I) = KBLANK
   20 CONTINUE
*
*     Convert the MPSX data file for use by E04NQF.
*
      IFAIL = 1
*
      CALL E04MZF(INFILE,MAXN,MAXM,MAXNNZ,XBLDEF,XBUDEF,MPSLST,N,M,NNZ,
     +            IOBJ,NCOLH,A,HA,KA,BL,BU,START,NAMES,NNAME,CRNAME,XS,
     +            ISTATE,IFAIL)
*
      IF (IFAIL.EQ.0) THEN
*
*        Set the unit number for advisory messages to OUTCHN.
*
         CALL X04ABF(1,OUTCHN)
*
*        Reset the value of NCOLH.
*
         NCOLH = 5
*
*        Call E04NPF to initialise E04NQF.
         IFAIL = -1
         CALL E04NPF(CW,LENCW,IW,LENIW,RW,LENRW,IFAIL)
         IF (IFAIL.EQ.0) THEN
            CALL E04NTF('Print file',NOUT,CW,IW,RW,IFAIL)
         END IF
         IF (IFAIL.NE.0) GO TO 60
*
*        We have no explicit objective vector so set LENC = 0; the
*        objective vector is stored in row IOBJ of A.
         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,NNZ,NNAME,LENC,NCOLH,IOBJ,OBJADD,
     +               PROB,A,HA,KA,BL,BU,C,CRNAME,HELAST,ISTATE,XS,PI,RC,
     +               NS,NINF,SINF,OBJ,CW,LENCW,IW,LENIW,RW,LENRW,CUSER,
     +               IUSER,RUSER,IFAIL)
*
      ELSE
         WRITE (NOUT,*)
         WRITE (NOUT,99999) ' ** E04MZF returned with IFAIL = ', IFAIL
      END IF
*
   60 CONTINUE
*
99999 FORMAT (1X,A,I5)
      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