! H02CEF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE h02cefe_mod ! H02CEF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. REAL (KIND=nag_wp), PARAMETER :: cutoff = -1847510.0_nag_wp INTEGER, PARAMETER :: lintvr = 10, mdepth = 2000, & nin = 5, nout = 6 CONTAINS SUBROUTINE qphx(nstate,ncolh,x,hx) ! Routine to compute H*x. (In this version of QPHX, the Hessian ! matrix H is not referenced explicitly.) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. INTEGER, INTENT (IN) :: ncolh, nstate ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (OUT) :: hx(ncolh) REAL (KIND=nag_wp), INTENT (IN) :: x(ncolh) ! .. Executable Statements .. hx(1) = 2.0_nag_wp*x(1) hx(2) = 2.0_nag_wp*x(2) hx(3) = 2.0_nag_wp*(x(3)+x(4)) hx(4) = hx(3) hx(5) = 2.0_nag_wp*x(5) hx(6) = 2.0_nag_wp*(x(6)+x(7)) hx(7) = hx(6) RETURN END SUBROUTINE qphx SUBROUTINE monit(intfnd,nodes,depth,obj,x,bstval,bstsol,bl,bu,n,halt, & count) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (INOUT) :: bstval REAL (KIND=nag_wp), INTENT (IN) :: obj INTEGER, INTENT (INOUT) :: count INTEGER, INTENT (IN) :: depth, intfnd, n, nodes LOGICAL, INTENT (INOUT) :: halt ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: bl(n), bstsol(n), bu(n), x(n) ! .. Executable Statements .. IF (intfnd==0) THEN bstval = cutoff END IF RETURN END SUBROUTINE monit END MODULE h02cefe_mod PROGRAM h02cefe ! H02CEF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : h02cef, h02cgf, nag_wp USE h02cefe_mod, ONLY : lintvr, mdepth, monit, nin, nout, qphx ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: obj INTEGER :: i, icol, ifail, iobj, jcol, & leniz, lenz, m, miniz, minz, n, & ncolh, nname, nnz, ns, strtgy CHARACTER (1) :: start ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: a(:), bl(:), bu(:), clamda(:), & xs(:), z(:) INTEGER, ALLOCATABLE :: ha(:), intvar(:), istate(:), & iz(:), ka(:) CHARACTER (8), ALLOCATABLE :: crname(:) CHARACTER (8) :: names(5) ! .. Executable Statements .. WRITE (nout,*) 'H02CEF Example Program Results' ! Skip heading in data file. READ (nin,*) READ (nin,*) n, m READ (nin,*) nnz, iobj, ncolh, start, nname ALLOCATE (a(nnz),bl(n+m),bu(n+m),clamda(n+m),xs(n+m),ha(nnz), & intvar(lintvr),istate(n+m),ka(n+1),crname(nname)) READ (nin,*) names(1:5) READ (nin,*) crname(1:nname) ! Read the matrix A from data file. Set up KA. jcol = 1 ka(jcol) = 1 DO i = 1, nnz ! Element ( HA( I ), ICOL ) is stored in A( I ). READ (nin,*) a(i), ha(i), icol IF (icol==jcol+1) THEN ! Index in A of the start of the ICOL-th column equals I. ka(icol) = i jcol = icol ELSE IF (icol>jcol+1) THEN ! Index in A of the start of the ICOL-th column equals I, ! but columns JCOL+1,JCOL+2,...,ICOL-1 are empty. Set the ! corresponding elements of KA to I. ka((jcol+1):(icol-1)) = i ka(icol) = i jcol = icol END IF END DO ka(n+1) = nnz + 1 READ (nin,*) bl(1:n+m) READ (nin,*) bu(1:n+m) READ (nin,*) istate(1:n) READ (nin,*) xs(1:n) strtgy = 3 intvar(1:7) = (/ 2, 3, 4, 5, 6, 7, -1/) CALL h02cgf('NoList') CALL h02cgf('Print Level = 0') ! Solve the QP problem. ! First call is a workspace query leniz = 1 lenz = 1 ALLOCATE (iz(leniz),z(lenz)) ifail = 1 CALL h02cef(n,m,nnz,iobj,ncolh,qphx,a,ha,ka,bl,bu,start,names,nname, & crname,ns,xs,intvar,lintvr,mdepth,istate,miniz,minz,obj,clamda, & strtgy,iz,leniz,z,lenz,monit,ifail) IF (ifail/=14) THEN WRITE (nout,99998) ifail ELSE DEALLOCATE (iz,z) leniz = miniz lenz = minz ALLOCATE (iz(leniz),z(lenz)) ifail = 0 CALL h02cef(n,m,nnz,iobj,ncolh,qphx,a,ha,ka,bl,bu,start,names,nname, & crname,ns,xs,intvar,lintvr,mdepth,istate,miniz,minz,obj,clamda, & strtgy,iz,leniz,z,lenz,monit,ifail) ! Print out the best integer solution found WRITE (nout,99999) obj, (i,xs(i),i=1,n) END IF 99999 FORMAT (' Optimal Integer Value is = ',E20.8/' Components are '/(' X(', & I3,') = ',F10.2)) 99998 FORMAT (1X,'** Workspace query in H02CEF exited with IFAIL = ',I0) END PROGRAM h02cefe