! H02BZF Example Program Text ! Mark 24 Release. NAG Copyright 2012. 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 ! .. Parameters .. Integer, Parameter :: 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 nag_library, Only: h02bbf, h02bzf, nag_wp Use h02bzfe_mod, Only: nin, nout, outsol ! .. 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