! D02UYF Example Program Text
! Mark 30.2 Release. NAG Copyright 2024.
Module d02uyfe_mod
! D02UYF 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 :: exact
! .. Parameters ..
Real (Kind=nag_wp), Parameter, Public :: a = -1.0_nag_wp
Real (Kind=nag_wp), Parameter, Public :: b = 3.0_nag_wp
Integer, Parameter, Public :: nin = 5, nout = 6
Logical, Parameter, Public :: reqerr = .False., reqwgt = .False.
Contains
Function exact(x)
! .. Function Return Value ..
Real (Kind=nag_wp) :: exact
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: x
! .. Executable Statements ..
exact = 3.0_nag_wp*x**2
Return
End Function exact
End Module d02uyfe_mod
Program d02uyfe
! D02UYF Example Main Program
! .. Use Statements ..
Use d02uyfe_mod, Only: a, b, exact, nin, nout, reqerr, reqwgt
Use nag_library, Only: d02ucf, d02uyf, ddot, nag_wp, x02ajf
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Real (Kind=nag_wp) :: integ, scale, uerr
Integer :: i, ifail, iu, n
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: f(:), w(:), x(:)
! .. Intrinsic Procedures ..
Intrinsic :: abs, int
! .. Executable Statements ..
Write (nout,*) ' D02UYF Example Program Results '
Write (nout,*)
Read (nin,*)
Read (nin,*) n
Allocate (f(n+1),w(n+1),x(n+1))
! Set up solution grid
ifail = 0
Call d02ucf(n,a,b,x,ifail)
! Set up problem right hand sides for grid
Do i = 1, n + 1
f(i) = exact(x(i))
End Do
scale = 0.5_nag_wp*(b-a)
! Solve on equally spaced grid
ifail = 0
Call d02uyf(n,w,ifail)
! The NAG name equivalent of ddot is f06eaf
integ = ddot(n+1,w,1,f,1)*scale
! Print function values and weights if required
If (reqwgt) Then
Write (nout,*) ' f(x) and Integral weights'
Write (nout,*)
Write (nout,99999)
Write (nout,99998)(x(i),f(i),w(i),i=1,n+1)
End If
! Print approximation to integral
Write (nout,99996) a, b, integ
If (reqerr) Then
uerr = abs(integ-28.0_nag_wp)
iu = 10*(int(uerr/10.0_nag_wp/x02ajf())+1)
Write (nout,99997) iu
End If
99999 Format (1X,T8,'X',T18,'f(X)',T28,'W')
99998 Format (1X,3F10.4)
99997 Format (/,1X,'Integral is within a multiple ',I8, &
' of machine precision.')
99996 Format (/,1X,'Integral of f(x) from ',F6.1,' to ',F6.2,' = ',F13.5,'.', &
/)
End Program d02uyfe