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

    Module d01rk_p0w_fe_mod

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: f
!     .. Parameters ..
      Integer, Parameter, Public       :: nout = 6
    Contains
      Subroutine f(ad_handle,x,nx,fv,iflag,iuser,ruser,cpuser)
!       .. Use Statements ..
        Use, Intrinsic                 :: iso_c_binding, Only: c_ptr
!       .. Scalar Arguments ..
        Type (c_ptr), Intent (Inout)   :: ad_handle
        Type (c_ptr), Intent (In)      :: cpuser
        Integer, Intent (Inout)        :: iflag
        Integer, Intent (In)           :: nx
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: fv(nx)
        Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
        Real (Kind=nag_wp), Intent (In) :: x(nx)
        Integer, Intent (Inout)        :: iuser(*)
!       .. Intrinsic Procedures ..
        Intrinsic                      :: cos, sin
!       .. Executable Statements ..
        fv = x*sin(ruser(1)*x)*cos(ruser(2)*x)
        Return
      End Subroutine f
    End Module d01rk_p0w_fe_mod

    Program d01rk_p0w_fe

!     D01RK_P0W_F Example Main Program

!     .. Use Statements ..
      Use d01rk_p0w_fe_mod, Only: f, nout
      Use, Intrinsic                   :: iso_c_binding, Only: c_null_ptr,     &
                                          c_ptr
      Use nagad_library, Only: d01rk_p0w_f
      Use nag_library, Only: nag_wp, x01aaf
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Type (c_ptr)                     :: ad_handle, cpuser
      Real (Kind=nag_wp)               :: a, abserr, b, epsabs, epsrel, pi,    &
                                          result
      Integer                          :: ifail, key, liinfo, lrinfo, maxsub
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: rinfo(:)
      Real (Kind=nag_wp)               :: ruser(2)
      Integer, Allocatable             :: iinfo(:)
      Integer                          :: iuser(1)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: max
!     .. Executable Statements ..

      Write (nout,*) 'D01RK_P0W_F Example Program Results'

      key = 6
      pi = x01aaf(pi)

!     Initialize passive types
      a = 0.0_nag_wp
      b = 2.0_nag_wp*pi
      epsabs = 0.0_nag_wp
      epsrel = 1.0E-4_nag_wp

      maxsub = 20
      lrinfo = 4*maxsub
      liinfo = max(maxsub,4)

      Allocate (rinfo(lrinfo),iinfo(liinfo))

      iuser(1) = 0
      ruser(1) = 30.0_nag_wp
      ruser(2) = 1.0_nag_wp
      cpuser = c_null_ptr

!     Evaluate the integral using the passive routine
      ifail = -1
      Call d01rk_p0w_f(ad_handle,f,a,b,key,epsabs,epsrel,maxsub,result,abserr, &
        rinfo,iinfo,iuser,ruser,cpuser,ifail)

      If (ifail<0) Then
        Write (nout,99999) 'The routine has failed with ifail = ', ifail
        Go To 100
99999   Format (1X,A,I0)
      End If
!     Print inputs and primal outputs
      Write (nout,*)
      Write (nout,99998) 'a     ', 'lower limit of integration', a
      Write (nout,99998) 'b     ', 'upper limit of integration', b
      Write (nout,99995) 'key   ', 'choice of Gaussian rule', key
      Write (nout,99997) 'epsabs', 'absolute accuracy requested', epsabs
      Write (nout,99997) 'epsrel', 'relative accuracy requested', epsrel
      Write (nout,99995) 'maxsub', 'max number of subintervals', maxsub
      Write (nout,*)
      If (ifail>=0) Then
        Write (nout,99996) 'result', 'approximation to the integral', result
        Write (nout,99997) 'abserr', 'estimate of the absolute error', abserr
        Write (nout,99995) 'iinfo(1)', 'number of subintervals used', iinfo(1)
      End If
99998 Format (1X,A6,' - ',A30,' = ',F10.4)
99997 Format (1X,A6,' - ',A30,' = ',E10.2)
99996 Format (1X,A6,' - ',A30,' = ',F10.5)
99995 Format (1X,A6,' - ',A30,' = ',I10)

100   Continue

    End Program d01rk_p0w_fe