Program e04tafe

!     This example program demonstrates how to edit an LP model using
!     the NAG Optimization Modeling Suite functionality
!
!     We solve here 3 variants of a small LP model:
!     I/   max 2x1 + 4.5x2
!            1.2x1 +  3x2 <= 1500
!            6x1   + 10x2 <= 6000
!            40x1  + 80x2  = 16000
!            0 <= x1
!            0 <= x2 <= 100
!
!     II/ A variable is added
!          max 2x1 + 4.5x2 + 7x3
!            1.2x1 + 3x2 + 5x3   <= 1500
!            6x1  + 10x2 + 12x3  <= 6000
!            40x1 + 80x2 + 120x3  = 16000
!            0 <= x1
!            0 <= x2 <= 100
!            0 <= x3 <= 50
!
!     III/ A linear constraint is added
!          max 2x1 + 4.5x2 + 7x3
!            1.2x1 + 3x2 + 5x3   <= 1500
!            6x1  + 10x2 + 12x3  <= 6000
!            40x1 + 80x2 + 120x3  = 16000
!                    x2  +   x3  <= 100
!            0 <= x1
!            0 <= x2 <= 100
!            0 <= x3 <= 50

!     Mark 27.3 Release. NAG Copyright 2021.

!     .. Use Statements ..
      Use iso_c_binding, Only: c_null_ptr, c_ptr
      Use nag_library, Only: e04mtf, e04mtu, e04raf, e04ref, e04rhf, e04rjf,   &
                             e04rwf, e04rzf, e04taf, e04tdf, e04tef, e04tjf,   &
                             e04zmf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter    :: infbnd = 1.0E20_nag_wp
      Integer, Parameter               :: nout = 6
!     .. Local Scalars ..
      Type (c_ptr)                     :: cpuser, handle
      Integer                          :: idlc, ifail, ioflag, liarr, nclin,   &
                                          nnza, nnzu, nvar
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: a(:), bla(:), bua(:), cvec(:),       &
                                          ulag(:), x(:), xl(:), xu(:)
      Real (Kind=nag_wp)               :: rinfo(100), ruser(1), stats(100),    &
                                          u(1)
      Integer, Allocatable             :: icola(:), irowa(:)
      Integer                          :: iuser(1), pinfo(100)
!     .. Executable Statements ..

      Write (nout,*) 'E04TAF Example Program Results'
      Write (nout,*)
      Write (nout,*) 'Solve the first LP'
      Write (nout,*)
      Flush (nout)

      handle = c_null_ptr
      cpuser = c_null_ptr

!     Initialize the handle
      nvar = 2
      ifail = 0
      Call e04raf(handle,nvar,ifail)

!     Define the objective function
      Allocate (cvec(nvar))
      cvec(:) = (/2.0_nag_wp,4.5_nag_wp/)
      ifail = 0
      Call e04ref(handle,nvar,cvec,ifail)

!     Box constraints
      Allocate (xl(nvar),xu(nvar))
      xl(:) = 0.0_nag_wp
      xu(:) = (/infbnd,100.0_nag_wp/)
      ifail = 0
      Call e04rhf(handle,nvar,xl,xu,ifail)

!     Set the linear constraints
      idlc = 0
      nclin = 3
      nnza = 6
      Allocate (bla(nclin),bua(nclin),irowa(nnza),icola(nnza),a(nnza))
      bla(:) = (/-infbnd,-infbnd,-infbnd/)
      bua(:) = (/1500.0_nag_wp,6000.0_nag_wp,16000.0_nag_wp/)
      irowa(:) = (/1,1,2,2,3,3/)
      icola(:) = (/1,2,1,2,1,2/)
      a(:) = (/1.2_nag_wp,3.0_nag_wp,6.0_nag_wp,10.0_nag_wp,40.0_nag_wp,       &
        80.0_nag_wp/)
      ifail = 0
      Call e04rjf(handle,nclin,bla,bua,nnza,irowa,icola,a,idlc,ifail)

!     Optional parameters
      Call e04zmf(handle,'Task = Max',ifail)
      Call e04zmf(handle,'Print Options = No',ifail)
      Call e04zmf(handle,'Print Level = 1',ifail)
      Call e04zmf(handle,'Print Solution = X',ifail)

!     Call the LP solver
      Allocate (x(nvar+1))
      nnzu = 0
      ifail = -1
      Call e04mtf(handle,nvar,x,nnzu,u,rinfo,stats,e04mtu,iuser,ruser,cpuser,  &
        ifail)

!     Add a variable
      ifail = 0
      Call e04taf(handle,1,nvar,ifail)

!     Box constraint on the new variable
      ifail = 0
      Call e04tdf(handle,'variable',nvar,0.0_nag_wp,50.0_nag_wp,ifail)

!     Add the linear objective component
      ifail = 0
      Call e04tef(handle,3,7.0_nag_wp,ifail)

!     Add linear constraints coefficients
      ifail = 0
      Call e04tjf(handle,1,3,5.0_nag_wp,ifail)
      ifail = 0
      Call e04tjf(handle,2,3,12.0_nag_wp,ifail)
      ifail = 0
      Call e04tjf(handle,3,3,120.0_nag_wp,ifail)

      Write (nout,*)
      Write (nout,*) 'The new variable has been added, solve the handle again'
      Write (nout,*)
      Flush (nout)

!     Solve the problem again
      ifail = -1
      Call e04mtf(handle,nvar,x,nnzu,u,rinfo,stats,e04mtu,iuser,ruser,cpuser,  &
        ifail)

!     Add a linear constraint
      nclin = 1
      bla(1) = -infbnd
      bua(1) = 100.0_nag_wp
      nnza = 2
      irowa(1:2) = (/1,1/)
      icola(1:2) = (/2,3/)
      a(1:2) = 1.0_nag_wp
      idlc = 0
      Call e04rjf(handle,nclin,bla,bua,nnza,irowa,icola,a,idlc,ifail)

      Write (nout,*)
      Write (nout,*)                                                           &
        'The new constraint has been added, solve the handle again'
      Write (nout,*)
      Flush (nout)

!     Query the problem sizes to request the Lagrangian multipliers for the
!     last solve
      ioflag = 1
      liarr = 100
      Call e04rwf(handle,'pinfo',ioflag,liarr,pinfo,ifail)
      nnzu = pinfo(11)
      Allocate (ulag(nnzu))

!     Solve the problem again
      ifail = -1
      Call e04mtf(handle,nvar,x,nnzu,ulag,rinfo,stats,e04mtu,iuser,ruser,      &
        cpuser,ifail)

!     Free the memory
      ifail = 0
      Call e04rzf(handle,ifail)

    End Program e04tafe