! D05BAF Example Program Text
! Mark 30.3 Release. nAG Copyright 2024.
Module d05bafe_mod
! D05BAF 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 :: cf, cg, ck, sol
! .. Parameters ..
Integer, Parameter, Public :: nmesh = 6, nout = 6
Contains
Function sol(t)
! .. Function Return Value ..
Real (Kind=nag_wp) :: sol
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: t
! .. Intrinsic Procedures ..
Intrinsic :: exp, log
! .. Executable Statements ..
sol = log(t+exp(1.0_nag_wp))
Return
End Function sol
Function cf(t)
! .. Function Return Value ..
Real (Kind=nag_wp) :: cf
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: t
! .. Intrinsic Procedures ..
Intrinsic :: exp
! .. Executable Statements ..
cf = exp(-t)
Return
End Function cf
Function ck(t)
! .. Function Return Value ..
Real (Kind=nag_wp) :: ck
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: t
! .. Intrinsic Procedures ..
Intrinsic :: exp
! .. Executable Statements ..
ck = exp(-t)
Return
End Function ck
Function cg(s,y)
! .. Function Return Value ..
Real (Kind=nag_wp) :: cg
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: s, y
! .. Intrinsic Procedures ..
Intrinsic :: exp
! .. Executable Statements ..
cg = y + exp(-y)
Return
End Function cg
End Module d05bafe_mod
Program d05bafe
! D05BAF Example Main Program
! .. Use Statements ..
Use d05bafe_mod, Only: cf, cg, ck, nmesh, nout, sol
Use nag_library, Only: d05baf, nag_wp, x02ajf
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Real (Kind=nag_wp) :: alim, h, hi, si, thresh, tlim, tol
Integer :: i, ifail, iorder, lwk
Character (1) :: method
! .. Local Arrays ..
Real (Kind=nag_wp) :: errest(nmesh), yn(nmesh)
Real (Kind=nag_wp), Allocatable :: work(:)
! .. Intrinsic Procedures ..
Intrinsic :: abs, int, real
! .. Executable Statements ..
Write (nout,*) 'D05BAF Example Program Results'
method = 'A'
iorder = 6
alim = 0.0_nag_wp
tlim = 20.0_nag_wp
h = (tlim-alim)/real(nmesh,kind=nag_wp)
tol = 1.E-3_nag_wp
thresh = x02ajf()
lwk = 10*nmesh + 6
Allocate (work(lwk))
! Loop until the supplied workspace is big enough
loop: Do
ifail = 1
Call d05baf(ck,cg,cf,method,iorder,alim,tlim,yn,errest,nmesh,tol, &
thresh,work,lwk,ifail)
Select Case (ifail)
Case (5,6)
lwk = int(work(1))
Deallocate (work)
Allocate (work(lwk))
Case Default
Exit loop
End Select
End Do loop
If (ifail/=0) Then
Write (nout,99996) 'D05BAF exited with IFAIL =', ifail
Go To 100
End If
Write (nout,*)
Write (nout,99999) 'Size of workspace =', lwk
Write (nout,99998) 'Tolerance =', tol
Write (nout,*)
Write (nout,*) &
' T Approx. Sol. True Sol. Est. Error Actual Error'
Do i = 1, nmesh
hi = real(i,kind=nag_wp)*h
si = sol(hi)
Write (nout,99997) alim + hi, yn(i), si, errest(i), abs((yn(i)-si)/si)
End Do
100 Continue
99999 Format (1X,A,I12)
99998 Format (1X,A,E12.4)
99997 Format (F7.2,2F14.5,2E15.5)
99996 Format (1X,A,I5)
End Program d05bafe