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

NAG AD Library Introduction
Example description
!   D01RM_P0W_F Example Program Text
!   Mark 28.4 Release. NAG Copyright 2022.

    Module d01rm_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 ..
        Do i = 1, nx
          fv(i) = 1.0_nag_wp/((x(i)+ruser(21))*sqrt(ruser(22)*x(i)))
        End Do
        Return
      End Subroutine f
    End Module d01rm_p0w_fe_mod

    Program d01rm_p0w_fe

!     D01RM_P0W_F Example Main Program

!     .. Use Statements ..
      Use d01rm_p0w_fe_mod, Only: f, nout
      Use, Intrinsic                   :: iso_c_binding, Only: c_null_ptr,     &
                                          c_ptr
      Use nagad_library, Only: d01rm_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)               :: abserr, bound, epsabs, epsrel,       &
                                          result
      Integer                          :: ifail, inf, liinfo, lrinfo, maxsub
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: rinfo(:)
      Real (Kind=nag_wp)               :: ruser(22)
      Integer, Allocatable             :: iinfo(:)
      Integer                          :: iuser(1)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: max
!     .. Executable Statements ..

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

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

      inf = 1
      maxsub = 20
      lrinfo = 4*maxsub
      liinfo = max(maxsub,4)

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

      iuser(1) = 0
      ruser(1:20) = 0.0_nag_wp
      ruser(21) = 1.0_nag_wp
      ruser(22) = 1.0_nag_wp
      cpuser = c_null_ptr

!     Evaluate the integral using the passive routine
      ifail = -1
      Call d01rm_p0w_f(ad_handle,f,bound,inf,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) 'bound    ', 'lower limit of integration', bound
      Write (nout,99994) 'Inf      ', 'upper limit of integration', 'Infinity'
      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)
99994 Format (1X,A9,' - ',A32,' = ',A8)

100   Continue

    End Program d01rm_p0w_fe