Program c06bafe
! C06BAF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: c06baf, nag_wp, x01aaf
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: lwork = 16, nout = 6
! .. Local Scalars ..
Real (Kind=nag_wp) :: abserr, ans, error, pi, r, result, &
seqn, sig
Integer :: i, ifail, ncall
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: work(:)
! .. Intrinsic Procedures ..
Intrinsic :: real
! .. Executable Statements ..
Write (nout,*) 'C06BAF Example Program Results'
Write (nout,*)
Allocate (work(lwork))
pi = x01aaf(pi)
ans = pi**2/12.0_nag_wp
ncall = 0
sig = 1.0_nag_wp
seqn = 0.0_nag_wp
Write (nout,99999) 'Estimated Actual'
Write (nout,99998) 'I SEQN RESULT', 'abs error error'
Write (nout,*)
Do i = 1, 10
r = real(i,kind=nag_wp)
seqn = seqn + sig/(r**2)
! ifail: behaviour on error exit
! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
ifail = 0
Call c06baf(seqn,ncall,result,abserr,work,lwork,ifail)
error = result - ans
sig = -sig
If (i<=3) Then
! First three calls of C06BAF return no error estimate
Write (nout,99997) i, seqn, result, error
Else
Write (nout,99996) i, seqn, result, abserr, error
End If
End Do
99999 Format (36X,A)
99998 Format (3X,A25,8X,A)
99997 Format (1X,I4,2F12.4,3X,10X,'- ',E14.2)
99996 Format (1X,I4,2F12.4,3X,2E14.2)
End Program c06bafe