! E04JCF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE e04jcfe_mod ! E04JCF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nout = 6 CONTAINS SUBROUTINE objfun(n,x,f,iuser,ruser,inform) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. REAL (KIND=nag_wp), PARAMETER :: five = 5.0_nag_wp REAL (KIND=nag_wp), PARAMETER :: ten = 1.0E1_nag_wp REAL (KIND=nag_wp), PARAMETER :: two = 2.0_nag_wp ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (OUT) :: f INTEGER, INTENT (OUT) :: inform INTEGER, INTENT (IN) :: n ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (INOUT) :: ruser(*) REAL (KIND=nag_wp), INTENT (IN) :: x(n) INTEGER, INTENT (INOUT) :: iuser(*) ! .. Executable Statements .. inform = 0 f = (x(1)+ten*x(2))**2 + five*(x(3)-x(4))**2 + (x(2)-two*x(3))**4 + & ten*(x(1)-x(4))**4 RETURN END SUBROUTINE objfun SUBROUTINE monfun(n,nf,x,f,rho,iuser,ruser,inform) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: f, rho INTEGER, INTENT (OUT) :: inform INTEGER, INTENT (IN) :: n, nf ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (INOUT) :: ruser(*) REAL (KIND=nag_wp), INTENT (IN) :: x(n) INTEGER, INTENT (INOUT) :: iuser(*) ! .. Executable Statements .. inform = 0 WRITE (nout,FMT='(/4X,A,1P,E13.5,A,I16)') 'New RHO =', rho, & ', number of function evaluations =', nf WRITE (nout,FMT='(4X,A,1P,E13.5)') 'Current function value =', f WRITE (nout,FMT='(4X,A,/(4X,5E13.5))') 'The corresponding X is:', & x(1:n) RETURN END SUBROUTINE monfun END MODULE e04jcfe_mod PROGRAM e04jcfe ! Example problem for E04JCF. ! .. Use Statements .. USE nag_library, ONLY : e04jcf, e04jcp, nag_wp, x02alf USE e04jcfe_mod, ONLY : nout, objfun ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: f, infbnd, rhobeg, rhoend INTEGER :: ifail, maxcal, n, nf, npt ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: bl(:), bu(:), x(:) REAL (KIND=nag_wp) :: ruser(1) INTEGER :: iuser(1) ! .. Executable Statements .. WRITE (nout,*) 'E04JCF Example Program Results' maxcal = 500 rhobeg = 1.0E-1_nag_wp rhoend = 1.0E-6_nag_wp n = 4 npt = 2*n + 1 ! x(3) is unconstrained, so we're going to set bl(3) to a large ! negative number and bu(3) to a large positive number. infbnd = x02alf()**0.25_nag_wp ALLOCATE (bl(n),bu(n),x(n)) bl(1:n) = (/ 1.0_nag_wp, -2.0_nag_wp, -infbnd, 1.0_nag_wp/) bu(1:n) = (/ 3.0_nag_wp, 0.0_nag_wp, infbnd, 3.0_nag_wp/) x(1:n) = (/ 3.0_nag_wp, -1.0_nag_wp, 0.0_nag_wp, 1.0_nag_wp/) ! USE monfun from e04jcfe_mod and pass this to e04jcf instead ! of e04jcp to enable monitoring output ifail = -1 CALL e04jcf(objfun,n,npt,x,bl,bu,rhobeg,rhoend,e04jcp,maxcal,f,nf, & iuser,ruser,ifail) SELECT CASE (ifail) CASE (0,2:5) IF (ifail==0) THEN WRITE (nout,FMT='(2(/1X,A),1P,E13.5)') & 'Successful exit from E04JCF.', & 'Function value at lowest point found =', f ELSE WRITE (nout,FMT='(/1X,A,1P,E13.5)') & 'On exit from E04JCF, function value at lowest point found =', & f END IF WRITE (nout,FMT='(1X,A,/(2X,5E13.5))') 'The corresponding X is:', & x(1:n) END SELECT END PROGRAM e04jcfe