! E04MTF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
Module e04mtfe_mod
! .. Use Statements ..
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: monit
Contains
Subroutine monit(handle,rinfo,stats,iuser,ruser,cpuser,inform)
! Monitoring function
! .. Use Statements ..
Use iso_c_binding, Only: c_ptr
! .. Scalar Arguments ..
Type (c_ptr), Intent (In) :: cpuser, handle
Integer, Intent (Inout) :: inform
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (In) :: rinfo(100), stats(100)
Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
Integer, Intent (Inout) :: iuser(*)
! .. Local Scalars ..
Real (Kind=nag_wp) :: tol
Integer :: nout
! .. Intrinsic Procedures ..
Intrinsic :: int
! .. Executable Statements ..
nout = iuser(1)
tol = 1.2E-08_nag_wp
! If x is close to the solution, print a message
If (iuser(2)==1) Then
! For the primal-dual algorithm
If (rinfo(5)<tol .And. rinfo(6)<tol .And. rinfo(7)<tol) Then
Write (nout,99999) 'Iteration ', int(stats(1))
Write (nout,99998) &
'monit() reports good approximate solution (tol =', tol, '):'
End If
Else
! For the self-dual algorithm
If (rinfo(15)<tol .And. rinfo(16)<tol .And. rinfo(17)<tol .And. &
rinfo(18)<tol) Then
Write (nout,99999) 'Iteration ', int(stats(1))
Write (nout,99998) &
'monit() reports good approximate solution (tol =', tol, '):'
End If
End If
Return
99999 Format (5X,A,I2)
99998 Format (5X,A,Es9.2,A)
End Subroutine monit
End Module e04mtfe_mod
Program e04mtfe
! .. Use Statements ..
Use e04mtfe_mod, Only: monit
Use iso_c_binding, Only: c_null_ptr, c_ptr
Use nag_library, Only: e04mtf, e04raf, e04rff, e04rhf, e04rjf, e04rzf, &
e04zmf, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Type (c_ptr) :: cpuser, handle
Integer :: idlc, ifail, m, n, nnza, nnzc, nnzu
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: a(:), bla(:), bua(:), c(:), u(:), &
x(:), xl(:), xu(:)
Real (Kind=nag_wp) :: h(1), rinfo(100), ruser(1), &
stats(100)
Integer, Allocatable :: cindex(:), icola(:), irowa(:)
Integer :: icolh(1), irowh(1), iuser(2)
! .. Executable Statements ..
Write (nout,*) 'E04MTF Example Program Results'
! Skip Header in data file
Read (nin,*)
! read dimensions of the problem
Read (nin,*) m, n, nnza, nnzc
nnzu = 2*n + 2*m
! Allocate memory
Allocate (cindex(nnzc),icola(nnza),irowa(nnza),a(nnza),bla(m),bua(m), &
xl(n),xu(n),c(nnzc),x(n),u(nnzu))
! Read problem data
Read (nin,*) cindex(1:nnzc)
Read (nin,*) c(1:nnzc)
Read (nin,*) irowa(1:nnza)
Read (nin,*) icola(1:nnza)
Read (nin,*) a(1:nnza)
Read (nin,*) bla(1:m)
Read (nin,*) bua(1:m)
Read (nin,*) xl(1:n)
Read (nin,*) xu(1:n)
! Create the problem handle
! Initialize handle
ifail = 0
Call e04raf(handle,n,ifail)
! set objective function
Call e04rff(handle,nnzc,cindex,c,0,irowh,icolh,h,ifail)
! Set box constraints
Call e04rhf(handle,n,xl,xu,ifail)
! Set linear constraints.
idlc = 0
Call e04rjf(handle,m,bla,bua,nnza,irowa,icola,a,idlc,ifail)
! Turn on monitoring
Call e04zmf(handle,'LPIPM Monitor Frequency = 1',ifail)
! Require a high accuracy solution
Call e04zmf(handle,'LPIPM Stop Tolerance = 1.0e-10',ifail)
! Require printing of the solution at the end of the solve
Call e04zmf(handle,'Print Solution = YES',ifail)
! Use a constant number of centrality correctors steps
Call e04zmf(handle,'LPIPM Centrality Correctors = -6',ifail)
! Call LP interior point solver with the default (primal-dual) algorithm
Write (nout,*)
Write (nout,*) '++++++++++ Use the Primal-Dual algorithm ++++++++++'
cpuser = c_null_ptr
iuser(1) = nout
iuser(2) = 1
ifail = -1
Call e04mtf(handle,n,x,nnzu,u,rinfo,stats,monit,iuser,ruser,cpuser, &
ifail)
! Solve the same problem with the self-dual algorithm
Write (nout,*)
Write (nout,*) '++++++++++ Use the Self-Dual algorithm ++++++++++'
Call e04zmf(handle,'LPIPM Algorithm = Self-Dual',ifail)
Call e04zmf(handle,'LPIPM Stop Tolerance 2 = 1.0e-11',ifail)
iuser(2) = 2
ifail = -1
Call e04mtf(handle,n,x,nnzu,u,rinfo,stats,monit,iuser,ruser,cpuser, &
ifail)
! Free the handle memory
Call e04rzf(handle,ifail)
End Program e04mtfe