!   E05JBF Example Program Text
!   Mark 24 Release. NAG Copyright 2012.

    Module e05jbfe_mod

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

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter                   :: lcomm = 100, nin = 5, nout = 6
!     .. Local Scalars ..
      Logical                              :: plot
    Contains
      Subroutine outbox(n,boxl,boxu)

!       Displays edges of box with bounds BOXL and BOXU in format suitable
!       for plotting.

!       .. Scalar Arguments ..
        Integer, Intent (In)                 :: n
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (In)      :: boxl(n), boxu(n)
!       .. Executable Statements ..
        Write (nout,99999) boxl(1), boxl(2)
        Write (nout,99999) boxl(1), boxu(2)
        Write (nout,99998)
        Write (nout,99999) boxl(1), boxl(2)
        Write (nout,99999) boxu(1), boxl(2)
        Write (nout,99998)
        Write (nout,99999) boxl(1), boxu(2)
        Write (nout,99999) boxu(1), boxu(2)
        Write (nout,99998)
        Write (nout,99999) boxu(1), boxl(2)
        Write (nout,99999) boxu(1), boxu(2)
        Write (nout,99998)

        Return

99999   Format (F20.15,1X,F20.15)
99998   Format (A)
      End Subroutine outbox
      Subroutine objfun(n,x,f,nstate,iuser,ruser,inform)

!       Routine to evaluate E05JBF objective function.

!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (Out)     :: f
        Integer, Intent (Out)                :: inform
        Integer, Intent (In)                 :: n, nstate
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Inout)   :: ruser(*)
        Real (Kind=nag_wp), Intent (In)      :: x(n)
        Integer, Intent (Inout)              :: iuser(*)
!       .. Local Scalars ..
        Real (Kind=nag_wp)                   :: x1, x2
!       .. Intrinsic Procedures ..
        Intrinsic                            :: exp
!       .. Executable Statements ..
        inform = 0

        If (inform>=0) Then

!         If INFORM>=0 then we're prepared to evaluate OBJFUN
!         at the current X

          If (nstate==1) Then

!           This is the first call to OBJFUN

            Write (nout,*)
            Write (nout,99999)
          End If

          x1 = x(1)
          x2 = x(2)

          f = 3.0E0_nag_wp*(1.0E0_nag_wp-x1)**2*exp(-(x1**2)-(x2+1.0E0_nag_wp) &
            **2) - 1.0E1_nag_wp*(x1/5.0E0_nag_wp-x1**3-x2**5)*exp(-x1**2-x2**2 &
            ) - 1.0E0_nag_wp/3.0E0_nag_wp*exp(-(x1+1.0E0_nag_wp)**2-x2**2)
        End If

        Return

99999   Format (1X,'(OBJFUN was just called for the first time)')
      End Subroutine objfun
      Subroutine monit(n,ncall,xbest,icount,ninit,list,numpts,initpt,nbaskt, &
        xbaskt,boxl,boxu,nstate,iuser,ruser,inform)

!       Monitoring routine for E05JBF.

!       .. Scalar Arguments ..
        Integer, Intent (Out)                :: inform
        Integer, Intent (In)                 :: n, nbaskt, ncall, ninit, nstate
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (In)      :: boxl(n), boxu(n),              &
                                                list(n,ninit),                 &
                                                xbaskt(n,nbaskt), xbest(n)
        Real (Kind=nag_wp), Intent (Inout)   :: ruser(*)
        Integer, Intent (In)                 :: icount(6), initpt(n), numpts(n)
        Integer, Intent (Inout)              :: iuser(*)
!       .. Local Scalars ..
        Integer                              :: i, j
!       .. Executable Statements ..
        inform = 0

        If (inform>=0) Then

!         We are going to allow the iterations to continue.

          If (nstate==0 .Or. nstate==1) Then

!           When NSTATE==1, MONIT is called for the first time. When
!           NSTATE==0, MONIT is called for the first AND last time.
!           Display a welcome message

            Write (nout,*)
            Write (nout,99999)
            Write (nout,*)

            If (plot .And. (n==2)) Then
              Write (nout,99998)
              Write (nout,*)
            End If

          End If

          If (plot .And. (n==2)) Then

