*     H02CFF Example Program Text
*     Mark 19 Release. NAG Copyright 1999.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          NMAX, MMAX, NNZMAX, LENIZ, LENZ, LINTVR, MM
      PARAMETER        (NMAX=100,MMAX=100,NNZMAX=100,LENIZ=100000,
     +                 LENZ=100000,LINTVR=10,MM=2000)
*     .. Local Scalars ..
      DOUBLE PRECISION OBJ
      INTEGER          I, ICOL, IFAIL, INFORM, IOBJ, J, JCOL, M, MINIZ,
     +                 MINZ, N, NCOLH, NNAME, NNZ, NS, OUTCHN, STRTGY
      CHARACTER        START
*     .. Local Arrays ..
      DOUBLE PRECISION A(NNZMAX), BL(NMAX+MMAX), BU(NMAX+MMAX),
     +                 CLAMDA(NMAX+MMAX), XS(NMAX+MMAX), Z(LENZ)
      INTEGER          HA(NNZMAX), INTVAR(LINTVR), ISTATE(NMAX+MMAX),
     +                 IZ(LENIZ), KA(NMAX+1)
      CHARACTER*8      CRNAME(NMAX+MMAX), NAMES(5)
*     .. External Subroutines ..
      EXTERNAL         H02CEF, H02CFF, H02CGF, MONIT, QPHX, X04ABF
*     .. Executable Statements ..
      WRITE (NOUT,*) 'H02CFF Example Program Results'
      OUTCHN = NOUT
*     Skip heading in data file.
      READ (NIN,*)
      READ (NIN,*) N, M
      IF (N.LE.NMAX .AND. M.LE.MMAX) THEN
*
*        Read NNZ, IOBJ, NCOLH, START and NNAME from data file.
*
         READ (NIN,*) NNZ, IOBJ, NCOLH, START, NNAME
*
*        Read NAMES and CRNAME from data file.
*
         READ (NIN,*) (NAMES(I),I=1,5)
         READ (NIN,*) (CRNAME(I),I=1,NNAME)
*
*        Read the matrix A from data file. Set up KA.
*
         JCOL = 1
         KA(JCOL) = 1
         DO 40 I = 1, NNZ
*
*           Element ( HA( I ), ICOL ) is stored in A( I ).
*
            READ (NIN,*) A(I), HA(I), ICOL
*
            IF (ICOL.EQ.JCOL+1) THEN
*
*              Index in A of the start of the ICOL-th column equals I.
*
               KA(ICOL) = I
               JCOL = ICOL
            ELSE IF (ICOL.GT.JCOL+1) THEN
*
*              Index in A of the start of the ICOL-th column equals I,
*              but columns JCOL+1,JCOL+2,...,ICOL-1 are empty. Set the
*              corresponding elements of KA to I.
*
               DO 20 J = JCOL + 1, ICOL - 1
                  KA(J) = I
   20          CONTINUE
               KA(ICOL) = I
               JCOL = ICOL
            END IF
   40    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)
         READ (NIN,*) (ISTATE(I),I=1,N)
         READ (NIN,*) (XS(I),I=1,N)
*
*        Set three options using H02CGF.
*
         CALL H02CGF(' Check Frequency = 10 ')
*
         CALL H02CGF(' Feasibility Tolerance = 0.00001 ')
*
         CALL H02CGF(' 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 H02CFF(NIN,INFORM)
*
         IF (INFORM.NE.0) THEN
            WRITE (NOUT,99999) 'H02CFF terminated with INFORM = ',
     +        INFORM
            GO TO 60
         END IF
*
         STRTGY = 3
         INTVAR(1) = 2
         INTVAR(2) = 3
         INTVAR(3) = 4
         INTVAR(4) = 5
         INTVAR(5) = 6
         INTVAR(6) = 7
         INTVAR(7) = -1
*
         CALL H02CGF('NoList')
         CALL H02CGF('Print Level = 0')
*
*        Solve the QP problem.
*
         IFAIL = 0
*
         CALL H02CEF(N,M,NNZ,IOBJ,NCOLH,QPHX,A,HA,KA,BL,BU,START,NAMES,
     +               NNAME,CRNAME,NS,XS,INTVAR,LINTVR,MM,ISTATE,MINIZ,
     +               MINZ,OBJ,CLAMDA,STRTGY,IZ,LENIZ,Z,LENZ,MONIT,IFAIL)
*
*        Print out the best integer solution found
*
         WRITE (NOUT,99999) OBJ, (I,XS(I),I=1,N)
      END IF
   60 CONTINUE
*
99999 FORMAT (' Optimal Integer Value is = ',E20.8,/' Components are ',
     +       /(' X(',I3,') = ',F10.2))
      END
*
      SUBROUTINE QPHX(NSTATE,NCOLH,X,HX)
*
*     Routine to compute H*x. (In this version of QPHX, the Hessian
*     matrix H is not referenced explicitly.)
*
*     .. Parameters ..
      DOUBLE PRECISION TWO
      PARAMETER        (TWO=2.0D+0)
*     .. Scalar Arguments ..
      INTEGER          NCOLH, NSTATE
*     .. Array Arguments ..
      DOUBLE PRECISION HX(NCOLH), X(NCOLH)
*     .. Executable Statements ..
      HX(1) = TWO*X(1)
      HX(2) = TWO*X(2)
      HX(3) = TWO*(X(3)+X(4))
      HX(4) = HX(3)
      HX(5) = TWO*X(5)
      HX(6) = TWO*(X(6)+X(7))
      HX(7) = HX(6)
*
      END
*
      SUBROUTINE MONIT(INTFND,NODES,DEPTH,OBJ,X,BSTVAL,BSTSOL,BL,BU,N,
     +                 HALT,COUNT)
*     .. Parameters ..
      DOUBLE PRECISION CUTOFF
      PARAMETER        (CUTOFF=-1840000.0D+0)
*     .. Scalar Arguments ..
      DOUBLE PRECISION BSTVAL, OBJ
      INTEGER          COUNT, DEPTH, INTFND, N, NODES
      LOGICAL          HALT
*     .. Array Arguments ..
      DOUBLE PRECISION BL(N), BSTSOL(N), BU(N), X(N)
*     .. Executable Statements ..
      IF (INTFND.EQ.0) BSTVAL = CUTOFF
*
      END