! E04PTF Example Program Text
! Mark 29.1 Release. NAG Copyright 2023.
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