! H02BZF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
Module h02bzfe_mod
! H02BZF Example Program Module:
! Parameters and User-defined Routines
! .. Use Statements ..
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: outsol
! .. Parameters ..
Integer, Parameter, Public :: nin = 5, nout = 6
Contains
Subroutine outsol(n,m,a,lda,bl,bu,x,istate,clamda,bigbnd,names,nout)
! .. Use Statements ..
Use nag_library, Only: ddot
! .. Parameters ..
Character (2), Parameter :: lstate(-2:4) = (/' ',' ','FR','LL' &
,'UL','EQ','TF'/)
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: bigbnd
Integer, Intent (In) :: lda, m, n, nout
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (In) :: a(lda,*), bl(n+m), bu(n+m), &
clamda(n+m), x(n)
Integer, Intent (In) :: istate(n+m)
Character (8), Intent (In) :: names(n+m)
! .. Local Scalars ..
Real (Kind=nag_wp) :: b1, b2, res, res2, v, wlam
Integer :: is, j, k
Character (80) :: rec
! .. Intrinsic Procedures ..
Intrinsic :: abs
! .. Executable Statements ..
Write (nout,99999)
Do j = 1, n + m
b1 = bl(j)
b2 = bu(j)
wlam = clamda(j)
is = istate(j)
If (j<=n) Then
! The variables x.
k = j
v = x(j)
Else
! The linear constraints A*x.
If (j==n+1) Then
Write (nout,99998)
End If
k = j - n
! The NAG name equivalent of ddot is f06eaf
v = ddot(n,a(k,1),lda,x,1)
End If
! Print a line for the j-th variable or constraint.
res = v - b1
res2 = b2 - v
If (abs(res)>abs(res2)) Then
res = res2
End If
Write (rec,99997) names(j), lstate(is), v, b1, b2, wlam, res
If (b1<=-bigbnd) Then
rec(29:42) = ' None '
End If
If (b2>=bigbnd) Then
rec(43:56) = ' None '
End If
Write (nout,'(A)') rec
End Do
Return
99999 Format (/,/,1X,'Varbl',3X,'State',5X,'Value',5X,'Lower Bound',3X, &
'Upper Bound',4X,'Lagr Mult',3X,'Residual',/)
99998 Format (/,/,1X,'L Con',3X,'State',5X,'Value',5X,'Lower Bound',3X, &
'Upper Bound',4X,'Lagr Mult',3X,'Residual',/)
99997 Format (1X,A8,2X,A2,1X,1P,3G14.4,1P,G12.4,1P,G12.4)
End Subroutine outsol
End Module h02bzfe_mod
Program h02bzfe
! H02BZF Example Main Program
! .. Use Statements ..
Use h02bzfe_mod, Only: nin, nout, outsol
Use nag_library, Only: h02bbf, h02bzf, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Real (Kind=nag_wp) :: bigbnd, inival, objmip, tolfes, &
toliv
Integer :: i, ifail, intfst, itmax, j, lda, &
liwork, lrwork, m, maxdpt, maxnod, &
msglvl, n
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: a(:,:), bl(:), bu(:), clamda(:), &
cvec(:), rwork(:), x(:)
Integer, Allocatable :: intvar(:), istate(:), iwork(:)
Character (8), Allocatable :: names(:)
! .. Intrinsic Procedures ..
Intrinsic :: min
! .. Executable Statements ..
Write (nout,*) 'H02BZF Example Program Results'
! Skip heading in data file
Read (nin,*)
Read (nin,*) n, m
lda = m
Allocate (a(lda,n),bl(n+m),bu(n+m),clamda(n+m),cvec(n),x(n),intvar(n), &
istate(n+m),names(n+m))
Read (nin,*) itmax, msglvl
Read (nin,*) maxnod
Read (nin,*) intfst, maxdpt
Read (nin,*) tolfes, toliv
Read (nin,*) cvec(1:n)
Read (nin,*)(names(j),a(1:m,j),j=1,n)
Read (nin,*) bigbnd
Read (nin,*) bl(1:n)
Read (nin,*)(names(n+i),bl(n+i),i=1,m)
Read (nin,*) bu(1:n+m)
Read (nin,*) intvar(1:n)
Read (nin,*) x(1:n)
liwork = (25+n+m)*maxdpt + 5*n + m + 4
lrwork = maxdpt*(n+1) + 2*min(n,m+1)**2 + 14*n + 12*m
Allocate (iwork(liwork),rwork(lrwork))
! Solve the IP problem using H02BBF
ifail = -1
Call h02bbf(itmax,msglvl,n,m,a,lda,bl,bu,intvar,cvec,maxnod,intfst, &
maxdpt,toliv,tolfes,bigbnd,x,objmip,iwork,liwork,rwork,lrwork,ifail)
Select Case (ifail)
Case (0,7,9)
Write (nout,99999) 'IP objective value = ', objmip
! Get information about the solution
ifail = 0
Call h02bzf(n,m,bl,bu,clamda,istate,iwork,liwork,rwork,lrwork,ifail)
! Print the solution
Call outsol(n,m,a,lda,bl,bu,x,istate,clamda,bigbnd,names,nout)
! Increase the energy requirements and solve the modified IP
! problem using the current IP solution as the starting point
inival = bl(n+1)
Read (nin,*) bl(n+1)
Write (nout,99998) 'Increase the energy requirements from', inival, &
'to', bl(n+1)
ifail = -1
Call h02bbf(itmax,msglvl,n,m,a,lda,bl,bu,intvar,cvec,maxnod,intfst, &
maxdpt,toliv,tolfes,bigbnd,x,objmip,iwork,liwork,rwork,lrwork,ifail)
Select Case (ifail)
Case (0,7,9)
Write (nout,99999) 'IP objective value = ', objmip
! Get information about the solution
ifail = 0
Call h02bzf(n,m,bl,bu,clamda,istate,iwork,liwork,rwork,lrwork,ifail)
! Print the solution
Call outsol(n,m,a,lda,bl,bu,x,istate,clamda,bigbnd,names,nout)
End Select
End Select
99999 Format (/,/,1X,A,1P,G16.4)
99998 Format (/,/,1X,A,1X,1P,G11.4,2X,A,1X,1P,G11.4)
End Program h02bzfe