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

    MODULE d01fbfe_mod

!      D01FBF Example Program Module:
!             Parameters and User-defined Routines

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER                  :: ndim = 4, nout = 6
    CONTAINS
       FUNCTION fun(ndim,x)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: fun
!         .. Scalar Arguments ..
          INTEGER, INTENT (IN)                :: ndim
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: x(ndim)
!         .. Intrinsic Functions ..
          INTRINSIC                              exp
!         .. Executable Statements ..
          fun = (x(1)*x(2)*x(3))**6/(x(4)+2.0E0_nag_wp)**8* &
             exp(-2.0E0_nag_wp*x(2)-0.5E0_nag_wp*x(3)*x(3))

          RETURN

       END FUNCTION fun
    END MODULE d01fbfe_mod
    PROGRAM d01fbfe

!      D01FBF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : d01baw, d01bax, d01bay, d01baz, d01bbf, d01fbf, &
                               nag_wp
       USE d01fbfe_mod, ONLY : fun, ndim, nout
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: a, ans, b
       INTEGER                             :: i, ifail, itype, j, lwa
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: abscis(:), weight(:)
       INTEGER                             :: nptvec(ndim)
!      .. Intrinsic Functions ..
       INTRINSIC                              sum
!      .. Executable Statements ..
       WRITE (nout,*) 'D01FBF Example Program Results'

       nptvec(1:ndim) = (/ 4, 4, 4, 4/)
       lwa = sum(nptvec(1:ndim))
       ALLOCATE (abscis(lwa),weight(lwa))

       itype = 1
       j = 1

       DO i = 1, 4

          ifail = 0
          SELECT CASE (i)
          CASE (1)
             a = 1.0E0_nag_wp
             b = 2.0E0_nag_wp
             CALL d01bbf(d01baz,a,b,itype,nptvec(i),weight(j),abscis(j),ifail)
          CASE (2)
             a = 0.0E0_nag_wp
             b = 2.0E0_nag_wp
             CALL d01bbf(d01bax,a,b,itype,nptvec(i),weight(j),abscis(j),ifail)
          CASE (3)
             a = 0.0E0_nag_wp
             b = 0.5E0_nag_wp
             CALL d01bbf(d01baw,a,b,itype,nptvec(i),weight(j),abscis(j),ifail)
          CASE (4)
             a = 1.0E0_nag_wp
             b = 2.0E0_nag_wp
             CALL d01bbf(d01bay,a,b,itype,nptvec(i),weight(j),abscis(j),ifail)
          END SELECT

          j = j + nptvec(i)
       END DO

       ifail = 0
       ans = d01fbf(ndim,nptvec,lwa,weight,abscis,fun,ifail)

       WRITE (nout,*)
       WRITE (nout,99999) 'Answer = ', ans

99999  FORMAT (1X,A,F10.5)
    END PROGRAM d01fbfe