! E05KBF Example Program Text
! Mark 30.0 Release. NAG Copyright 2024.
Module e05kbfe_mod
! E05KBF Example Program Module:
! Parameters and User-defined Routines
! .. Use Statements ..
Use iso_c_binding, Only: c_ptr
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: objfun
! .. Parameters ..
Integer, Parameter, Public :: nout = 6
Contains
Subroutine objfun(nvar,x,f,inform,iuser,ruser,cpuser)
! Routine to evaluate E05KBF objective function.
! .. Scalar Arguments ..
Type (c_ptr), Intent (In) :: cpuser
Real (Kind=nag_wp), Intent (Out) :: f
Integer, Intent (Inout) :: inform
Integer, Intent (In) :: nvar
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
Real (Kind=nag_wp), Intent (In) :: x(nvar)
Integer, Intent (Inout) :: iuser(*)
! .. Local Scalars ..
Real (Kind=nag_wp) :: x1, x2
! .. Intrinsic Procedures ..
Intrinsic :: exp
! .. Executable Statements ..
! This is a two-dimensional objective function.
! As an example of using the inform mechanism,
! terminate if any other problem size is supplied.
If (nvar/=2) Then
inform = -1
Else
inform = 0
If (inform>=0) Then
! If INFORM>=0 then we're prepared to evaluate OBJFUN
! at the current X
x1 = x(1)
x2 = x(2)
f = 3.0E0_nag_wp*(1.0E0_nag_wp-x1)**2*exp(-(x1**2)-(x2+ &
1.0E0_nag_wp)**2) - 1.0E1_nag_wp*(x1/5.0E0_nag_wp-x1**3-x2**5)* &
exp(-x1**2-x2**2) - 1.0E0_nag_wp/3.0E0_nag_wp*exp(-(x1+ &
1.0E0_nag_wp)**2-x2**2)
End If
End If
Return
End Subroutine objfun
End Module e05kbfe_mod
Program e05kbfe
! E05KBF Example Main Program
! .. Use Statements ..
Use e05kbfe_mod, Only: nout, objfun
Use iso_c_binding, Only: c_null_ptr, c_ptr
Use nag_library, Only: e04kfu, e04raf, e04rgf, e04rhf, e04rzf, e04zmf, &
e05kbf, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nvar = 2
! .. Local Scalars ..
Type (c_ptr) :: cpuser, handle
Integer :: i, ifail
! .. Local Arrays ..
Real (Kind=nag_wp) :: bl(nvar), bu(nvar), rinfo(100), &
ruser(1), stats(100), x(nvar)
Integer :: iidx(nvar), iuser(1)
! .. Executable Statements ..
cpuser = c_null_ptr
Write (nout,*) 'E05KBF Example Program Results'
! Initialize handle
ifail = 0
Call e04raf(handle,nvar,ifail)
! Define Simple box bounds
bl(1:nvar) = (/-3.0_nag_wp,-3.0_nag_wp/)
bu(1:nvar) = (/3.0_nag_wp,3.0_nag_wp/)
ifail = 0
Call e04rhf(handle,nvar,bl,bu,ifail)
! Add nonlinear objective information
iidx(1:nvar) = (/(i,i=1,nvar)/)
ifail = 0
Call e04rgf(handle,nvar,iidx,ifail)
! Add options
ifail = 0
Call e04zmf(handle,'Print Level = 1',ifail)
! Solve the problem.
ifail = 0
Call e05kbf(handle,objfun,e04kfu,nvar,x,rinfo,stats,iuser,ruser,cpuser, &
ifail)
! Clean up
ifail = 0
Call e04rzf(handle,ifail)
End Program e05kbfe