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

    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
!     .. Accessibility Statements ..
      Private
      Public                           :: deriv, fcn
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter, Public :: a = 0.0_nag_wp
      Real (Kind=nag_wp), Parameter, Public :: b = 1.5_nag_wp
      Real (Kind=nag_wp), Parameter    :: one = 1.0_nag_wp
      Integer, Parameter, Public       :: nin = 5, nout = 6
      Logical, Parameter, Public       :: reqerr = .False.
    Contains
      Function fcn(x)

!       .. Function Return Value ..
        Real (Kind=nag_wp)             :: fcn
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: x
!       .. Intrinsic Procedures ..
        Intrinsic                      :: exp
!       .. Executable Statements ..
        fcn = (one+one)*x + exp(-x)
        Return
      End Function fcn
      Function deriv(x)

!       .. Function Return Value ..
        Real (Kind=nag_wp)             :: deriv
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: x
!       .. Intrinsic Procedures ..
        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 d02udfe_mod, Only: a, b, deriv, fcn, nin, nout, reqerr
      Use nag_library, Only: d02ucf, d02udf, nag_wp, x02ajf
!     .. 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 Procedures ..
      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