! E04MZF Example Program Text
! Mark 27.1 Release. NAG Copyright 2020.
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
! .. Accessibility Statements ..
Private
Public :: qphx
! .. Parameters ..
Real (Kind=nag_wp), Parameter, Public :: xbldef = 0.0_nag_wp
Real (Kind=nag_wp), Parameter, Public :: xbudef = 1.0E+20_nag_wp
Integer, Parameter, Public :: 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.)
! .. 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. You may perform any required one-time
! operations here.
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. You may perform any required clean up
! operations here.
End If
Return
End Subroutine qphx
End Module e04mzfe_mod
Program e04mzfe
! E04MZF Example Main Program
! .. Use Statements ..
Use e04mzfe_mod, Only: iset, lencw, leniw, lenrw, maxm, maxn, maxnnz, &
nindat, nout, qphx, xbldef, xbudef
Use nag_library, Only: e04mzf, e04npf, e04nqf, e04ntf, nag_wp, x04abf, &
x04acf
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Character (*), Parameter :: fname = 'e04mzfe.opt'
! .. Local Scalars ..
Real (Kind=nag_wp) :: obj, objadd, sinf
Integer :: i, ifail, infile, iobj, lenc, m, &
mode, n, ncolh, ninf, nname, nnz, &
ns, outchn
Logical :: mpslst, verbose_output
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 Procedures ..
Intrinsic :: max
! .. Executable Statements ..
Write (nout,*) 'E04MZF Example Program Results'
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.
Write (nout,99999)
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)
Write (nout,99998) n, m
! Set the unit number for advisory messages to OUTCHN.
outchn = nout
Call x04abf(iset,outchn)
! Set the value of NCOLH (the number of columns of the Hessian matrix)
ncolh = 5
! Call E04NPF to initialize E04NQF.
ifail = 0
Call e04npf(cw,lencw,iw,leniw,rw,lenrw,ifail)
! Set this to .True. to cause e04nqf to produce intermediate
! progress output
verbose_output = .False.
If (verbose_output) Then
Call e04ntf('Print file',nout,cw,iw,rw,ifail)
End If
! 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
Write (nout,99997)
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)
Write (nout,99996) obj
Write (nout,99995)
Write (nout,99994)(i,xs(i),i=1,n)
99999 Format (1X,/,1X,'Reading MPSX file:')
99998 Format (1X,'MPSX file contains ',I3,' variables and ',I3, &
' linear constraints')
99997 Format (1X,/,1X,'Solving QP problem:')
99996 Format (1X,'Optimal objective value: ',1P,E11.3)
99995 Format (1X,'Optimal X:')
99994 Format (1X,' X(',I2,') =',F10.4)
End Program e04mzfe