! E04CBF Example Program Text
! Mark 30.3 Release. nAG Copyright 2024.
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
! .. Accessibility Statements ..
Private
Public :: funct, monit
! .. Parameters ..
Integer, Parameter, Public :: 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 e04cbfe_mod, Only: funct, monit, nout
Use nag_library, Only: e04cbf, e04cbk, nag_wp, x02ajf
! .. 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