! H02BZF Example Program Text ! Mark 23 Release. NAG Copyright 2011. 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 ! .. Implicit None Statement .. IMPLICIT NONE ! .. 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 Functions .. 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 Functions .. 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