! E04CBF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module e04cbfe_mod ! E04CBF 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 funct(n,xc,fc,iuser,ruser) ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (Out) :: fc Integer, Intent (In) :: n ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Inout) :: ruser(*) Real (Kind=nag_wp), Intent (In) :: xc(n) Integer, Intent (Inout) :: iuser(*) ! .. Intrinsic Procedures .. Intrinsic :: exp ! .. Executable Statements .. fc = exp(xc(1))*(4.0_nag_wp*xc(1)*(xc(1)+xc(2))+2.0_nag_wp*xc(2)*(xc(2 & )+1.0_nag_wp)+1.0_nag_wp) Return End Subroutine funct Subroutine monit(fmin,fmax,sim,n,ncall,serror,vratio,iuser,ruser) ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: fmax, fmin, serror, vratio Integer, Intent (In) :: n, ncall ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Inout) :: ruser(*) Real (Kind=nag_wp), Intent (In) :: sim(n+1,n) Integer, Intent (Inout) :: iuser(*) ! .. Executable Statements .. Write (nout,*) Write (nout,99999) ncall Write (nout,99998) fmin Write (nout,99997) Write (nout,99996) sim(1:(n+1),1:n) Write (nout,99995) serror Write (nout,99994) vratio Return 99999 Format (1X,'There have been',I5,' function calls') 99998 Format (1X,'The smallest function value is',F10.4) 99997 Format (1X,'The simplex is') 99996 Format (1X,2F10.4) 99995 Format (1X,'The standard deviation in function values at the ', & 'vertices of the simplex is',F10.4) 99994 Format (1X,'The linearized volume ratio of the current simplex', & ' to the starting one is',F10.4) End Subroutine monit End Module e04cbfe_mod Program e04cbfe ! E04CBF Example Main Program ! .. Use Statements .. Use nag_library, Only: e04cbf, e04cbk, nag_wp, x02ajf Use e04cbfe_mod, Only: funct, monit, nout ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: n = 2 ! .. Local Scalars .. Real (Kind=nag_wp) :: f, tolf, tolx Integer :: ifail, maxcal Logical :: monitoring ! .. Local Arrays .. Real (Kind=nag_wp) :: ruser(1), x(n) Integer :: iuser(1) ! .. Intrinsic Procedures .. Intrinsic :: sqrt ! .. Executable Statements .. Write (nout,*) 'E04CBF Example Program Results' ! Set MONITORING to .TRUE. to obtain monitoring information monitoring = .False. x(1:n) = (/-1.0_nag_wp,1.0_nag_wp/) tolf = sqrt(x02ajf()) tolx = sqrt(tolf) maxcal = 100 ifail = 0 If (.Not. monitoring) Then Call e04cbf(n,x,f,tolf,tolx,funct,e04cbk,maxcal,iuser,ruser,ifail) Else Call e04cbf(n,x,f,tolf,tolx,funct,monit,maxcal,iuser,ruser,ifail) End If Write (nout,*) Write (nout,99999) f Write (nout,99998) x(1:n) 99999 Format (1X,'The final function value is',F12.4) 99998 Format (1X,'at the point',2F12.4) End Program e04cbfe