!   H02BZF Example Program Text
!   Mark 30.3 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