!   D02UWF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    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
!      .. Parameters ..
       REAL (KIND=nag_wp), PARAMETER       :: a = -1.0_nag_wp
       REAL (KIND=nag_wp), PARAMETER       :: b = 1.0_nag_wp
       REAL (KIND=nag_wp), PARAMETER       :: zero = 0.0_nag_wp
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
       LOGICAL, PARAMETER                  :: reqerr = .FALSE.
    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                              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 nag_library, ONLY : d02ucf, d02uwf, nag_wp, x02ajf
       USE d02uwfe_mod, ONLY : a, b, exact, nin, nout, reqerr, zero
!      .. 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 Functions ..
       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