*     D01EAF Example Program Text
*     Mark 14 Revised. NAG Copyright 1989.
*     .. Parameters ..
      INTEGER          NDIM, NFUN, IRCLS, MXCLS, LENWRK
      PARAMETER        (NDIM=4,NFUN=10,
     +                 IRCLS=2**NDIM+2*NDIM*NDIM+2*NDIM+1,MXCLS=IRCLS,
     +                 LENWRK=6*NDIM+9*NFUN+(NDIM+NFUN+2)
     +                 *(1+MXCLS/IRCLS))
      INTEGER          NOUT
      PARAMETER        (NOUT=6)
*     .. Local Scalars ..
      DOUBLE PRECISION ABSREQ, RELREQ
      INTEGER          I, IFAIL, MAXCLS, MINCLS, MULFAC, N
*     .. Local Arrays ..
      DOUBLE PRECISION A(NDIM), ABSEST(NFUN), B(NDIM), FINEST(NFUN),
     +                 WRKSTR(LENWRK)
*     .. External Subroutines ..
      EXTERNAL         D01EAF, FUNSUB
*     .. Executable Statements ..
      WRITE (NOUT,*) 'D01EAF Example Program Results'
      DO 20 N = 1, NDIM
         A(N) = 0.0D0
         B(N) = 1.0D0
   20 CONTINUE
      MINCLS = 0
      MAXCLS = MXCLS
      ABSREQ = 0.0D0
      RELREQ = 1.0D-3
      IF (NDIM.LE.10) THEN
         MULFAC = 2**NDIM
      ELSE
         MULFAC = 2*NDIM**3
      END IF
   40 IFAIL = -1
*
      CALL D01EAF(NDIM,A,B,MINCLS,MAXCLS,NFUN,FUNSUB,ABSREQ,RELREQ,
     +            LENWRK,WRKSTR,FINEST,ABSEST,IFAIL)
*
      WRITE (NOUT,*)
      IF (IFAIL.GT.0) THEN
         IF (IFAIL.EQ.1 .OR. IFAIL.EQ.3) THEN
            WRITE (NOUT,99999) 'Results so far (', MINCLS,
     +        ' FUNSUB calls in last call of D01EAF)'
            WRITE (NOUT,*)
            WRITE (NOUT,*) '   I       Integral   Estimated error'
            DO 60 I = 1, NFUN
               WRITE (NOUT,99998) I, FINEST(I), ABSEST(I)
   60       CONTINUE
            WRITE (NOUT,*)
            MINCLS = -1
            MAXCLS = MAXCLS*MULFAC
            GO TO 40
         END IF
      ELSE
         WRITE (NOUT,99999) 'Final results (', MINCLS,
     +     ' FUNSUB calls in last call of D01EAF)'
         WRITE (NOUT,*)
         WRITE (NOUT,*) '   I       Integral   Estimated error'
         DO 80 I = 1, NFUN
            WRITE (NOUT,99998) I, FINEST(I), ABSEST(I)
   80    CONTINUE
      END IF
      STOP
*
99999 FORMAT (1X,A,I7,A)
99998 FORMAT (1X,I4,2F14.4)
      END
*
      SUBROUTINE FUNSUB(NDIM,Z,NFUN,F)
*     .. Scalar Arguments ..
      INTEGER           NDIM, NFUN
*     .. Array Arguments ..
      DOUBLE PRECISION  F(NFUN), Z(NDIM)
*     .. Local Scalars ..
      DOUBLE PRECISION  SUM
      INTEGER           I, N
*     .. Intrinsic Functions ..
      INTRINSIC         DBLE, LOG, SIN
*     .. Executable Statements ..
      SUM = 0.0D0
      DO 20 N = 1, NDIM
         SUM = SUM + DBLE(N)*Z(N)
   20 CONTINUE
      DO 40 I = 1, NFUN
         F(I) = LOG(SUM)*SIN(DBLE(I)+SUM)
   40 CONTINUE
      RETURN
      END
