!   D01APF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.

    Module d01apfe_mod

!     D01APF 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                           :: g1, g2
!     .. Parameters ..
      Integer, Parameter, Public       :: lw = 800, nout = 6
      Integer, Parameter, Public       :: liw = lw/4
    Contains
      Function g1(x)

!       .. Use Statements ..
        Use nag_library, Only: x01aaf
!       .. Function Return Value ..
        Real (Kind=nag_wp)             :: g1
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: x
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: a, pi
!       .. Intrinsic Procedures ..
        Intrinsic                      :: cos
!       .. Executable Statements ..
        pi = x01aaf(pi)
        a = 10.0E0_nag_wp*pi
        g1 = cos(a*x)

        Return

      End Function g1
      Function g2(x)

!       .. Function Return Value ..
        Real (Kind=nag_wp)             :: g2
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: x
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: omega
!       .. Intrinsic Procedures ..
        Intrinsic                      :: sin
!       .. Executable Statements ..
        omega = 10.0E0_nag_wp
        g2 = sin(omega*x)

        Return

      End Function g2
    End Module d01apfe_mod
    Program d01apfe

!     D01APF Example Main Program

!     .. Use Statements ..
      Use d01apfe_mod, Only: g1, g2, liw, lw, nout
      Use nag_library, Only: d01apf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: a, abserr, alpha, b, beta, epsabs,   &
                                          epsrel, result
      Integer                          :: ifail, key, nof
!     .. Local Arrays ..
      Real (Kind=nag_wp)               :: alpha_a(2), beta_a(2)
      Real (Kind=nag_wp), Allocatable  :: w(:)
      Integer, Allocatable             :: iw(:)
      Integer                          :: key_a(2)
!     .. Executable Statements ..
      Write (nout,*) 'D01APF Example Program Results'

      Allocate (w(lw),iw(liw))

      alpha_a = (/0.0_nag_wp,-0.5_nag_wp/)
      beta_a = (/0.0_nag_wp,-0.5_nag_wp/)
      key_a = (/2,1/)

      epsabs = 0.0_nag_wp
      epsrel = 1.0E-04_nag_wp
      a = 0.0_nag_wp
      b = 1.0_nag_wp

funs: Do nof = 1, 2

        alpha = alpha_a(nof)
        beta = beta_a(nof)
        key = key_a(nof)

        ifail = -1
        If (nof==1) Then
          Call d01apf(g1,a,b,alpha,beta,key,epsabs,epsrel,result,abserr,w,lw,  &
            iw,liw,ifail)
        Else
          Call d01apf(g2,a,b,alpha,beta,key,epsabs,epsrel,result,abserr,w,lw,  &
            iw,liw,ifail)
        End If

        If (ifail<0) Then
          Exit funs
        End If

        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,*)
        Write (nout,99998) 'ALPHA ', 'parameter in the weight function', alpha
        Write (nout,99998) 'BETA  ', 'parameter in the weight function', beta
        Write (nout,99997) 'KEY   ', 'which weight function is used', key

        If (ifail>3) Then
          Cycle funs
        End If
        Write (nout,*)
        Write (nout,99996) 'RESULT', 'approximation to the integral', result
        Write (nout,99998) 'ABSERR', 'estimate of the absolute error', abserr
        Write (nout,99997) 'IW(1)', 'number of subintervals used ', iw(1)

      End Do funs

99999 Format (1X,A6,' - ',A32,' = ',F10.4)
99998 Format (1X,A6,' - ',A32,' = ',E9.2)
99997 Format (1X,A6,' - ',A32,' = ',I4)
99996 Format (1X,A6,' - ',A32,' = ',F9.5)
    End Program d01apfe