!   E04PTF Example Program Text
!   Mark 30.0 Release. NAG Copyright 2024.

    Program e04ptfe

!     .. Use Statements ..
      Use iso_c_binding, Only: c_null_ptr, c_ptr
      Use nag_library, Only: e04ptf, e04ptu, e04raf, e04rbf, e04ref, 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                          :: icone, idgroup, idlc, ifail, m, n,   &
                                          ncones, nnza, nnzu, nnzuc,           &
                                          nvar_cone, x_idx
      Logical                          :: verbose_output
      Character (8)                    :: cone_type
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: a(:), bla(:), bua(:), c(:), u(:),    &
                                          uc(:), x(:), xl(:), xu(:)
      Real (Kind=nag_wp)               :: rinfo(100), ruser(1), stats(100)
      Integer, Allocatable             :: icola(:), irowa(:), vidx_cone(:)
      Integer                          :: iuser(1)
!     .. Executable Statements ..

      Write (nout,*) 'E04PTF Example Program Results'

!     Skip Header in data file
      Read (nin,*)

!     Read dimensions of the problem
      Read (nin,*) n, m, nnza
      nnzu = 2*n + 2*m

!     Allocate memory
      Allocate (icola(nnza),irowa(nnza),a(nnza),bla(m),bua(m),xl(n),xu(n),     &
        c(n),vidx_cone(n))

!     Read problem data: linear objective function, constraints and bounds
      Read (nin,*) c(1:n)
      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
      ifail = 0
      Call e04raf(handle,n,ifail)

!     Set objective function
      ifail = 0
      Call e04ref(handle,n,c,ifail)

!     Set box constraints
      ifail = 0
      Call e04rhf(handle,n,xl,xu,ifail)

!     Set linear constraints
      ifail = 0
      idlc = 0
      Call e04rjf(handle,m,bla,bua,nnza,irowa,icola,a,idlc,ifail)

!     Create the number of cone constraints
      Read (nin,*) ncones

!     Read and set cone constraints one by one
      nnzuc = 0
      Do icone = 1, ncones

!       Read cone dimension, its type and variable indices
        Read (nin,*) nvar_cone
        Read (nin,*) cone_type
        Read (nin,*) vidx_cone(1:nvar_cone)

!       Set a new cone constraint
        ifail = 0
        idgroup = 0
        Call e04rbf(handle,cone_type,nvar_cone,vidx_cone,idgroup,ifail)

!       Update number of dual cone variables
        nnzuc = nnzuc + nvar_cone

      End Do

!     Set this to .True. to cause e04ptf to produce intermediate
!     progress output
      verbose_output = .False.

      If (verbose_output) Then
!       Require printing of primal and dual solutions at the end of the solve
        ifail = 0
        Call e04zmf(handle,'Print Solution = YES',ifail)
      Else
!       Turn off printing of intermediate progress output
        ifail = 0
        Call e04zmf(handle,'Print Level = 1',ifail)
      End If

!     Allocate memory for the solution
      Allocate (x(n),u(nnzu),uc(nnzuc))

!     Call SOCP interior point solver
      cpuser = c_null_ptr
      ifail = -1
      Call e04ptf(handle,n,x,nnzu,u,nnzuc,uc,rinfo,stats,e04ptu,iuser,ruser,   &
        cpuser,ifail)

!     Print solution if optimal or suboptimal solution found
      If (ifail==0 .Or. ifail==50) Then
        Write (nout,99999) 'Optimal X:'
        Write (nout,99997) 'x_idx', '    Value    '
        Do x_idx = 1, n
          Write (nout,99998) x_idx, x(x_idx)
        End Do
      End If

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


99999 Format (1X,A)
99998 Format (2X,I5,3X,Es12.5e2)
99997 Format (2X,A5,3X,A12)

    End Program e04ptfe