PROGRAM h02ccfe

!      H02CCF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. 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 20
       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

20     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