! E04JCF Example Program Text ! Mark 24 Release. NAG Copyright 2012. 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) ! .. 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) ! .. 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