! 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 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) END SUBROUTINE outbox 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)') 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. ! .. 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,'') 99997 FORMAT (1X,'') 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