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

    MODULE e05jcfe_mod

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

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
       USE nag_library, ONLY : x04baf, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER                  :: lcomm = 100, nin = 5,            &
                                              ninopt = 7, 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)
!         .. Local Scalars ..
          CHARACTER (80)                      :: rec
!         .. Executable Statements ..
          WRITE (rec,99999) boxl(1), boxl(2)
          CALL x04baf(nout,rec)
          WRITE (rec,99999) boxl(1), boxu(2)
          CALL x04baf(nout,rec)
          WRITE (rec,'()')
          CALL x04baf(nout,rec)
          WRITE (rec,99999) boxl(1), boxl(2)
          CALL x04baf(nout,rec)
          WRITE (rec,99999) boxu(1), boxl(2)
          CALL x04baf(nout,rec)
          WRITE (rec,'()')
          CALL x04baf(nout,rec)
          WRITE (rec,99999) boxl(1), boxu(2)
          CALL x04baf(nout,rec)
          WRITE (rec,99999) boxu(1), boxu(2)
          CALL x04baf(nout,rec)
          WRITE (rec,'()')
          CALL x04baf(nout,rec)
          WRITE (rec,99999) boxu(1), boxl(2)
          CALL x04baf(nout,rec)
          WRITE (rec,99999) boxu(1), boxu(2)
          CALL x04baf(nout,rec)
          WRITE (rec,'()')
          CALL x04baf(nout,rec)

          RETURN

99999     FORMAT (F20.15,1X,F20.15)
!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
          CHARACTER (80)                      :: rec
!         .. 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 (rec,'()')
                CALL x04baf(nout,rec)
                WRITE (rec,99999)
                CALL x04baf(nout,rec)
             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
          CHARACTER (80)                      :: rec
!         .. 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.EQ.1, MONIT is called for the first time. When
!               NSTATE.EQ.0, MONIT is called for the first AND last time.
!               Display a welcome message

                WRITE (rec,'()')
                CALL x04baf(nout,rec)
                WRITE (rec,99999)
                CALL x04baf(nout,rec)
                WRITE (rec,'()')
                CALL x04baf(nout,rec)

                IF (plot .AND. (n==2)) THEN
                   WRITE (rec,99998)
                   CALL x04baf(nout,rec)
                   WRITE (rec,'()')
                   CALL x04baf(nout,rec)
                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 (rec,99997)
                   CALL x04baf(nout,rec)
                   WRITE (rec,'()')
                   CALL x04baf(nout,rec)
                END IF

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

                DO i = 1, n
                   WRITE (rec,99987) i, (xbaskt(i,j),j=1,nbaskt)
                   CALL x04baf(nout,rec)
                END DO

                WRITE (rec,'()')
                CALL x04baf(nout,rec)
                WRITE (rec,99986)
                CALL x04baf(nout,rec)
                WRITE (rec,'()')
                CALL x04baf(nout,rec)
             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 e05jcfe_mod
    PROGRAM e05jcfe

!      E05JCF Example Main Program

!      This program demonstrates the use of routines to set and get
!      values of optional parameters associated with E05JBF

!      .. Use Statements ..
       USE nag_library, ONLY : e05jaf, e05jbf, e05jcf, e05jdf, e05jef, e05jff, &
                               e05jgf, e05jhf, e05jjf, e05jkf, e05jlf, nag_wp, &
                               x04acf, x04baf
       USE e05jcfe_mod, ONLY : lcomm, monit, nin, ninopt, nout, objfun, plot
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       CHARACTER (*), PARAMETER            :: fname = 'e05jcfe.opt'
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: loctol, obj
       INTEGER                             :: i, ibdchk, ibound, ifail, iinit, &
                                              j, loclim, mode, n, n_r, sdlist, &
                                              stclim
       CHARACTER (3)                       :: lcsrch
       CHARACTER (80)                      :: rec
!      .. 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)
!      .. Intrinsic Functions ..
       INTRINSIC                              count, sqrt, trim
!      .. Executable Statements ..
       WRITE (rec,99992) 'E05JCF Example Program Results'
       CALL x04baf(nout,rec)

