!   D01RJ_P0W_F Example Program Text
!   Mark 30.2 Release. NAG Copyright 2024.

    Module d01rj_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(*)
!       .. Local Scalars ..
        Integer                        :: i
!       .. Intrinsic Procedures ..
        Intrinsic                      :: sin, sqrt
!       .. Executable Statements ..
        Do i = 1, nx
          If (x(i)==1.0_nag_wp) Then
!           An undefined result will be generated.
!           Set iflag to force immediate exit and stoe in iuser
            iflag = -1
            iuser(1) = iflag
          Else
            fv(i) = x(i)*sin(ruser(2)*x(i))/sqrt(1.0_nag_wp-x(i)*x(i)/ruser(1) &
              )
          End If
        End Do
        Return
      End Subroutine f
    End Module d01rj_p0w_fe_mod

    Program d01rj_p0w_fe

!     D01RJ_P0W_F Example Main Program

!     .. Use Statements ..
      Use d01rj_p0w_fe_mod, Only: f, nout
      Use, Intrinsic                   :: iso_c_binding, Only: c_ptr
      Use nagad_library, Only: d01rj_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, 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,*) 'D01RJ_P0W_F Example Program Results'

      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) = 4.0_nag_wp*pi*pi
      ruser(2) = 30.0_nag_wp

!     Evaluate the integral using the passive routine
      ifail = -1
      Call d01rj_p0w_f(ad_handle,f,a,b,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,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 d01rj_p0w_fe