```!   E04MXF Example Program Text
!   Mark 26 Release. NAG Copyright 2016.

Module e04mxfe_mod

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

!     .. Use Statements ..
Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
Implicit None
!     .. Accessibility Statements ..
Private
Public                           :: qphx
Contains
Subroutine qphx(ncolh,x,hx,nstate,cuser,iuser,ruser)

!       Subroutine to compute H*x.

!       Note: IUSER and RUSER contain the following data:
!       RUSER(1:NNZH) = H(1:NNZH)
!       IUSER(1:NCOLH+1) = ICCOLH(1:NCOLH+1)
!       IUSER(NCOLH+2:NNZH+NCOLH+1) = IROWH(1:NNZH)

!       .. 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(*)
!       .. Local Scalars ..
Integer                        :: end, icol, idx, irow, start
!       .. Executable Statements ..
hx(1:ncolh) = 0.0E0_nag_wp

Do icol = 1, ncolh
start = iuser(icol)
end = iuser(icol+1) - 1

Do idx = start, end
irow = iuser(ncolh+1+idx)
hx(irow) = hx(irow) + x(icol)*ruser(idx)
If (irow/=icol) Then
hx(icol) = hx(icol) + x(irow)*ruser(idx)
End If

End Do

End Do

Return
End Subroutine qphx
End Module e04mxfe_mod

Program e04mxfe

!     .. Use Statements ..
Use nag_library, Only: e04mxf, e04npf, e04nqf, e04nsf, e04ntf, nag_wp,   &
Use e04mxfe_mod, Only: qphx
!     .. Implicit None Statement ..
Implicit None
!     .. Parameters ..
Integer, Parameter               :: lencw = 600, leniw = 600,            &
lenrw = 600, mpslst = 1, nin = 7,    &
nout = 6
Logical, Parameter               :: readints = .False.
Character (*), Parameter         :: fname = 'e04mxfe.opt'
!     .. Local Scalars ..
Real (Kind=nag_wp)               :: obj, objadd, sinf
Integer                          :: i, ifail, iobj, lenc, lintvar, m,    &
maxlintvar, maxm, maxn, maxncolh,    &
maxnnz, maxnnzh, minmax, mode, n,    &
ncolh, ninf, nname, nnz, nnzh, ns
Character (1)                    :: start
!     .. Local Arrays ..
Real (Kind=nag_wp), Allocatable  :: a(:), bl(:), bu(:), c(:), h(:),      &
pi(:), rc(:), ruser(:), rw(:), x(:)
Integer, Allocatable             :: helast(:), hs(:), iccola(:),         &
iccolh(:), intvar(:), irowa(:),      &
irowh(:), iuser(:), iw(:)
Character (8), Allocatable       :: crname(:), cw(:)
Character (8)                    :: cuser(1), pnames(5)
!     .. Intrinsic Procedures ..
Intrinsic                        :: max, min
!     .. Executable Statements ..
Write (nout,*) 'E04MXF Example Program Results'
Flush (nout)

!     Initialize
pnames(1:5) = '        '
maxm = 0
maxn = 0
maxnnz = 0
maxnnzh = 0
maxncolh = 0
maxlintvar = 0

!     Open the data file for reading
mode = 0
ifail = 0
Call x04acf(nin,fname,mode,ifail)

!     Call e04mxf in query mode
Allocate (a(maxnnz),irowa(maxnnz),iccola(maxn+1),bl(maxn+maxm),          &
bu(maxn+maxm),crname(maxn+maxm),h(maxnnzh),irowh(maxnnzh),             &
iccolh(maxncolh+1),intvar(maxlintvar))
ifail = 0
Call e04mxf(nin,maxn,maxm,maxnnz,maxncolh,maxnnzh,maxlintvar,mpslst,n,m, &
nnz,ncolh,nnzh,lintvar,iobj,a,irowa,iccola,bl,bu,pnames,nname,crname,  &
h,irowh,iccolh,minmax,intvar,ifail)
Deallocate (a,irowa,iccola,bl,bu,crname,h,irowh,iccolh,intvar)

!     Close the data file
ifail = 0

!     set maxm maxn and maxnnz
maxm = m
maxn = n
maxnnz = nnz
maxnnzh = nnzh
maxncolh = ncolh
maxlintvar = lintvar
Else
maxlintvar = -1
End If

!     Allocate memory
Allocate (irowa(maxnnz),iccola(maxn+1),a(maxnnz),bl(maxn+maxm),          &
bu(maxn+maxm),crname(maxn+maxm),irowh(maxnnzh),iccolh(maxncolh+1),     &
h(maxnnzh),intvar(maxlintvar))

!     Open the data file for reading
mode = 0
ifail = 0
Call x04acf(nin,fname,mode,ifail)

!     Call e04mxf to read the problem
ifail = 0
Call e04mxf(nin,maxn,maxm,maxnnz,maxncolh,maxnnzh,maxlintvar,mpslst,n,m, &
nnz,ncolh,nnzh,lintvar,iobj,a,irowa,iccola,bl,bu,pnames,nname,crname,  &
h,irowh,iccolh,minmax,intvar,ifail)

!     Close the data file
ifail = 0

!     Data has been read. Set up and run the solver

Allocate (iw(leniw),rw(lenrw),cw(lencw))

!     Call e04npf to initialize workspace
ifail = 0
Call e04npf(cw,lencw,iw,leniw,rw,lenrw,ifail)

!     Call option setter e04nsf to change the direction of optimization.
!     Minimization is assumed by default.
If (minmax==1) Then
ifail = 0
Call e04nsf('Maximize',cw,iw,rw,ifail)
Else If (minmax==0) Then
ifail = 0
Call e04nsf('Feasible Point',cw,iw,rw,ifail)
End If

!     By default E04NQF does not print monitoring
!     information. Set the print file unit or the summary
!     file unit to get information.
ifail = 0
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
start = 'C'

Allocate (c(max(1,lenc)),helast(n+m),x(n+m),pi(m),rc(n+m),hs(n+m),iuser( &
ncolh+1+nnzh),ruser(nnzh))

helast(1:n+m) = 0
hs(1:n+m) = 0
Do i = 1, n + m
x(i) = min(max(0.0E0_nag_wp,bl(i)),bu(i))
End Do

If (ncolh>0) Then
!       Store the non zeros of H in ruser for use by qphx
ruser(1:nnzh) = h(1:nnzh)

!       Store iccolh and irowh in iuser for use by qphx
iuser(1:ncolh+1) = iccolh(1:ncolh+1)
iuser(ncolh+2:nnzh+ncolh+1) = irowh(1:nnzh)
End If

!     Call e04nqf to solve the problem
ifail = 0