! D05BAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. 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 ! .. Parameters .. Integer, Parameter :: 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 nag_library, Only: d05baf, nag_wp, x02ajf Use d05bafe_mod, Only: cf, cg, ck, nmesh, nout, sol ! .. 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