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

    MODULE d02udfe_mod

!      D02UDF 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 = 0.0_nag_wp
       REAL (KIND=nag_wp), PARAMETER       :: b = 1.5_nag_wp
       REAL (KIND=nag_wp), PARAMETER       :: one = 1.0_nag_wp
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
       LOGICAL, PARAMETER                  :: reqerr = .FALSE.
    CONTAINS
       FUNCTION fcn(x)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: fcn
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: x
!         .. Intrinsic Functions ..
          INTRINSIC                              exp
!         .. Executable Statements ..
          fcn = (one+one)*x + exp(-x)
          RETURN
       END FUNCTION fcn
       FUNCTION deriv(x)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: deriv
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: x
!         .. Intrinsic Functions ..
          INTRINSIC                              exp
!         .. Executable Statements ..
          deriv = one + one - exp(-x)
          RETURN
       END FUNCTION deriv

    END MODULE d02udfe_mod
    PROGRAM d02udfe

!      D02UDF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : d02ucf, d02udf, x02ajf
       USE d02udfe_mod, ONLY : a, b, deriv, fcn, nag_wp, nin, nout, reqerr
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: scale, teneps, uxerr
       INTEGER                             :: i, ifail, n
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: f(:), fd(:), x(:)
!      .. Intrinsic Functions ..
       INTRINSIC                              abs, int, max
!      .. Executable Statements ..
       WRITE (nout,*) ' D02UDF Example Program Results '
       WRITE (nout,*)

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

       ALLOCATE (f(n+1),fd(n+1),x(n+1))

!      Set up solution grid
       ifail = 0
       CALL d02ucf(n,a,b,x,ifail)

!      Evaluate fcn on Chebyshev grid.
       DO i = 1, n + 1
          f(i) = fcn(x(i))
       END DO

!      Calculate derivative of fcn.
       ifail = 0
       CALL d02udf(n,f,fd,ifail)

       scale = 2.0_nag_wp/(b-a)
       fd(1:n+1) = scale*fd(1:n+1)

!      Print function and its derivative 
       WRITE (nout,*) ' Original Function F and numerical derivative Fx'
       WRITE (nout,*)
       WRITE (nout,99999)
       WRITE (nout,99998) (x(i),f(i),fd(i),i=1,n+1)

       IF (reqerr) THEN
          uxerr = 0.0_nag_wp
          DO i = 1, n + 1
             uxerr = max(uxerr,abs(fd(i)-deriv(x(i))))
          END DO
          teneps = 100.0_nag_wp*x02ajf()
          WRITE (nout,99997) 100*(int(uxerr/teneps)+1)
       END IF

99999  FORMAT (1X,T8,'X',T18,'F',T28,'Fx')
99998  FORMAT (1X,3F10.4)
99997  FORMAT (1X,'Fx is within a multiple ',I8,' of machine precision.')

    END PROGRAM d02udfe