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

    Module d01eafe_mod

!     D01EAF 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                           :: funsub
!     .. Parameters ..
      Integer, Parameter               :: mulcls = 1
      Integer, Parameter, Public       :: ndim = 4, nfun = 10, nout = 6
      Integer, Parameter               :: ircls = 2**ndim + 2*ndim*(ndim+1) +  &
                                          1
      Integer, Parameter, Public       :: lenwrk = (ndim+nfun+2)*(10+mulcls)
      Integer, Parameter, Public       :: mxcls = mulcls*ircls
    Contains
      Subroutine funsub(ndim,z,nfun,f)

!       .. Scalar Arguments ..
        Integer, Intent (In)           :: ndim, nfun
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: f(nfun)
        Real (Kind=nag_wp), Intent (In) :: z(ndim)
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: sum_nag
        Integer                        :: i, n
!       .. Intrinsic Procedures ..
        Intrinsic                      :: log, real, sin
!       .. Executable Statements ..
        sum_nag = 0.0E0_nag_wp

        Do n = 1, ndim
          sum_nag = sum_nag + real(n,kind=nag_wp)*z(n)
        End Do

        Do i = 1, nfun
          f(i) = log(sum_nag)*sin(real(i,kind=nag_wp)+sum_nag)
        End Do

        Return

      End Subroutine funsub
    End Module d01eafe_mod
    Program d01eafe

!     D01EAF Example Main Program

!     .. Use Statements ..
      Use d01eafe_mod, Only: funsub, lenwrk, mxcls, ndim, nfun, nout
      Use nag_library, Only: d01eaf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: absreq, relreq
      Integer                          :: i, ifail, maxcls, mincls, mulfac
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: a(:), absest(:), b(:), finest(:),    &
                                          wrkstr(:)
!     .. Executable Statements ..
      Write (nout,*) 'D01EAF Example Program Results'
      Flush (nout)

      Allocate (a(ndim),absest(nfun),b(ndim),finest(nfun),wrkstr(lenwrk))

      a(1:ndim) = 0.0_nag_wp
      b(1:ndim) = 1.0_nag_wp
      mincls = 0
      maxcls = mxcls
      absreq = 0.0_nag_wp
      relreq = 1.0E-3_nag_wp

      If (ndim<=10) Then
        mulfac = 2**ndim
      Else
        mulfac = 2*ndim**3
      End If

loop: Do

        ifail = -1
        Call d01eaf(ndim,a,b,mincls,maxcls,nfun,funsub,absreq,relreq,lenwrk,   &
          wrkstr,finest,absest,ifail)

        Select Case (ifail)
        Case (1,3)
          Write (nout,*)
          Write (nout,99999) mincls
          Write (nout,99998)

          Do i = 1, nfun
            Write (nout,99997) i, finest(i), absest(i)
          End Do

          Write (nout,*)
          Flush (nout)
          mincls = -1
          maxcls = maxcls*mulfac
        Case (0)
          Write (nout,*)
          Write (nout,99996) mincls
          Write (nout,99998)

          Do i = 1, nfun
            Write (nout,99997) i, finest(i), absest(i)
          End Do

          Exit loop
        Case Default
          Exit loop
        End Select

      End Do loop

99999 Format (1X,'Results so far (',I7,' FUNSUB calls in last call of D01EAF)' &
        )
99998 Format (/,1X,'   I       Integral   Estimated error')
99997 Format (1X,I4,2F14.4)
99996 Format (1X,'Final Results (',I7,' FUNSUB calls in last call of D01EAF)')
    End Program d01eafe