NAG Library Manual, Mark 30
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
!   D02UZF Example Program Text
!   Mark 30.0 Release. NAG Copyright 2024.

    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
!     .. Accessibility Statements ..
      Private
      Public                           :: exact
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter, Public :: one = 1.0_nag_wp
      Real (Kind=nag_wp), Parameter, Public :: two = 2.0_nag_wp
      Real (Kind=nag_wp), Parameter, Public :: zero = 0.0_nag_wp
      Integer, Parameter, Public       :: nin = 5, nout = 6
      Logical, Parameter, Public       :: reqerr = .False.
!     .. Local Scalars ..
      Real (Kind=nag_wp), Public, Save :: 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 d02uzfe_mod, Only: a, b, exact, nin, nout, one, reqerr, two, zero
      Use nag_library, Only: d02uaf, d02ucf, d02uzf, nag_wp, x01aaf, x02ajf
!     .. 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