! D02UZF Example Program Text ! Mark 23 Release. NAG Copyright 2011. 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) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: exact ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: x ! .. Intrinsic Functions .. 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, x01aaf, x02ajf USE d02uzfe_mod, ONLY : a, b, exact, nag_wp, 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 Functions .. 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