!   E04MZF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.
    MODULE e04mzfe_mod

!      E04MZF Example Program Module:
!             Parameters and User-defined Routines

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       REAL (KIND=nag_wp), PARAMETER       :: xbldef = 0.0_nag_wp
       REAL (KIND=nag_wp), PARAMETER       :: xbudef = 1.0E+20_nag_wp
       INTEGER, PARAMETER                  :: iset = 1, lencw = 600,           &
                                              leniw = 600, lenrw = 600,        &
                                              maxm = 10000, maxn = 10000,      &
                                              maxnnz = 100000, nindat = 7,     &
                                              nout = 6
    CONTAINS
       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.)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Scalar Arguments ..
          INTEGER, INTENT (IN)                :: ncolh, nstate
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (OUT)    :: hx(ncolh)
          REAL (KIND=nag_wp), INTENT (INOUT)  :: ruser(*)
          REAL (KIND=nag_wp), INTENT (IN)     :: x(ncolh)
          INTEGER, INTENT (INOUT)             :: iuser(*)
          CHARACTER (8), INTENT (INOUT)       :: cuser(*)
!         .. Executable Statements ..
          IF (nstate==1) THEN

!            First entry.

             WRITE (nout,*)
             WRITE (nout,99999) ncolh
             FLUSH (nout)
          END IF

          hx(1) = 2.0_nag_wp*x(1) + x(2) + x(3) + x(4) + x(5)
          hx(2) = x(1) + 2.0_nag_wp*x(2) + x(3) + x(4) + x(5)
          hx(3) = x(1) + x(2) + 2.0_nag_wp*x(3) + x(4) + x(5)
          hx(4) = x(1) + x(2) + x(3) + 2.0_nag_wp*x(4) + x(5)
          hx(5) = x(1) + x(2) + x(3) + x(4) + 2.0_nag_wp*x(5)

          IF (nstate>=2) THEN

!            Final entry.

             WRITE (nout,*)
             WRITE (nout,99998)
             FLUSH (nout)
          END IF

          RETURN

99999     FORMAT (1X,' This is the E04MZF example.   NCOLH =',I4,'.')
99998     FORMAT (1X,' Finished the E04MZF example.')
       END SUBROUTINE qphx
    END MODULE e04mzfe_mod
    PROGRAM e04mzfe

!      E04MZF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : e04mzf, e04npf, e04nqf, e04ntf, x04abf, x04acf
       USE e04mzfe_mod, ONLY : iset, lencw, leniw, lenrw, maxm, maxn, maxnnz,  &
                               nag_wp, nindat, nout, qphx, xbldef, xbudef
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       CHARACTER (*), PARAMETER            :: fname = 'e04mzfe.opt'
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: obj, objadd, sinf
       INTEGER                             :: ifail, infile, iobj, lenc, m,    &
                                              mode, n, ncolh, ninf, nname,     &
                                              nnz, ns, outchn
       LOGICAL                             :: mpslst
       CHARACTER (8)                       :: prob
       CHARACTER (1)                       :: start
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: a(:), bl(:), bu(:), c(:), pi(:), &
                                              rc(:), xs(:)
       REAL (KIND=nag_wp)                  :: ruser(1), rw(lenrw)
       INTEGER, ALLOCATABLE                :: ha(:), helast(:), istate(:), ka(:)
       INTEGER                             :: iuser(1), iw(leniw)
       CHARACTER (8), ALLOCATABLE          :: crname(:)
       CHARACTER (8)                       :: cuser(1), cw(lencw), names(5)
!      .. Intrinsic Functions ..
       INTRINSIC                              max
!      .. Executable Statements ..
       WRITE (nout,99999) 'E04MZF Example Program Results'
       FLUSH (nout)

       ALLOCATE (ha(maxnnz),ka(maxn+1),istate(maxn+maxm),a(maxnnz), &
          bl(maxn+maxm),bu(maxn+maxm),xs(maxn+maxm),crname(maxn+maxm))

!      Open the data file for reading

       mode = 0

       ifail = 0
       CALL x04acf(nindat,fname,mode,ifail)

!      Initialize parameters.

       infile = nindat
       mpslst = .FALSE.
       names(1:5) = '        '

!      Convert the MPSX data file for use by E04NQF.

       ifail = 0
       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)

!      Set the unit number for advisory messages to OUTCHN.

       outchn = nout
       CALL x04abf(iset,outchn)

!      Reset the value of NCOLH.

       ncolh = 5

!      Call E04NPF to initialise E04NQF.

       ifail = 0
       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 A.

       lenc = 0
       ALLOCATE (c(max(1,lenc)),helast(n+m),pi(m),rc(n+m))

       objadd = 0.0_nag_wp
       prob = ' '

!      Do not allow any elastic variables (i.e. they cannot be
!      infeasible).

       helast(1:(n+m)) = 0

!      Solve the QP problem.

       ifail = 0
       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)

99999  FORMAT (1X,A)
    END PROGRAM e04mzfe