!      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

       IF (iinit==3) THEN

!         User is specifying the initialization list

          READ (nin,*) (numpts(i),i=1,n)
          READ (nin,*) ((list(i,j),j=1,numpts(i)),i=1,n)
          READ (nin,*) (initpt(i),i=1,n)
       END IF

!      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)

!      Open the options file for reading

       mode = 0

       ifail = 0
       CALL x04acf(ninopt,fname,mode,ifail)

!      Use E05JCF to read some options from the options file

       ifail = 0
       CALL e05jcf(ninopt,comm,lcomm,ifail)

       WRITE (rec,'()')
       CALL x04baf(nout,rec)

!      Use E05JKF to find the value of the integer-valued option
!      'Local Searches Limit'

       ifail = 0
       CALL e05jkf('Local Searches Limit',loclim,comm,lcomm,ifail)

       WRITE (rec,99999) loclim
       CALL x04baf(nout,rec)

!      Compute the number of free variables, then use E05JFF to set the value of
!      the integer-valued option 'Static Limit'

       n_r = count(bl(1:n)/=bu(1:n))
       stclim = 4*n_r

       ifail = 0
       CALL e05jff('Static Limit',stclim,comm,lcomm,ifail)

!      Use E05JHF to determine whether the real-valued option
!      'Infinite Bound Size' has been set by us (in which case
!      E05JHF returns 1) or whether it holds its default value
!      (E05JHF returns 0)

       ifail = 0
       ibdchk = e05jhf('Infinite Bound Size',comm,lcomm,ifail)

       IF (ibdchk==1) THEN
          WRITE (rec,99998)
          CALL x04baf(nout,rec)
       ELSE IF (ibdchk==0) THEN
          WRITE (rec,99997)
          CALL x04baf(nout,rec)
       END IF

!      Use E05JLF/E05JGF to set the real-valued option
!      'Local Searches Tolerance' to the square root of its default

       ifail = 0
       CALL e05jlf('Local Searches Tolerance',loctol,comm,lcomm,ifail)

       ifail = 0
       CALL e05jgf('Local Searches Tolerance',sqrt(loctol),comm,lcomm,ifail)

!      Use E05JLF to get the new value of 'Local Searches Tolerance'

       ifail = 0
       CALL e05jlf('Local Searches Tolerance',loctol,comm,lcomm,ifail)

       WRITE (rec,99996) loctol
       CALL x04baf(nout,rec)

!      Use E05JDF to set the option 'Minimize' (which is the default)

       ifail = 0
       CALL e05jdf('Minimize',comm,lcomm,ifail)

!      Use E05JEF to set the option 'Local Searches' to 'On' (also
!      the default)

       lcsrch = 'On'

       ifail = 0
       CALL e05jef('Local Searches',lcsrch,comm,lcomm,ifail)

!      Get that value of 'Local Searches' using E05JJF

       ifail = 0
       CALL e05jjf('Local Searches',lcsrch,comm,lcomm,ifail)

       WRITE (rec,99995) trim(lcsrch)
       CALL x04baf(nout,rec)

!      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 (rec,'()')
       CALL x04baf(nout,rec)
       WRITE (rec,99994) obj
       CALL x04baf(nout,rec)
       WRITE (rec,99993) (x(i),i=1,n)
       CALL x04baf(nout,rec)

99999  FORMAT (1X,'Option "Local Searches Limit" has the value ',I6,'.')
99998  FORMAT (1X,'Option "Infinite Bound Size" has been set by us.')
99997  FORMAT (1X,'Option "Infinite Bound Size" holds its default value.')
99996  FORMAT (1X,'Option "Local Searches Tolerance" has the value ',E13.5, &
          '.')
99995  FORMAT (1X,'Option "Local Searches" has the value "',A,'".')
99994  FORMAT (1X,'Final objective value =',F11.5)
99993  FORMAT (1X,'Global optimum X =',2F9.5)
99992  FORMAT (1X,A)
    END PROGRAM e05jcfe
