NAG Library Manual, Mark 30.2
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
!   D01RMF Example Program Text
!   Mark 30.2 Release. NAG Copyright 2024.

    Module d01rmfe_mod

!     D01RMF 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                      :: sqrt
!       .. Executable Statements ..
        fv(1:nx) = 1.0E0_nag_wp/((x(1:nx)+1.0E0_nag_wp)*sqrt(x(1:nx)))

        Return

      End Subroutine f
    End Module d01rmfe_mod
    Program d01rmfe

!     D01RMF Example Main Program

!     .. Use Statements ..
      Use d01rmfe_mod, Only: f, nout
      Use, Intrinsic                   :: iso_c_binding, Only: c_null_ptr,     &
                                          c_ptr
      Use nag_library, Only: d01rmf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Type (c_ptr)                     :: cpuser
      Real (Kind=nag_wp)               :: abserr, bound, epsabs, epsrel,       &
                                          result
      Integer                          :: ifail, inf, liinfo, lrinfo, maxsub
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: rinfo(:), ruser(:)
      Integer, Allocatable             :: iinfo(:), iuser(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: max
!     .. Executable Statements ..
      Write (nout,*) 'D01RMF Example Program Results'

      bound = 0.0E0_nag_wp
      inf = 1
      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 d01rmf(f,bound,inf,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', bound
        Write (nout,99995) 'B       ', 'upper limit of integration',           &
          'infinity'
        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,99994) ' Exit requested from F'
      End If

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

    End Program d01rmfe