! E04JCF Example Program Text
! Mark 30.3 Release. nAG Copyright 2024.
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
! .. Accessibility Statements ..
Private
Public :: monfun, objfun
! .. Parameters ..
Integer, Parameter, Public :: 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(*)
! .. Local Scalars ..
Logical :: verbose_output
! .. Executable Statements ..
inform = 0
Write (nout,Fmt=99999) 'Monitoring: new trust region radius =', rho
! Set this to .True. to get more detailed output
verbose_output = .False.
If (verbose_output) Then
Write (nout,Fmt=99998) 'Number of function calls =', nf
Write (nout,Fmt=99997) 'Current function value =', f
Write (nout,Fmt=99996) 'The corresponding X is:', x(1:n)
End If
Return
99999 Format (/,4X,A,1P,E13.3)
99998 Format (4X,A,I16)
99997 Format (4X,A,1P,E12.4)
99996 Format (4X,A,/,(4X,5E12.4))
End Subroutine monfun
End Module e04jcfe_mod
Program e04jcfe
! Example problem for E04JCF.
! .. Use Statements ..
Use e04jcfe_mod, Only: monfun, nout, objfun
Use nag_library, Only: e04jcf, nag_wp, x02alf
! .. 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/)
ifail = -1
Call e04jcf(objfun,n,npt,x,bl,bu,rhobeg,rhoend,monfun,maxcal,f,nf,iuser, &
ruser,ifail)
Select Case (ifail)
Case (0,2:5)
If (ifail==0) Then
Write (nout,Fmt=99999) 'Successful exit from E04JCF.', &
'Function value at lowest point found =', f
Else
Write (nout,Fmt=99998) &
'On exit from E04JCF, function value at lowest point found =', f
End If
Write (nout,Fmt=99997) 'The corresponding X is:', x(1:n)
End Select
99999 Format (2(/,1X,A),1P,E13.3)
99998 Format (/,1X,A,1P,E13.3)
99997 Format (1X,A,/,(2X,5E13.3))
End Program e04jcfe