! D02UYF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d02uyfe_mod ! D02UYF 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 = 3.0_nag_wp Real (Kind=nag_wp), Parameter :: zero = 0.0_nag_wp Integer, Parameter :: nin = 5, nout = 6 Logical, Parameter :: reqerr = .False., reqwgt = .False. Contains Function exact(x) ! .. Function Return Value .. Real (Kind=nag_wp) :: exact ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: x ! .. Executable Statements .. exact = 3.0_nag_wp*x**2 Return End Function exact End Module d02uyfe_mod Program d02uyfe ! D02UYF Example Main Program ! .. Use Statements .. Use nag_library, Only: d02ucf, d02uyf, ddot, nag_wp, x02ajf Use d02uyfe_mod, Only: a, b, exact, nin, nout, reqerr, reqwgt ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: integ, scale, uerr Integer :: i, ifail, iu, n ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: f(:), w(:), x(:) ! .. Intrinsic Procedures .. Intrinsic :: abs, int ! .. Executable Statements .. Write (nout,*) ' D02UYF Example Program Results ' Write (nout,*) Read (nin,*) Read (nin,*) n Allocate (f(n+1),w(n+1),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 scale = 0.5_nag_wp*(b-a) ! Solve on equally spaced grid ifail = 0 Call d02uyf(n,w,ifail) ! The NAG name equivalent of ddot is f06eaf integ = ddot(n+1,w,1,f,1)*scale ! Print function values and weights if required If (reqwgt) Then Write (nout,*) ' f(x) and Integral weights' Write (nout,*) Write (nout,99999) Write (nout,99998)(x(i),f(i),w(i),i=1,n+1) End If ! Print approximation to integral Write (nout,99996) a, b, integ If (reqerr) Then uerr = abs(integ-28.0_nag_wp) iu = 10*(int(uerr/10.0_nag_wp/x02ajf())+1) Write (nout,99997) iu End If 99999 Format (1X,T8,'X',T18,'f(X)',T28,'W') 99998 Format (1X,3F10.4) 99997 Format (/1X,'Integral is within a multiple ',I8, & ' of machine precision.') 99996 Format (/1X,'Integral of f(x) from ',F6.1,' to ',F6.2,' = ',F13.5,'.'/) End Program d02uyfe