! D01RG_P0W_F Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
Module d01rg_p0w_fe_mod
! .. Use Statements ..
Use iso_c_binding, Only: c_ptr
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: f
! .. Parameters ..
Integer, Parameter, Public :: nin = 5, nout = 6
Contains
Subroutine f(ad_handle,x,nx,fv,iflag,iuser,ruser)
! .. Scalar Arguments ..
Type (c_ptr), Intent (Inout) :: ad_handle
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 :: log, sin
! .. Executable Statements ..
fv = sin(x)/x*log(10.0_nag_wp*(1.0_nag_wp-x))
Return
End Subroutine f
End Module d01rg_p0w_fe_mod
Program d01rg_p0w_fe
! D01RG_P0W_F Example Main Program
! .. Use Statements ..
Use d01rg_p0w_fe_mod, Only: f, nin, nout
Use iso_c_binding, Only: c_ptr
Use nagad_library, Only: d01rg_p0w_f
Use nag_library, Only: nag_wp, x07caf, x07cbf
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Type (c_ptr) :: ad_handle
Real (Kind=nag_wp) :: a, b, dinest, epsabs, epsrel, errest
Integer :: ifail, nevals
! .. Local Arrays ..
Real (Kind=nag_wp) :: ruser(1)
Integer :: exmode(3), exmode_old(3), iuser(1)
! .. Executable Statements ..
Write (nout,*) 'D01RG_P0W_F Example Program Results'
! The example function can raise various exceptions - it contains
! a division by zero and a log singularity - although its integral
! is well behaved.
Call x07caf(exmode_old)
! Save the original halting mode
! Turn exception halting mode off for the three common exceptions
exmode = (/0,0,0/)
Call x07cbf(exmode)
! Skip first line of data file
Read (nin,*)
! Read problem parameters and initialize passive types
Read (nin,*) a
Read (nin,*) b
Read (nin,*) epsabs
Read (nin,*) epsrel
! Evaluate the integral using the passive routine
ifail = -1
Call d01rg_p0w_f(ad_handle,a,b,f,epsabs,epsrel,dinest,errest,nevals, &
iuser,ruser,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,99997) 'epsabs', 'absolute accuracy requested', epsabs
Write (nout,99997) 'epsrel', 'relative accuracy requested', epsrel
Write (nout,*)
If (ifail>=0) Then
Write (nout,99996) 'dinest', 'approximation to the integral', dinest
Write (nout,99997) 'errest', 'estimate of the absolute error', errest
Write (nout,99995) 'nevals', 'number of function evaluations', nevals
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
! Restore the original halting mode
Call x07cbf(exmode_old)
End Program d01rg_p0w_fe