! D02UZF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d02uzfe_mod ! D02UZF 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 :: one = 1.0_nag_wp Real (Kind=nag_wp), Parameter :: two = 2.0_nag_wp Real (Kind=nag_wp), Parameter :: zero = 0.0_nag_wp Integer, Parameter :: nin = 5, nout = 6 Logical, Parameter :: reqerr = .False. ! .. Local Scalars .. Real (Kind=nag_wp) :: a, b Contains Function exact(x) ! .. Function Return Value .. Real (Kind=nag_wp) :: exact ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: x ! .. Intrinsic Procedures .. Intrinsic :: exp ! .. Executable Statements .. exact = x + exp(-x) Return End Function exact End Module d02uzfe_mod Program d02uzfe ! D02UZF Example Main Program ! .. Use Statements .. Use nag_library, Only: d02uaf, d02ucf, d02uzf, nag_wp, x01aaf, x02ajf Use d02uzfe_mod, Only: a, b, exact, nin, nout, one, reqerr, two, zero ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: deven, dmap, fseries, pi, t, & teneps, uerr, xeven, xmap Integer :: i, ifail, k, m, n ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: c(:), f(:), x(:) ! .. Intrinsic Procedures .. Intrinsic :: abs, int, max, min, real ! .. Executable Statements .. Write (nout,*) ' D02UZF Example Program Results ' Write (nout,*) Read (nin,*) Read (nin,*) n, m Allocate (f(n+1),c(n+1),x(n+1)) ! Set up problem boundary conditions and definition pi = x01aaf(pi) a = -0.24_nag_wp*pi b = pi/two ! Set up Chebyshev grid ifail = 0 Call d02ucf(n,a,b,x,ifail) ! Evaluate function on grid and get interpolating Chebyshev coefficients. Do i = 1, n + 1 f(i) = exact(x(i)) End Do ifail = 0 Call d02uaf(n,f,c,ifail) ! Evaluate Chebyshev series manually by evaluating each Chebyshev ! polynomial in turn at new equispaced (m+1) grid points. ! Chebyshev series on [-1,1] map of [a,b]. xmap = -one dmap = two/real(m-1,kind=nag_wp) xeven = a deven = (b-a)/real(m-1,kind=nag_wp) Write (nout,99999) uerr = zero Do i = 1, m fseries = zero Do k = 0, n ifail = 0 Call d02uzf(k,xmap,t,ifail) fseries = fseries + c(k+1)*t End Do uerr = max(uerr,abs(fseries-exact(xeven))) Write (nout,99998) xmap, xeven, fseries xmap = min(one,xmap+dmap) xeven = xeven + deven End Do If (reqerr) Then teneps = 10.0_nag_wp*x02ajf() Write (nout,'(//)') Write (nout,99997) 10*(int(uerr/teneps)+1) End If 99999 Format (1X,T6,'x_even',T17,'x_map',T28,'Sum') 99998 Format (1X,3F10.4) 99997 Format (1X,'Error in coefficient sum is < ',I8,' * machine precision.') End Program d02uzfe