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

    MODULE d02uyfe_mod

!      D02UYF 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 = 3.0_nag_wp
       REAL (KIND=nag_wp), PARAMETER       :: zero = 0.0_nag_wp
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
       LOGICAL, PARAMETER                  :: reqerr = .FALSE., reqwgt = .FALSE.
    CONTAINS
!dec$ attributes offload : mic :: exact
       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
!         .. Executable Statements ..
          exact = 3.0_nag_wp*x**2
          RETURN
!dec$ attributes offload : mic :: exact
       END FUNCTION exact
    END MODULE d02uyfe_mod
    PROGRAM d02uyfe

!      D02UYF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : d02ucf, d02uyf, ddot, nag_wp, x02ajf
       USE d02uyfe_mod, ONLY : a, b, exact, nin, nout, reqerr, reqwgt
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: integ, scale, uerr
       INTEGER                             :: i, ifail, iu, n
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: f(:), w(:), x(:)
!      .. Intrinsic Functions ..
       INTRINSIC                              abs, int
!      .. Executable Statements ..
       WRITE (nout,*) ' D02UYF Example Program Results '
       WRITE (nout,*)

       READ (nin,*)
       READ (nin,*) n

       ALLOCATE (f(n+1),w(n+1),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
       scale = 0.5_nag_wp*(b-a)

!      Solve on equally spaced grid
       ifail = 0
       CALL d02uyf(n,w,ifail)
!      The NAG name equivalent of ddot is f06eaf
       integ = ddot(n+1,w,1,f,1)*scale

!      Print function values and weights if required
       IF (reqwgt) THEN
          WRITE (nout,*) ' f(x) and Integral weights'
          WRITE (nout,*)
          WRITE (nout,99999)
          WRITE (nout,99998) (x(i),f(i),w(i),i=1,n+1)
       END IF

!      Print approximation to integral
       WRITE (nout,99996) a, b, integ

       IF (reqerr) THEN
          uerr = abs(integ-28.0_nag_wp)
          iu = 10*(int(uerr/10.0_nag_wp/x02ajf())+1)
          WRITE (nout,99997) iu
       END IF

99999  FORMAT (1X,T8,'X',T18,'f(X)',T28,'W')
99998  FORMAT (1X,3F10.4)
99997  FORMAT (/1X,'Integral is within a multiple ',I8, &
          ' of machine precision.')
99996  FORMAT (/1X,'Integral of f(x) from ',F6.1,' to ',F6.2,' = ',F13.5,'.'/)
    END PROGRAM d02uyfe
