! E05JBF Example Program Text
! Mark 30.3 Release. nAG Copyright 2024.
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
! .. Accessibility Statements ..
Private
Public :: monit, objfun
! .. Parameters ..
Integer, Parameter, Public :: lcomm = 100, nin = 5, nout = 6
! .. Local Scalars ..
Logical, Public, Save :: plot
Contains
Subroutine outbox(boxl,boxu)
! Displays edges of box with bounds BOXL and BOXU in format suitable
! for plotting.
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (In) :: boxl(2), boxu(2)
! .. 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 ..
! This is a two-dimensional objective function.
! As an example of using the inform mechanism,
! terminate if any other problem size is supplied.
If (n/=2) Then
inform = -1
Else
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
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
! .. 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,*)
Write (nout,99998)
Do i = 1, n
Write (nout,99997)
Write (nout,99996) i
Write (nout,99995) numpts(i)
Write (nout,99994)
Write (nout,99993) list(i,1:numpts(i))
Write (nout,99992) initpt(i)
End Do
If (plot .And. (n==2)) Then
Write (nout,99991)
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(boxl,boxu)
End If
If (nstate<=0) Then
! MONIT is called for the last time
If (plot .And. (n==2)) Then
Write (nout,99990)
Write (nout,*)
End If
Write (nout,99989) icount(1)
Write (nout,99988) 20*((ncall+10)/20)
Write (nout,99987) 15*((icount(2)+7)/15)
Write (nout,99986) icount(3)
Write (nout,99985) icount(4)
Write (nout,99984) icount(5)
Write (nout,99983) icount(6)
Write (nout,99982) nbaskt
Write (nout,99981)
Do i = 1, n
Write (nout,99980) i, xbaskt(i,1:nbaskt)
End Do
Write (nout,99979)
Write (nout,99978) xbest(1:n)
Write (nout,*)
Write (nout,99977)
Write (nout,*)
End If
End If
Return
99999 Format (1X,'*** Begin monitoring information ***')
99998 Format (1X,'Values controlling initial splitting of a box:')
99997 Format (1X,'**')
99996 Format (1X,'In dimension ',I5)
99995 Format (1X,'Extent of initialization list in this dimension =',I5)
99994 Format (1X,'Initialization points in this dimension:')
99993 Format (1X,'LIST(I,1:NUMPTS(I)) =',(6F9.5))
99992 Format (1X,'Initial point in this dimension: LIST(I,',I5,')')
99991 Format (1X,'<Begin displaying search boxes>')
99990 Format (1X,'<End displaying search boxes>')
99989 Format (1X,'Total sub-boxes =',I5)
99988 Format (1X,'Total function evaluations (rounded to nearest 20) =',I5)
99987 Format (1X,'Total function evaluations used in local search (rounded', &
/,3X,'to nearest 15) =',I5)
99986 Format (1X,'Total points used in local search =',I5)
99985 Format (1X,'Total sweeps through levels =',I5)
99984 Format (1X,'Total splits by init. list =',I5)
99983 Format (1X,'Lowest level with nonsplit boxes =',I5)
99982 Format (1X,'Number of candidate minima in the "shopping basket','" =', &
I5)
99981 Format (1X,'Shopping basket:')
99980 Format (1X,'XBASKT(',I3,',:) =',(6F9.5))
99979 Format (1X,'Best point:')
99978 Format (1X,'XBEST =',(6F9.5))
99977 Format (1X,'*** End monitoring information ***')
End Subroutine monit
End Module e05jbfe_mod
Program e05jbfe
! E05JBF Example Main Program
! .. Use Statements ..
Use e05jbfe_mod, Only: lcomm, monit, nin, nout, objfun, plot
Use nag_library, Only: e05jaf, e05jbf, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: n = 2
! .. Local Scalars ..
Real (Kind=nag_wp) :: obj
Integer :: i, ibound, ifail, iinit, sdlist
! .. Local Arrays ..
Real (Kind=nag_wp) :: bl(n), bu(n), comm(lcomm), ruser(1), &
x(n)
Real (Kind=nag_wp), Allocatable :: list(:,:)
Integer :: initpt(n), iuser(1), numpts(n)
! .. Executable Statements ..
Write (nout,*) 'E05JBF Example Program Results'
! Skip heading in data file
Read (nin,*)
Read (nin,*) sdlist
Allocate (list(n,sdlist))
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