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