! E04MZF Example Program Text ! Mark 24 Release. NAG Copyright 2012. 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.) ! .. 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, nag_wp, x04abf, & x04acf Use e04mzfe_mod, Only: iset, lencw, leniw, lenrw, maxm, maxn, maxnnz, & 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 Procedures .. 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