NAG Library Manual, Mark 30.2
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
!   D02UYF Example Program Text
!   Mark 30.2 Release. NAG Copyright 2024.

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

!       .. 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
      End Function exact
    End Module d02uyfe_mod
    Program d02uyfe

!     D02UYF Example Main Program

!     .. Use Statements ..
      Use d02uyfe_mod, Only: a, b, exact, nin, nout, reqerr, reqwgt
      Use nag_library, Only: d02ucf, d02uyf, ddot, nag_wp, x02ajf
!     .. 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 Procedures ..
      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