Program d04bafe
! D04BAF Example Program Text
! Mark 30.0 Release. NAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: d04baf, d04bbf, nag_wp, s14aef
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Real (Kind=nag_wp), Parameter :: x_0 = 0.05_nag_wp
Integer, Parameter :: nout = 6, n_der_comp = 3, &
n_display = 3, n_hbase = 4, &
zeroth = 0
! .. Local Scalars ..
Real (Kind=nag_wp) :: hbase
Integer :: ifail, j, k
! .. Local Arrays ..
Real (Kind=nag_wp) :: actder(n_display), der(14), &
der_comp(n_hbase,n_der_comp,14), &
erest(14), fval(21), xval(21)
! .. Executable Statements ..
Write (nout,*) 'D04BAF Example Program Results'
Write (nout,*)
Write (nout,*) ' Find the derivatives of the polygamma (psi) function'
Write (nout,*) ' using function values generated by S14AEF.'
Write (nout,*)
Write (nout,*) ' Demonstrate the effect of successively reducing HBASE.'
Write (nout,*)
! Select an initial separation distance HBASE.
hbase = 0.0025_nag_wp
! Compute the actual derivatives at target location x_0 using s14aef for
! comparison.
Do j = 1, n_display
ifail = 0
actder(j) = s14aef(x_0,j,ifail)
End Do
! Attempt N_HBASE approximations, reducing HBASE by factor 0.1 each time.
Do j = 1, n_hbase
! Generate the abscissa XVAL using D04BBF
Call d04bbf(x_0,hbase,xval)
! Calculate the corresponding objective function values.
Do k = 1, 21
ifail = 0
fval(k) = s14aef(xval(k),zeroth,ifail)
End Do
! Call D04BAF to calculate the derivative estimates
ifail = 0
Call d04baf(xval,fval,der,erest,ifail)
! Store results in DER_COMP
der_comp(j,1,1:14) = hbase
der_comp(j,2,1:14) = der(1:14)
der_comp(j,3,1:14) = erest(1:14)
! Decrease hbase for next loop
hbase = hbase*0.1_nag_wp
End Do
! Display Results for first N_DISPLAY derivatives
Do j = 1, n_display
Write (nout,99999) j, actder(j)
Write (nout,99998) j
Write (nout,99997) j, j
Do k = 1, n_hbase
Write (nout,99996) der_comp(k,1,j), der_comp(k,2,j), der_comp(k,3,j)
End Do
Write (nout,*)
End Do
99999 Format (1X,' Derivative (',I1,') calculated using S14AEF :',1X,Es11.4)
99998 Format (1X,' Derivative and error estimates for derivative (',I1,')')
99997 Format (10X,'hbase DER(',I1,') EREST(',I1,')')
99996 Format (1X,1P,E14.4,E13.4,E13.1)
End Program d04bafe