! D02UDF Example Program Text
! Mark 30.2 Release. NAG Copyright 2024.
Module d02udfe_mod
! D02UDF 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 :: deriv, fcn
! .. Parameters ..
Real (Kind=nag_wp), Parameter, Public :: a = 0.0_nag_wp
Real (Kind=nag_wp), Parameter, Public :: b = 1.5_nag_wp
Real (Kind=nag_wp), Parameter :: one = 1.0_nag_wp
Integer, Parameter, Public :: nin = 5, nout = 6
Logical, Parameter, Public :: reqerr = .False.
Contains
Function fcn(x)
! .. Function Return Value ..
Real (Kind=nag_wp) :: fcn
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: x
! .. Intrinsic Procedures ..
Intrinsic :: exp
! .. Executable Statements ..
fcn = (one+one)*x + exp(-x)
Return
End Function fcn
Function deriv(x)
! .. Function Return Value ..
Real (Kind=nag_wp) :: deriv
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: x
! .. Intrinsic Procedures ..
Intrinsic :: exp
! .. Executable Statements ..
deriv = one + one - exp(-x)
Return
End Function deriv
End Module d02udfe_mod
Program d02udfe
! D02UDF Example Main Program
! .. Use Statements ..
Use d02udfe_mod, Only: a, b, deriv, fcn, nin, nout, reqerr
Use nag_library, Only: d02ucf, d02udf, nag_wp, x02ajf
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Real (Kind=nag_wp) :: scale, teneps, uxerr
Integer :: i, ifail, n
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: f(:), fd(:), x(:)
! .. Intrinsic Procedures ..
Intrinsic :: abs, int, max
! .. Executable Statements ..
Write (nout,*) ' D02UDF Example Program Results '
Write (nout,*)
Read (nin,*)
Read (nin,*) n
Allocate (f(n+1),fd(n+1),x(n+1))
! Set up solution grid
ifail = 0
Call d02ucf(n,a,b,x,ifail)
! Evaluate fcn on Chebyshev grid.
Do i = 1, n + 1
f(i) = fcn(x(i))
End Do
! Calculate derivative of fcn.
ifail = 0
Call d02udf(n,f,fd,ifail)
scale = 2.0_nag_wp/(b-a)
fd(1:n+1) = scale*fd(1:n+1)
! Print function and its derivative
Write (nout,*) ' Original Function F and numerical derivative Fx'
Write (nout,*)
Write (nout,99999)
Write (nout,99998)(x(i),f(i),fd(i),i=1,n+1)
If (reqerr) Then
uxerr = 0.0_nag_wp
Do i = 1, n + 1
uxerr = max(uxerr,abs(fd(i)-deriv(x(i))))
End Do
teneps = 100.0_nag_wp*x02ajf()
Write (nout,99997) 100*(int(uxerr/teneps)+1)
End If
99999 Format (1X,T8,'X',T18,'F',T28,'Fx')
99998 Format (1X,3F10.4)
99997 Format (1X,'Fx is within a multiple ',I8,' of machine precision.')
End Program d02udfe