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

NAG AD Library Introduction
Example description
!   D01RG_P0W_F Example Program Text
!   Mark 30.0 Release. NAG Copyright 2024.

    Module d01rg_p0w_fe_mod

!     .. Use Statements ..
      Use iso_c_binding, Only: c_ptr
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: f
!     .. Parameters ..
      Integer, Parameter, Public       :: nin = 5, nout = 6
    Contains
      Subroutine f(ad_handle,x,nx,fv,iflag,iuser,ruser)

!       .. Scalar Arguments ..
        Type (c_ptr), Intent (Inout)   :: ad_handle
        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                      :: log, sin
!       .. Executable Statements ..

        fv = sin(x)/x*log(10.0_nag_wp*(1.0_nag_wp-x))
        Return
      End Subroutine f
    End Module d01rg_p0w_fe_mod

    Program d01rg_p0w_fe

!     D01RG_P0W_F Example Main Program

!     .. Use Statements ..
      Use d01rg_p0w_fe_mod, Only: f, nin, nout
      Use iso_c_binding, Only: c_ptr
      Use nagad_library, Only: d01rg_p0w_f
      Use nag_library, Only: nag_wp, x07caf, x07cbf
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Type (c_ptr)                     :: ad_handle
      Real (Kind=nag_wp)               :: a, b, dinest, epsabs, epsrel, errest
      Integer                          :: ifail, nevals
!     .. Local Arrays ..
      Real (Kind=nag_wp)               :: ruser(1)
      Integer                          :: exmode(3), exmode_old(3), iuser(1)
!     .. Executable Statements ..

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

!     The example function can raise various exceptions - it contains
!     a division by zero and a log singularity - although its integral
!     is well behaved.

      Call x07caf(exmode_old)
!     Save the original halting mode

!     Turn exception halting mode off for the three common exceptions
      exmode = (/0,0,0/)
      Call x07cbf(exmode)

!     Skip first line of data file
      Read (nin,*)
!     Read problem parameters and initialize passive types
      Read (nin,*) a
      Read (nin,*) b
      Read (nin,*) epsabs
      Read (nin,*) epsrel

!     Evaluate the integral using the passive routine
      ifail = -1
      Call d01rg_p0w_f(ad_handle,a,b,f,epsabs,epsrel,dinest,errest,nevals,     &
        iuser,ruser,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) 'a     ', 'lower limit of integration', a
      Write (nout,99998) 'b     ', 'upper limit of integration', b
      Write (nout,99997) 'epsabs', 'absolute accuracy requested', epsabs
      Write (nout,99997) 'epsrel', 'relative accuracy requested', epsrel
      Write (nout,*)
      If (ifail>=0) Then
        Write (nout,99996) 'dinest', 'approximation to the integral', dinest
        Write (nout,99997) 'errest', 'estimate of the absolute error', errest
        Write (nout,99995) 'nevals', 'number of function evaluations', nevals
      End If
99998 Format (1X,A6,' - ',A30,' = ',F10.4)
99997 Format (1X,A6,' - ',A30,' = ',E10.2)
99996 Format (1X,A6,' - ',A30,' = ',F10.5)
99995 Format (1X,A6,' - ',A30,' = ',I10)

100   Continue

!     Restore the original halting mode
      Call x07cbf(exmode_old)
    End Program d01rg_p0w_fe