Program h02ccfe

!     H02CCF Example Program Text

!     Mark 30.1 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: e04nfu, h02cbf, h02cbu, h02ccf, h02cdf, nag_wp,   &
                             x04abf, x04acf, x04baf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: iset = 1, lintvr = 1, mdepth = 30,   &
                                          nin = 5, ninopt = 7, nout = 6
      Character (*), Parameter         :: fname = 'h02ccfe.opt'
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: obj
      Integer                          :: i, ifail, inform, j, lda, ldh,       &
                                          liwork, lwork, mode, n, nclin,       &
                                          outchn, strtgy
      Character (80)                   :: rec
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: a(:,:), ax(:), bl(:), bu(:),         &
                                          clamda(:), cvec(:), h(:,:), work(:), &
                                          x(:)
      Integer, Allocatable             :: intvar(:), istate(:), iwork(:)
!     .. Executable Statements ..
      Write (rec,99996) 'H02CCF Example Program Results'
      Call x04baf(nout,rec)

!     Skip heading in data file
      Read (nin,*)

      Read (nin,*) n, nclin
      lda = nclin
      ldh = n

      liwork = 2*n + 3 + 2*mdepth

!     LWRK for default problem-type QP2

      If (nclin==0) Then
        lwork = n**2 + 9*n + 4*mdepth
      Else
        lwork = 2*n**2 + 9*n + 5*nclin + 4*mdepth
      End If

      Allocate (a(lda,n),ax(nclin),bl(n+nclin),bu(n+nclin),clamda(n+nclin),    &
        cvec(n),h(ldh,n),x(n+nclin),intvar(lintvr),istate(n+nclin),            &
        iwork(liwork),work(lwork))

      Read (nin,*)(cvec(i),i=1,n)
      Read (nin,*)((a(i,j),j=1,n),i=1,nclin)
      Read (nin,*)(bl(i),i=1,n+nclin)
      Read (nin,*)(bu(i),i=1,n+nclin)
      Read (nin,*)(x(i),i=1,n)
      Read (nin,*)((h(i,j),j=1,n),i=1,n)

!     Set four options using H02CDF

      Call h02cdf(' Print Level = 1 ')

      Call h02cdf(' Check Frequency = 10 ')

      Call h02cdf(' Crash Tolerance = 0.05 ')

      Call h02cdf(' Infinite Bound Size = 1.0D+25 ')

!     Set the unit number for advisory messages to OUTCHN

      outchn = nout

      Call x04abf(iset,outchn)

!     Open the options file for reading

      mode = 0

      ifail = 0
      Call x04acf(ninopt,fname,mode,ifail)

!     Read the options file for the remaining options

      Call h02ccf(ninopt,inform)

      If (inform/=0) Then
        Write (rec,99997) 'H02CCF terminated with INFORM = ', inform
        Call x04baf(nout,rec)
        Go To 100
      End If

      strtgy = 2
      intvar(1) = 4

      Call h02cdf('Nolist')

      Call h02cdf('Print Level = 0')

!     Solve the problem

      ifail = 0
      Call h02cbf(n,nclin,a,lda,bl,bu,cvec,h,ldh,e04nfu,intvar,lintvr,mdepth,  &
        istate,x,obj,ax,clamda,strtgy,iwork,liwork,work,lwork,h02cbu,ifail)

!     Print out the best integer solution found

      Write (rec,'()')
      Call x04baf(nout,rec)
      Write (rec,'()')
      Call x04baf(nout,rec)
      Write (rec,99999) obj
      Call x04baf(nout,rec)
      Call x04baf(nout,' Components are ')

      Do i = 1, n
        Write (rec,99998) i, x(i)
        Call x04baf(nout,rec)
      End Do

100   Continue

99999 Format (1X,'Optimal Integer Value is = ',E20.8)
99998 Format (1X,'X(',I3,') = ',F15.8)
99997 Format (A,I5)
99996 Format (1X,A)
    End Program h02ccfe