!   D01RJF Example Program Text
!   Mark 28.3 Release. NAG Copyright 2022.

    Module d01rjfe_mod

!     D01RJF 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                           :: f
!     .. Parameters ..
      Integer, Parameter, Public       :: nout = 6
    Contains
      Subroutine f(x,nx,fv,iflag,iuser,ruser,cpuser)

!       .. Use Statements ..
        Use, Intrinsic                 :: iso_c_binding, Only: c_ptr
!       .. Scalar Arguments ..
        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                      :: any, sin, sqrt
!       .. Executable Statements ..
        If (any(x==1.0E0_nag_wp)) Then
!         An undefined result will be generated.
!         Set iflag to force an immediate exit
          iflag = -1
!         Store chosen value of iflag in iuser
          iuser(1) = iflag
        Else
          fv(1:nx) = x(1:nx)*sin(30.0E0_nag_wp*x(1:nx))/                       &
            sqrt(1.0E0_nag_wp-x(1:nx)**2/ruser(1))
        End If
        Return

      End Subroutine f
    End Module d01rjfe_mod
    Program d01rjfe

!     D01RJF Example Main Program

!     .. Use Statements ..
      Use d01rjfe_mod, Only: f, nout
      Use, Intrinsic                   :: iso_c_binding, Only: c_null_ptr,     &
                                          c_ptr
      Use nag_library, Only: d01rjf, nag_wp, x01aaf
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Type (c_ptr)                     :: 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(:), ruser(:)
      Integer, Allocatable             :: iinfo(:), iuser(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: max
!     .. Executable Statements ..
      Write (nout,*) 'D01RJF Example Program Results'

      pi = x01aaf(pi)
      a = 0.0_nag_wp
      b = 2.0_nag_wp*pi
      epsabs = 0.0_nag_wp
      epsrel = 1.0E-04_nag_wp
      maxsub = 20
      lrinfo = 4*maxsub
      liinfo = max(maxsub,4)

      Allocate (rinfo(lrinfo),iinfo(liinfo),iuser(1),ruser(1))

      iuser = 0
!     pass constant to f through ruser.
      ruser(1) = 4.0E0_nag_wp*pi**2
      cpuser = c_null_ptr

      ifail = -1
      Call d01rjf(f,a,b,epsabs,epsrel,maxsub,result,abserr,rinfo,iinfo,iuser,  &
        ruser,cpuser,ifail)

      If (ifail>=0) Then
        Write (nout,*)
        Write (nout,99999) 'A       ', 'lower limit of integration', a
        Write (nout,99999) 'B       ', 'upper limit of integration', b
        Write (nout,99998) 'EPSABS  ', 'absolute accuracy requested', epsabs
        Write (nout,99998) 'EPSREL  ', 'relative accuracy requested', epsrel
        Write (nout,99996) 'MAXSUB  ', 'maximum number of subintervals',       &
          maxsub
        If (ifail<=5) Then
          Write (nout,*)
          Write (nout,99997) 'RESULT  ', 'approximation to the integral',      &
            result
          Write (nout,99998) 'ABSERR  ', 'estimate of the absolute error',     &
            abserr
          Write (nout,99996) 'IINFO(1)', 'number of subintervals used',        &
            iinfo(1)
        End If
      Else If (ifail==-1) Then
!       User requested exit.
        Write (nout,99995) ' Exit requested from F with IFLAG ', iuser(1)
      End If

99999 Format (1X,A8,' - ',A30,' = ',F9.4)
99998 Format (1X,A8,' - ',A30,' = ',E9.2)
99997 Format (1X,A8,' - ',A30,' = ',F9.5)
99996 Format (1X,A8,' - ',A30,' = ',I4)
99995 Format (1X,A30,' = ',I4)

    End Program d01rjfe