!   D02UWF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.

    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
!     .. Accessibility Statements ..
      Private
      Public                           :: exact
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter, Public :: a = -1.0_nag_wp
      Real (Kind=nag_wp), Parameter, Public :: b = 1.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.
    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 d02uwfe_mod, Only: a, b, exact, nin, nout, reqerr, zero
      Use nag_library, Only: d02ucf, d02uwf, nag_wp, x02ajf
!     .. 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