! D01RK_P0W_F Example Program Text
! Mark 29.2 Release. NAG Copyright 2023.
Module d01rk_p0w_fe_mod
! .. Use Statements ..
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: f
! .. Parameters ..
Integer, Parameter, Public :: nout = 6
Contains
Subroutine f(ad_handle,x,nx,fv,iflag,iuser,ruser,cpuser)
! .. Use Statements ..
Use, Intrinsic :: iso_c_binding, Only: c_ptr
! .. Scalar Arguments ..
Type (c_ptr), Intent (Inout) :: ad_handle
Type (c_ptr), Intent (In) :: cpuser
Integer, Intent (Inout) :: iflag
Integer, Intent (In) :: nx
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (Out) :: fv(nx)
Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
Real (Kind=nag_wp), Intent (In) :: x(nx)
Integer, Intent (Inout) :: iuser(*)
! .. Intrinsic Procedures ..
Intrinsic :: cos, sin
! .. Executable Statements ..
fv = x*sin(ruser(1)*x)*cos(ruser(2)*x)
Return
End Subroutine f
End Module d01rk_p0w_fe_mod
Program d01rk_p0w_fe
! D01RK_P0W_F Example Main Program
! .. Use Statements ..
Use d01rk_p0w_fe_mod, Only: f, nout
Use, Intrinsic :: iso_c_binding, Only: c_null_ptr, &
c_ptr
Use nagad_library, Only: d01rk_p0w_f
Use nag_library, Only: nag_wp, x01aaf
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Type (c_ptr) :: ad_handle, cpuser
Real (Kind=nag_wp) :: a, abserr, b, epsabs, epsrel, pi, &
result
Integer :: ifail, key, liinfo, lrinfo, maxsub
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: rinfo(:)
Real (Kind=nag_wp) :: ruser(2)
Integer, Allocatable :: iinfo(:)
Integer :: iuser(1)
! .. Intrinsic Procedures ..
Intrinsic :: max
! .. Executable Statements ..
Write (nout,*) 'D01RK_P0W_F Example Program Results'
key = 6
pi = x01aaf(pi)
! Initialize passive types
a = 0.0_nag_wp
b = 2.0_nag_wp*pi
epsabs = 0.0_nag_wp
epsrel = 1.0E-4_nag_wp
maxsub = 20
lrinfo = 4*maxsub
liinfo = max(maxsub,4)
Allocate (rinfo(lrinfo),iinfo(liinfo))
iuser(1) = 0
ruser(1) = 30.0_nag_wp
ruser(2) = 1.0_nag_wp
cpuser = c_null_ptr
! Evaluate the integral using the passive routine
ifail = -1
Call d01rk_p0w_f(ad_handle,f,a,b,key,epsabs,epsrel,maxsub,result,abserr, &
rinfo,iinfo,iuser,ruser,cpuser,ifail)
If (ifail<0) Then
Write (nout,99999) 'The routine has failed with ifail = ', ifail
Go To 100
99999 Format (1X,A,I0)
End If
! Print inputs and primal outputs
Write (nout,*)
Write (nout,99998) 'a ', 'lower limit of integration', a
Write (nout,99998) 'b ', 'upper limit of integration', b
Write (nout,99995) 'key ', 'choice of Gaussian rule', key
Write (nout,99997) 'epsabs', 'absolute accuracy requested', epsabs
Write (nout,99997) 'epsrel', 'relative accuracy requested', epsrel
Write (nout,99995) 'maxsub', 'max number of subintervals', maxsub
Write (nout,*)
If (ifail>=0) Then
Write (nout,99996) 'result', 'approximation to the integral', result
Write (nout,99997) 'abserr', 'estimate of the absolute error', abserr
Write (nout,99995) 'iinfo(1)', 'number of subintervals used', iinfo(1)
End If
99998 Format (1X,A6,' - ',A30,' = ',F10.4)
99997 Format (1X,A6,' - ',A30,' = ',E10.2)
99996 Format (1X,A6,' - ',A30,' = ',F10.5)
99995 Format (1X,A6,' - ',A30,' = ',I10)
100 Continue
End Program d01rk_p0w_fe