*     D01FBF Example Program Text
*     Mark 14 Revised. NAG Copyright 1989.
*     .. Parameters ..
      INTEGER          NDIM, LWAMAX
      PARAMETER        (NDIM=4,LWAMAX=16)
      INTEGER          NOUT
      PARAMETER        (NOUT=6)
*     .. Local Scalars ..
      DOUBLE PRECISION A, ANS, B
      INTEGER          I, IFAIL, ITYPE, IW, LWA
*     .. Local Arrays ..
      DOUBLE PRECISION ABSCIS(LWAMAX), WEIGHT(LWAMAX)
      INTEGER          NPTVEC(NDIM)
*     .. External Functions ..
      DOUBLE PRECISION D01FBF, FUN
      EXTERNAL         D01FBF, FUN
*     .. External Subroutines ..
      EXTERNAL         D01BAW, D01BAX, D01BAY, D01BAZ, D01BBF
*     .. Data statements ..
      DATA             NPTVEC/4, 4, 4, 4/
*     .. Executable Statements ..
      WRITE (NOUT,*) 'D01FBF Example Program Results'
      LWA = 0
      DO 20 I = 1, NDIM
         LWA = LWA + NPTVEC(I)
   20 CONTINUE
      IF (LWAMAX.GE.LWA) THEN
         ITYPE = 1
         IW = 1
         DO 40 I = 1, 4
            IFAIL = 1
*
            IF (I.EQ.1) THEN
               A = 1.0D0
               B = 2.0D0
               CALL D01BBF(D01BAZ,A,B,ITYPE,NPTVEC(I),WEIGHT(IW),
     +                     ABSCIS(IW),IFAIL)
            ELSE IF (I.EQ.2) THEN
               A = 0.0D0
               B = 2.0D0
               CALL D01BBF(D01BAX,A,B,ITYPE,NPTVEC(I),WEIGHT(IW),
     +                     ABSCIS(IW),IFAIL)
            ELSE IF (I.EQ.3) THEN
               A = 0.0D0
               B = 0.5D0
               CALL D01BBF(D01BAW,A,B,ITYPE,NPTVEC(I),WEIGHT(IW),
     +                     ABSCIS(IW),IFAIL)
            ELSE IF (I.EQ.4) THEN
               A = 1.0D0
               B = 2.0D0
               CALL D01BBF(D01BAY,A,B,ITYPE,NPTVEC(I),WEIGHT(IW),
     +                     ABSCIS(IW),IFAIL)
            END IF
*
            IF (IFAIL.NE.0) THEN
               WRITE (NOUT,*)
               WRITE (NOUT,99998) ' ** D01BBF returned with IFAIL = ',
     +           IFAIL
               GO TO 60
            END IF
*
            IW = IW + NPTVEC(I)
   40    CONTINUE
*
         IFAIL = 1
*
         ANS = D01FBF(NDIM,NPTVEC,LWA,WEIGHT,ABSCIS,FUN,IFAIL)
*
         WRITE (NOUT,*)
         IF (IFAIL.EQ.0) THEN
            WRITE (NOUT,99999) 'Answer = ', ANS
         ELSE
            WRITE (NOUT,*)
            WRITE (NOUT,99998) ' ** D01FBF returned with IFAIL = ',
     +        IFAIL
         END IF
      END IF
   60 CONTINUE
*
99999 FORMAT (1X,A,F10.5)
99998 FORMAT (1X,A,I5)
      END
*
      DOUBLE PRECISION FUNCTION FUN(NDIM,X)
*     .. Scalar Arguments ..
      INTEGER          NDIM
*     .. Array Arguments ..
      DOUBLE PRECISION X(NDIM)
*     .. Intrinsic Functions ..
      INTRINSIC        EXP
*     .. Executable Statements ..
      FUN = (X(1)*X(2)*X(3))**6/(X(4)+2.0D0)**8*EXP(-2.0D0*X(2)
     +      -0.5D0*X(3)*X(3))
      RETURN
      END