! H02DAF Example Program Text
! Mark 30.0 Release. NAG Copyright 2024.
Module h02dafe_mod
! .. Use Statements ..
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: confun, objfun
Contains
Subroutine objfun(mode,n,varcon,x,objmip,objgrd,nstate,iuser,ruser)
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (Out) :: objmip
Integer, Intent (Inout) :: mode
Integer, Intent (In) :: n, nstate
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Inout) :: objgrd(n), ruser(*)
Real (Kind=nag_wp), Intent (In) :: x(n)
Integer, Intent (Inout) :: iuser(*)
Integer, Intent (In) :: varcon(*)
! .. Executable Statements ..
If (mode==0) Then
! Objective value
objmip = x(1)*(4.0_nag_wp*x(1)+3.0_nag_wp*x(2)-x(3)) + &
x(2)*(3.0_nag_wp*x(1)+6.0_nag_wp*x(2)+x(3)) + &
x(3)*(x(2)-x(1)+10.0_nag_wp*x(3))
Else
! Objective gradients for continuous variables
objgrd(1) = 8.0_nag_wp*x(1) + 6.0_nag_wp*x(2) - 2.0_nag_wp*x(3)
objgrd(2) = 6.0_nag_wp*x(1) + 12.0_nag_wp*x(2) + 2.0_nag_wp*x(3)
objgrd(3) = 2.0_nag_wp*(x(2)-x(1)) + 20.0_nag_wp*x(3)
objgrd(4) = 0.0_nag_wp
End If
Return
End Subroutine objfun
Subroutine confun(mode,ncnln,n,varcon,x,c,cjac,nstate,iuser,ruser)
! .. Parameters ..
Real (Kind=nag_wp), Parameter :: eight = 8.0_nag_wp
Real (Kind=nag_wp), Parameter :: nine = 9.0_nag_wp
Real (Kind=nag_wp), Parameter :: seven = 7.0_nag_wp
Real (Kind=nag_wp), Parameter :: twelve = 12.0_nag_wp
Real (Kind=nag_wp), Parameter :: zero = 0.0_nag_wp
! .. Scalar Arguments ..
Integer, Intent (Inout) :: mode
Integer, Intent (In) :: n, ncnln, nstate
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Out) :: c(ncnln)
Real (Kind=nag_wp), Intent (Inout) :: cjac(ncnln,n), ruser(*)
Real (Kind=nag_wp), Intent (In) :: x(n)
Integer, Intent (Inout) :: iuser(*)
Integer, Intent (In) :: varcon(*)
! .. Local Scalars ..
Real (Kind=nag_wp) :: rho
Integer :: p
! .. Intrinsic Procedures ..
Intrinsic :: real
! .. Executable Statements ..
If (mode==0) Then
! Constraints
p = iuser(1)
rho = ruser(1)
! Mean return rho:
c(1) = eight*x(1) + nine*x(2) + twelve*x(3) + seven*x(4) - rho
! Maximum of p assets in portfolio:
c(2) = real(p,kind=nag_wp) - x(5) - x(6) - x(7) - x(8)
Else
! Jacobian
cjac(1,1:4) = (/eight,nine,twelve,seven/)
! c(2) does not include continuous variables which requires
! that their derivatives are zero
cjac(2,1:4) = zero
End If
Return
End Subroutine confun
End Module h02dafe_mod
Program h02dafe
! .. Use Statements ..
Use h02dafe_mod, Only: confun, objfun
Use nag_library, Only: h02daf, h02zkf, h02zlf, nag_wp, x04caf
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Real (Kind=nag_wp), Parameter :: bigish = 1.0E3_nag_wp
Real (Kind=nag_wp), Parameter :: one = 1.0_nag_wp
Real (Kind=nag_wp), Parameter :: zero = 0.0_nag_wp
Integer, Parameter :: nout = 6
! .. Local Scalars ..
Real (Kind=nag_wp) :: acc, accqp, objmip
Integer :: ifail, ivalue, lda, liopts, lopts, &
maxit, n, nclin, ncnln, optype
Character (40) :: cvalue
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: a(:,:), ax(:), bl(:), bu(:), c(:), &
cjac(:,:), d(:), objgrd(:), x(:)
Real (Kind=nag_wp) :: opts(100), ruser(1)
Integer :: iopts(200), iuser(1)
Integer, Allocatable :: varcon(:)
! .. Intrinsic Procedures ..
Intrinsic :: size
! .. Executable Statements ..
Write (nout,*) 'H02DAF Example Program Results'
Write (nout,*)
Flush (nout)
n = 8
nclin = 5
ncnln = 2
lda = nclin
Allocate (a(lda,n),d(nclin),ax(nclin),bl(n),bu(n),varcon(n+nclin+ncnln), &
x(n),c(ncnln),cjac(ncnln,n),objgrd(n))
! Set variable types: continuous then binary
varcon(1:4) = 0
varcon(5:8) = 1
! Set continuous variable bounds
bl(1:4) = zero
bu(1:4) = bigish
! Bounds for binary variables need not be provided
bl(5:8) = zero
bu(5:8) = one
! Set linear constraint, equality first
varcon(n+1) = 3
varcon(n+2:n+nclin) = 4
! Set Ax=d then Ax>=d
a(1:nclin,1:n) = zero
a(1,1:4) = one
a(2,(/1,5/)) = (/-one,one/)
a(3,(/2,6/)) = (/-one,one/)
a(4,(/3,7/)) = (/-one,one/)
a(5,(/4,8/)) = (/-one,one/)
d(1) = one
d(2:5) = zero
! Set constraints supplied by CONFUN, equality first
varcon(n+nclin+1) = 3
varcon(n+nclin+2) = 4
liopts = size(iopts)
lopts = size(opts)
! Initialize communication arrays
ifail = 0
Call h02zkf('Initialize = H02DAF',iopts,liopts,opts,lopts,ifail)
! Optimization parameters
maxit = 500
acc = 1.0E-6_nag_wp
! Initial estimate (binary variables need not be given)
x(1:4) = one
x(5:8) = zero
! Portfolio parameters p and rho
iuser(1) = 3
ruser(1) = 10.0_nag_wp
ifail = 0
Call h02daf(n,nclin,ncnln,a,lda,d,ax,bl,bu,varcon,x,confun,c,cjac, &
objfun,objgrd,maxit,acc,objmip,iopts,opts,iuser,ruser,ifail)
! Results
If (ifail==0) Then
Call x04caf('G','N',n,1,x,n,'Final estimate:',ifail)
! Query the accuracy of the mixed integer QP solver
ifail = -1
Call h02zlf('QP Accuracy',ivalue,accqp,cvalue,optype,iopts,opts,ifail)
If (ifail==0) Then
Write (nout,'(/1x,a,1x,g12.4)') &
'Requested accuracy of QP subproblems', accqp
End If
Write (nout,'(1x,a,1x,g12.4)') 'Optimised value:', objmip
Else
Write (nout,'(/1x,a,i4/)') 'h02daf returns ifail = ', ifail
End If
End Program h02dafe