!   D01RL_P0W_F Example Program Text
!   Mark 30.3 Release. NAG Copyright 2024.

    Module d01rl_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                      :: sqrt
!       .. Executable Statements ..
        iflag = 0
        Do i = 1, nx
          fv(i) = x(i) - 1.0_nag_wp/7.0_nag_wp
          If (fv(i)==0.0_nag_wp) Then
!           singular point has been hit
            iflag = iflag + 1
            ruser(iflag) = x(i)
          Else If (fv(i)<0.0_nag_wp) Then
            fv(i) = -fv(i)
          End If
        End Do
        iuser(1) = iflag
!       signal abort by setting iflag <0
        If (iflag==0) Then
          Do i = 1, nx
            fv(i) = 1.0_nag_wp/sqrt(fv(i))
          End Do
        Else
          iflag = -iflag
        End If
        Return
      End Subroutine f
    End Module d01rl_p0w_fe_mod

    Program d01rl_p0w_fe

!     D01RL_P0W_F Example Main Program

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

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

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

      npts = 1
      maxsub = 20
      liinfo = 2*max(maxsub,npts) + npts + 4
      lrinfo = 4*max(maxsub,npts) + npts + 6

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

      points(1) = 1.0_nag_wp/7.0_nag_wp
      iuser(1) = 0
      ruser(1:20) = 0.0_nag_wp
      cpuser = c_null_ptr

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

      If (ifail<0) Then
        If (ifail==-1) Then
          Write (nout,99999) 'A user requested exit was issued from F '
        Else
          Write (nout,99999) 'The routine has failed with ifail = ', ifail
        End If
        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,99998) 'points(1)', 'given break-point', points(1)
      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,A9,' - ',A32,' = ',F9.4)
99997 Format (1X,A9,' - ',A32,' = ',E9.2)
99996 Format (1X,A9,' - ',A32,' = ',F9.5)
99995 Format (1X,A9,' - ',A32,' = ',I4)

100   Continue

    End Program d01rl_p0w_fe