!   D01EAF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: mulcls = 1, ndim = 4, nfun = 10, &
                                              nout = 6
       INTEGER, PARAMETER                  :: ircls = 2**ndim + 2*ndim*(ndim + &
                                              1) + 1
       INTEGER, PARAMETER                  ::                                  &
                                             lenwrk = (ndim+nfun+2)*(10+mulcls)
       INTEGER, PARAMETER                  :: mxcls = mulcls*ircls
    CONTAINS
!dec$ attributes offload : mic :: funsub
       SUBROUTINE funsub(ndim,z,nfun,f)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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
          INTEGER                             :: i, n
!         .. Intrinsic Functions ..
          INTRINSIC                              log, real, sin
!         .. Executable Statements ..
          sum = 0.0E0_nag_wp

          DO n = 1, ndim
             sum = sum + real(n,kind=nag_wp)*z(n)
          END DO

          DO i = 1, nfun
             f(i) = log(sum)*sin(real(i,kind=nag_wp)+sum)
          END DO

          RETURN

!dec$ attributes offload : mic :: funsub
       END SUBROUTINE funsub
    END MODULE d01eafe_mod
    PROGRAM d01eafe

!      D01EAF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : d01eaf, nag_wp
       USE d01eafe_mod, ONLY : funsub, lenwrk, mxcls, ndim, nfun, nout
!      .. 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
