* E05JBF Example Program Text * Mark 22 Release. NAG Copyright 2007. * * .. Implicit None Statement .. IMPLICIT NONE * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER N, NINMAX, LCOMM PARAMETER (N=2,NINMAX=192,LCOMM=100) * .. Local Scalars .. DOUBLE PRECISION OBJ INTEGER I, IBOUND, IFAIL, IINIT, SDLIST LOGICAL LPLOT * .. Local Arrays .. DOUBLE PRECISION BL(N), BU(N), COMM(LCOMM), LIST(N,NINMAX), + RUSER(1), X(N) INTEGER INITPT(N), IUSER(2), NUMPTS(N) * .. External Subroutines .. EXTERNAL E05JAF, E05JBF, MONIT, OBJFUN * .. Executable Statements .. CONTINUE * WRITE (NOUT,*) 'E05JBF Example Program Results' * * Skip heading in data file * READ (NIN,*) * * Read SDLIST from data file * READ (NIN,*) SDLIST * IF (SDLIST.LE.NINMAX) THEN * * Read IBOUND, BL, and BU from data file * READ (NIN,*) IBOUND * IF (IBOUND.EQ.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.EQ.3) THEN * * Bounds are uniform: read in only the first entry of each * READ (NIN,*) BL(1) READ (NIN,*) BU(1) * END IF * * Read in IINIT * READ (NIN,*) IINIT * * Read LPLOT. Its value determines whether MONIT displays * information on the current search box * READ (NIN,*) LPLOT * * Communicate NOUT and LPLOT through to callbacks * IUSER(1) = NOUT * IF (LPLOT) THEN IUSER(2) = 1 ELSE IUSER(2) = 0 END IF * * Call E05JAF to initialize E05JBF * IFAIL = -1 CALL E05JAF(N,COMM,LCOMM,IFAIL) * IF (IFAIL.EQ.0) THEN * * Solve the problem. * IFAIL = 1 CALL E05JBF(N,OBJFUN,IBOUND,IINIT,BL,BU,SDLIST,LIST,NUMPTS, + INITPT,MONIT,X,OBJ,COMM,LCOMM,IUSER,RUSER,IFAIL) * WRITE (NOUT,*) * IF (IFAIL.GE.0) THEN WRITE (NOUT,99999) IFAIL * IF (IFAIL.EQ.0) THEN WRITE (NOUT,99998) OBJ WRITE (NOUT,99997) (X(I),I=1,N) END IF * ELSE WRITE (NOUT,99996) IFAIL END IF * END IF * END IF * 99999 FORMAT (1X,'On exit from E05JBF, IFAIL =',I5) 99998 FORMAT (1X,'Final objective value =',F11.5) 99997 FORMAT (1X,'Global optimum X =',2F9.5) 99996 FORMAT (1X,' ** E05JBF returned with IFAIL = ',I5) END SUBROUTINE OBJFUN(N,X,F,NSTATE,IUSER,RUSER,INFORM) * * Routine to evaluate E05JBF objective function. * Mark 22 Release. NAG Copyright 2007. * * .. Scalar Arguments .. DOUBLE PRECISION F INTEGER INFORM, N, NSTATE * .. Array Arguments .. DOUBLE PRECISION RUSER(*), X(N) INTEGER IUSER(*) * .. Local Scalars .. DOUBLE PRECISION X1, X2 INTEGER NOUT * .. Intrinsic Functions .. INTRINSIC EXP * .. Executable Statements .. CONTINUE * INFORM = 0 * IF (INFORM.GE.0) THEN * * If INFORM >= 0 then we're prepared to evaluate OBJFUN * at the current X * IF (NSTATE.EQ.1) THEN * * This is the first call to OBJFUN * NOUT = IUSER(1) WRITE (NOUT,*) WRITE (NOUT,99999) END IF * X1 = X(1) X2 = X(2) * F = 3.0D0*(1.0D0-X1)**2*EXP(-(X1**2)-(X2+1)**2) - + 1.0D1*(X1/5.0D0-X1**3-X2**5)*EXP(-X1**2-X2**2) - + 1.0D0/3.0D0*EXP(-(X1+1.0D0)**2-X2**2) END IF * RETURN * 99999 FORMAT (1X,'(OBJFUN was just called for the first time)') END SUBROUTINE MONIT(N,NCALL,XBEST,ICOUNT,NINIT,LIST,NUMPTS,INITPT, + NBASKT,XBASKT,BOXL,BOXU,NSTATE,IUSER,RUSER, + INFORM) * * Monitoring routine for E05JBF. * Mark 22 Release. NAG Copyright 2007. * * .. Scalar Arguments .. INTEGER INFORM, N, NBASKT, NCALL, NINIT, NSTATE * .. Array Arguments .. DOUBLE PRECISION BOXL(N), BOXU(N), LIST(N,NINIT), RUSER(*), + XBASKT(N,NBASKT), XBEST(N) INTEGER ICOUNT(6), INITPT(N), IUSER(*), NUMPTS(N) * .. Local Scalars .. INTEGER I, IPLOT, J, NOUT * .. External Subroutines .. EXTERNAL OUTBOX * .. Executable Statements .. CONTINUE * INFORM = 0 * IF (INFORM.GE.0) THEN * * We are going to allow the iterations to continue. * Extract NOUT and PLOT from the integer communication-array * NOUT = IUSER(1) IPLOT = IUSER(2) * IF (NSTATE.EQ.0 .OR. NSTATE.EQ.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 (NOUT,*) WRITE (NOUT,99999) WRITE (NOUT,*) * IF ((IPLOT.EQ.1) .AND. (N.EQ.2)) THEN WRITE (NOUT,99998) WRITE (NOUT,*) END IF * END IF * IF ((IPLOT.EQ.1) .AND. (N.EQ.2)) THEN * * Display the coordinates of the edges of the current search * box * CALL OUTBOX(N,BOXL,BOXU,NOUT) * END IF * IF (NSTATE.LE.0) THEN * * MONIT is called for the last time * IF ((IPLOT.EQ.1) .AND. (N.EQ.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 20 I = 1, N WRITE (NOUT,99987) I, (XBASKT(I,J),J=1,NBASKT) 20 CONTINUE * 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 OUTBOX(N,BOXL,BOXU,NOUT) * * Displays edges of box with bounds BOXL and BOXU in format suitable * for plotting. * Mark 22 Release. NAG Copyright 2007. * * .. Scalar Arguments .. INTEGER N, NOUT * .. Array Arguments .. DOUBLE PRECISION BOXL(N), BOXU(N) * .. Executable Statements .. CONTINUE * 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