!   D01RKF Example Program Text
!   Mark 30.0 Release. NAG Copyright 2024.

    Module d01rkfe_mod

!     D01RKF 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                      :: cos, sin
!       .. Executable Statements ..
        fv(1:nx) = x(1:nx)*(sin(30.0E0_nag_wp*x(1:nx)))*cos(x(1:nx))

        Return

      End Subroutine f
    End Module d01rkfe_mod
    Program d01rkfe

!     D01RKF Example Main Program

!     .. Use Statements ..
      Use d01rkfe_mod, Only: f, nout
      Use, Intrinsic                   :: iso_c_binding, Only: c_null_ptr,     &
                                          c_ptr
      Use nag_library, Only: d01rkf, 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, key, liinfo, lrinfo, maxsub
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: rinfo(:), ruser(:)
      Integer, Allocatable             :: iinfo(:), iuser(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: max
!     .. Executable Statements ..
      Write (nout,*) 'D01RKF Example Program Results'

      key = 6
      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
      ruser = 0.0E0_nag_wp
      cpuser = c_null_ptr

      ifail = -1
      Call d01rkf(f,a,b,key,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,99996) 'KEY     ', 'choice of Gaussian rule', key
        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 '
      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)

    End Program d01rkfe