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

    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
!dec$ attributes offload : mic :: outbox
       SUBROUTINE outbox(n,boxl,boxu)

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

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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)
!dec$ attributes offload : mic :: outbox
       END SUBROUTINE outbox
!dec$ attributes offload : mic :: objfun
       SUBROUTINE objfun(n,x,f,nstate,iuser,ruser,inform)

!         Routine to evaluate E05JBF objective function.

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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 Functions ..
          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)')
!dec$ attributes offload : mic :: objfun
       END SUBROUTINE objfun
!dec$ attributes offload : mic :: monit
       SUBROUTINE monit(n,ncall,xbest,icount,ninit,list,numpts,initpt,nbaskt, &
             xbaskt,boxl,boxu,nstate,iuser,ruser,inform)

!         Monitoring routine for E05JBF.

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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 ***')
!dec$ attributes offload : mic :: monit
       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
