! D02UWF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d02uwfe_mod ! D02UWF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Real (Kind=nag_wp), Parameter :: a = -1.0_nag_wp Real (Kind=nag_wp), Parameter :: b = 1.0_nag_wp Real (Kind=nag_wp), Parameter :: zero = 0.0_nag_wp Integer, Parameter :: nin = 5, nout = 6 Logical, Parameter :: reqerr = .False. Contains Function exact(x) ! .. Function Return Value .. Real (Kind=nag_wp) :: exact ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: x ! .. Intrinsic Procedures .. Intrinsic :: cos ! .. Executable Statements .. exact = x + cos(5.0_nag_wp*x) Return End Function exact End Module d02uwfe_mod Program d02uwfe ! D02UWF Example Main Program ! .. Use Statements .. Use nag_library, Only: d02ucf, d02uwf, nag_wp, x02ajf Use d02uwfe_mod, Only: a, b, exact, nin, nout, reqerr, zero ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: uerr Integer :: i, ifail, iu, n, nip ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: f(:), fip(:), x(:), xip(:) ! .. Intrinsic Procedures .. Intrinsic :: abs, int, max ! .. Executable Statements .. Write (nout,*) ' D02UWF Example Program Results ' Write (nout,*) Read (nin,*) Read (nin,*) n, nip Allocate (f(n+1),fip(nip),xip(nip),x(n+1)) ! Set up solution grid ifail = 0 Call d02ucf(n,a,b,x,ifail) ! Set up problem right hand sides for grid Do i = 1, n + 1 f(i) = exact(x(i)) End Do ! Map to an equally spaced grid ifail = 0 Call d02uwf(n,nip,x,f,xip,fip,ifail) ! Print solution Write (nout,*) ' Numerical solution F' Write (nout,*) Write (nout,99999) Write (nout,99998)(xip(i),fip(i),i=1,nip) If (reqerr) Then uerr = zero Do i = 1, nip uerr = max(uerr,abs(fip(i)-exact(xip(i)))) End Do iu = 10*(int(uerr/10.0_nag_wp/x02ajf())+1) Write (nout,99997) iu End If 99999 Format (1X,T8,'X',T19,'F') 99998 Format (1X,F10.4,1X,F10.4) 99997 Format (//1X,'F is within a multiple ',I8,' of machine precision.') End Program d02uwfe