! D01ATF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
Module d01atfe_mod
! D01ATF 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 :: f
! .. Parameters ..
Integer, Parameter, Public :: lw = 800, nout = 6
Integer, Parameter, Public :: liw = lw/4
! .. Local Scalars ..
Real (Kind=nag_wp), Public, Save :: pi
Contains
Subroutine f(x,fv,n)
! .. Scalar Arguments ..
Integer, Intent (In) :: n
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Out) :: fv(n)
Real (Kind=nag_wp), Intent (In) :: x(n)
! .. Intrinsic Procedures ..
Intrinsic :: sin, sqrt
! .. Executable Statements ..
fv(1:n) = x(1:n)*sin(30.0E0_nag_wp*x(1:n))/sqrt(1.0E0_nag_wp-x(1:n)**2 &
/(4.0E0_nag_wp*pi**2))
Return
End Subroutine f
End Module d01atfe_mod
Program d01atfe
! D01ATF Example Main Program
! .. Use Statements ..
Use d01atfe_mod, Only: f, liw, lw, nout, pi
Use nag_library, Only: d01atf, nag_wp, x01aaf
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Real (Kind=nag_wp) :: a, abserr, b, epsabs, epsrel, result
Integer :: ifail
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: w(:)
Integer, Allocatable :: iw(:)
! .. Executable Statements ..
Write (nout,*) 'D01ATF Example Program Results'
Allocate (w(lw),iw(liw))
pi = x01aaf(pi)
epsabs = 0.0_nag_wp
epsrel = 1.0E-04_nag_wp
a = 0.0_nag_wp
b = 2.0_nag_wp*pi
ifail = -1
Call d01atf(f,a,b,epsabs,epsrel,result,abserr,w,lw,iw,liw,ifail)
If (ifail>=0) Then
Write (nout,*)
Write (nout,99999) 'A ', 'lower limit of integration', a
Write (nout,99999) 'B ', 'upper limit of integration', b
Write (nout,99998) 'EPSABS', 'absolute accuracy requested', epsabs
Write (nout,99998) 'EPSREL', 'relative accuracy requested', epsrel
End If
If (ifail>=0 .And. ifail<=5) Then
Write (nout,*)
Write (nout,99997) 'RESULT', 'approximation to the integral', result
Write (nout,99998) 'ABSERR', 'estimate of the absolute error', abserr
Write (nout,99996) 'IW(1) ', 'number of subintervals used', iw(1)
End If
99999 Format (1X,A6,' - ',A30,' = ',F10.4)
99998 Format (1X,A6,' - ',A30,' = ',E9.2)
99997 Format (1X,A6,' - ',A30,' = ',F9.5)
99996 Format (1X,A6,' - ',A30,' = ',I4)
End Program d01atfe