! E04AB_P0W_F Example Program Text
! Mark 30.3 Release. NAG Copyright 2024.
Module e04ab_p0w_fe_mod
! E04AB_P0W_F 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 :: funct
! .. Parameters ..
Integer, Parameter, Public :: nout = 6
! .. Local Scalars ..
Real (Kind=nag_wp), Public, Save :: t
Contains
Subroutine funct(ad_handle,xc,fc,iuser,ruser)
! Routine to evaluate F(x) at any point in (A, B)
! .. Scalar Arguments ..
Type (c_ptr), Intent (Inout) :: ad_handle
Real (Kind=nag_wp), Intent (Out) :: fc
Real (Kind=nag_wp), Intent (In) :: xc
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
Integer, Intent (Inout) :: iuser(*)
! .. Intrinsic Procedures ..
Intrinsic :: sin
! .. Executable Statements ..
fc = sin(t*xc)/(xc)
Return
End Subroutine funct
End Module e04ab_p0w_fe_mod
Program e04ab_p0w_fe
! E04AB_P0W_F Example Main Program
! .. Use Statements ..
Use e04ab_p0w_fe_mod, Only: funct, nout, t
Use iso_c_binding, Only: c_ptr
Use nagad_library, Only: e04ab_p0w_f
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Type (c_ptr) :: ad_handle
Real (Kind=nag_wp) :: a, b, e1, e2, f, x
Integer :: ifail, maxcal
! .. Local Arrays ..
Real (Kind=nag_wp) :: ruser(1)
Integer :: iuser(1)
! .. Executable Statements ..
Write (nout,*) 'E04AB_P0W_F Example Program Results'
e1 = 0.0_nag_wp
e2 = 0.0_nag_wp
! The minimum is known to lie in the range (3.5, 5.0)
a = 3.5_nag_wp
b = 5.0_nag_wp
t = 1.0_nag_wp
! Allow 30 calls of FUNCT
maxcal = 30
ifail = -1
Call e04ab_p0w_f(ad_handle,funct,e1,e2,a,b,maxcal,x,f,iuser,ruser,ifail)
Select Case (ifail)
Case (0,2)
Write (nout,*)
Write (nout,99999) 'The minimum lies in the interval', a, ' to', b
Write (nout,99999) 'Its estimated position is ', x, ','
Write (nout,99998) 'where the function value is ', f
Write (nout,99997) maxcal, 'function evaluations were required'
Case (:-1)
Write (nout,99996) 'Routine e04ab_p0w_f failed with ifail = ', ifail
End Select
99999 Format (1X,A,F11.8,A,F11.8)
99998 Format (1X,A,F7.4)
99997 Format (1X,I2,1X,A)
99996 Format (/,1X,A,I0)
End Program e04ab_p0w_fe