NAG Library Manual, Mark 30
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
!   E04MTF Example Program Text

!   Mark 30.0 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