! E04HCF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE e04hcfe_mod ! E04HCF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: liw = 1, n = 4, nout = 6 INTEGER, PARAMETER :: lw = 3*n CONTAINS SUBROUTINE funct(iflag,n,xc,fc,gc,iw,liw,w,lw) ! Routine to evaluate objective function and its 1st derivatives. ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (OUT) :: fc INTEGER, INTENT (INOUT) :: iflag INTEGER, INTENT (IN) :: liw, lw, n ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (OUT) :: gc(n) REAL (KIND=nag_wp), INTENT (INOUT) :: w(lw) REAL (KIND=nag_wp), INTENT (IN) :: xc(n) INTEGER, INTENT (INOUT) :: iw(liw) ! .. Executable Statements .. fc = (xc(1)+10.0_nag_wp*xc(2))**2 + 5.0_nag_wp*(xc(3)-xc(4))**2 + & (xc(2)-2.0_nag_wp*xc(3))**4 + 10.0_nag_wp*(xc(1)-xc(4))**4 gc(1) = 2.0_nag_wp*(xc(1)+10.0_nag_wp*xc(2)) + & 40.0_nag_wp*(xc(1)-xc(4))**3 gc(2) = 20.0_nag_wp*(xc(1)+10.0_nag_wp*xc(2)) + & 4.0_nag_wp*(xc(2)-2.0_nag_wp*xc(3))**3 gc(3) = 10.0_nag_wp*(xc(3)-xc(4)) - 8.0_nag_wp*(xc(2)-2.0_nag_wp*xc( & 3))**3 gc(4) = 10.0_nag_wp*(xc(4)-xc(3)) - 40.0_nag_wp*(xc(1)-xc(4))**3 RETURN END SUBROUTINE funct END MODULE e04hcfe_mod PROGRAM e04hcfe ! E04HCF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : e04hcf, nag_wp USE e04hcfe_mod, ONLY : funct, liw, lw, n, nout ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: f INTEGER :: ifail ! .. Local Arrays .. REAL (KIND=nag_wp) :: g(n), w(lw), x(n) INTEGER :: iw(liw) ! .. Executable Statements .. WRITE (nout,*) 'E04HCF Example Program Results' ! Set up an arbitrary point at which to check the 1st derivatives x(1:n) = (/ 1.46_nag_wp, -0.82_nag_wp, 0.57_nag_wp, 1.21_nag_wp/) WRITE (nout,*) WRITE (nout,*) 'The test point is' WRITE (nout,99999) x(1:n) ifail = -1 CALL e04hcf(n,funct,x,f,g,iw,liw,w,lw,ifail) IF (ifail>=0) THEN WRITE (nout,*) IF (ifail==0) THEN WRITE (nout,*) & '1st derivatives are consistent with function values' ELSE WRITE (nout,*) 'Probable error in calculation of 1st derivatives' END IF WRITE (nout,*) WRITE (nout,99998) & 'At the test point, FUNCT gives the function value', f WRITE (nout,*) 'and the 1st derivatives' WRITE (nout,99997) g(1:n) END IF 99999 FORMAT (1X,4F10.4) 99998 FORMAT (1X,A,1P,E12.4) 99997 FORMAT (1X,1P,4E12.3) END PROGRAM e04hcfe