!           Display the coordinates of the edges of the current search
!           box

            Call outbox(n,boxl,boxu)

          End If

          If (nstate<=0) Then

!           MONIT is called for the last time

            If (plot .And. (n==2)) Then
              Write (nout,99997)
              Write (nout,*)
            End If

            Write (nout,99996) icount(1)
            Write (nout,99995) ncall
            Write (nout,99994) icount(2)
            Write (nout,99993) icount(3)
            Write (nout,99992) icount(4)
            Write (nout,99991) icount(5)
            Write (nout,99990) icount(6)
            Write (nout,99989) nbaskt
            Write (nout,99988)

            Do i = 1, n
              Write (nout,99987) i, (xbaskt(i,j),j=1,nbaskt)
            End Do

            Write (nout,*)
            Write (nout,99986)
            Write (nout,*)
          End If

        End If

        Return

99999   Format (1X,'*** Begin monitoring information ***')
99998   Format (1X,'<Begin displaying search boxes>')
99997   Format (1X,'<End displaying search boxes>')
99996   Format (1X,'Total sub-boxes =',I5)
99995   Format (1X,'Total function evaluations =',I5)
99994   Format (1X,'Total function evaluations used in local search =',I5)
99993   Format (1X,'Total points used in local search =',I5)
99992   Format (1X,'Total sweeps through levels =',I5)
99991   Format (1X,'Total splits by init. list =',I5)
99990   Format (1X,'Lowest level with nonsplit boxes =',I5)
99989   Format (1X,'Number of candidate minima in the "shopping basket','" =', &
          I5)
99988   Format (1X,'Shopping basket:')
99987   Format (1X,'XBASKT(',I3,',:) =',(6F9.5))
99986   Format (1X,'*** End monitoring information ***')
      End Subroutine monit
    End Module e05jbfe_mod
    Program e05jbfe

!     E05JBF Example Main Program

!     .. Use Statements ..
      Use nag_library, Only: e05jaf, e05jbf, nag_wp
      Use e05jbfe_mod, Only: lcomm, monit, nin, nout, objfun, plot
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)                   :: obj
      Integer                              :: i, ibound, ifail, iinit, n, sdlist
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable      :: bl(:), bu(:), comm(:),           &
                                              list(:,:), x(:)
      Real (Kind=nag_wp)                   :: ruser(1)
      Integer, Allocatable                 :: initpt(:), numpts(:)
      Integer                              :: iuser(1)
!     .. Executable Statements ..
      Write (nout,*) 'E05JBF Example Program Results'

!     Skip heading in data file
      Read (nin,*)

      Read (nin,*) n, sdlist

      Allocate (bl(n),bu(n),list(n,sdlist),numpts(n),initpt(n),x(n), &
        comm(lcomm))

      Read (nin,*) ibound

      If (ibound==0) Then

!       Read in the whole of each bound

        Read (nin,*)(bl(i),i=1,n)
        Read (nin,*)(bu(i),i=1,n)
      Else If (ibound==3) Then

!       Bounds are uniform: read in only the first entry of each

        Read (nin,*) bl(1)
        Read (nin,*) bu(1)
      End If

      Read (nin,*) iinit

!     PLOT determines whether MONIT displays information on the
!     current search box:

      Read (nin,*) plot

!     The first argument to E05JAF is a legacy argument and has no
!     significance.

      ifail = 0
      Call e05jaf(0,comm,lcomm,ifail)

!     Solve the problem.

      ifail = 0
      Call e05jbf(n,objfun,ibound,iinit,bl,bu,sdlist,list,numpts,initpt,monit, &
        x,obj,comm,lcomm,iuser,ruser,ifail)

      Write (nout,*)
      Write (nout,99999) obj
      Write (nout,99998)(x(i),i=1,n)

99999 Format (1X,'Final objective value =',F11.5)
99998 Format (1X,'Global optimum X =',2F9.5)
    End Program e05jbfe
