1C+-----------------------------------------------------------------------+
2C| Program       : main.f                                                |
3C| Last modified : 07-16-2001                                            |
4C| Written by    : Owen Esslinger, Joerg Gablonsky, Alton Patrick        |
5C| The main program to run DIRECT on test problems.                      |
6C+-----------------------------------------------------------------------+
7      PROGRAM main
8
9      IMPLICIT NONE
10      INTEGER Maxdim
11      PARAMETER (Maxdim = 128)
12      integer i, problem
13      external myfunc
14
15C+----------------------------------------------------------------------+
16C| DIRECT specific variables.                                           |
17C+----------------------------------------------------------------------+
18      Double Precision DIReps, DIRf
19      Integer DIRmaxf, DIRmaxT
20      Integer DIRalg
21      Integer IError, logfile
22      Double Precision fglobal, fglper, volper, sigmaper
23      double precision u(Maxdim), l(Maxdim)
24      integer n
25      Double Precision DIRx(Maxdim)
26
27C+-----------------------------------------------------------------------+
28C| Variables to pass user defined data to the function to be optimized.  |
29C+-----------------------------------------------------------------------+
30      INTEGER iisize, idsize, icsize
31      Parameter (iisize = 300)
32      Parameter (idsize = 300)
33      Parameter (icsize = 30)
34      INTEGER iidata(iisize)
35      Double Precision ddata(idsize)
36      Character*40 cdata(icsize)
37
38      Integer resultfile
39      double precision per2
40      real dtime,diff,tarray(2)
41C+----------------------------------------------------------------------+
42C|  Define and open the logfile and the resultfile, where we store the  |
43C|  results of the run. We save the problem number, the number of       |
44C|  function evaluations needed, the time used by DIRECT, the percent   |
45C|  error and a flag signaling if we used DIRECT or DIRECT-l in the     |
46C|  resultfile.                                                         |
47C+----------------------------------------------------------------------+
48      logfile    = 2
49      resultfile = 29
50      open(logfile, file='direct.out')
51      open(resultfile, file='result.out')
52      CALL mainheader(logfile)
53C+----------------------------------------------------------------------+
54C| Read in the problem specific data and the parameters for DIRECT.     |
55C+----------------------------------------------------------------------+
56        CALL inputdata(n, u, l, logfile, DIReps, DIRmaxf,
57     +       DIRmaxT, problem, Maxdim, DIRalg, fglobal,
58     + fglper, volper, sigmaper,
59     + iidata, iisize, ddata, idsize, cdata, icsize)
60C+----------------------------------------------------------------------+
61C| Initialize and start the timing.                                     |
62C+----------------------------------------------------------------------+
63        tarray(1) = 0.D0
64        tarray(2) = 0.D0
65        diff=dtime(tarray)
66C+----------------------------------------------------------------------+
67C| If the budget is lower zero, multiply the absolute value of the      |
68C| budget by the dimension of the problem.                              |
69C+----------------------------------------------------------------------+
70        if (DIRmaxf .lt. 0) then
71           DIRmaxf = -DIRmaxf*n
72        endif
73
74C+----------------------------------------------------------------------+
75C|  For some problems, we need to store some specific data in the user  |
76C|  variables.                                                          |
77C+----------------------------------------------------------------------+
78        if ((problem .ge. 5) .and. (problem .LE. 7)) then
79           iidata(1) = 5
80           if (problem .EQ. 6) THEN
81              iidata(1) = 7
82           else if (problem .EQ. 7) THEN
83            iidata(1) = 10
84           END IF
85         else if ((problem .ge. 8) .and. (problem .LE. 9)) then
86           n = 3
87           iidata(1) = 4
88           if (problem .EQ. 9) THEN
89              iidata(1) = 4
90              n = 6
91           END IF
92         end if
93C+----------------------------------------------------------------------+
94C| Call the optimization method.                                        |
95C+----------------------------------------------------------------------+
96        CALL DIRect(myfunc, DIRx, n, DIReps, DIRmaxf, DIRmaxT,
97     +              DIRf, l, u, DIRalg, Ierror, logfile,
98     +              fglobal, fglper, volper, sigmaper,
99     +              iidata, iisize, ddata, idsize, cdata, icsize)
100C+----------------------------------------------------------------------+
101C| Give out the results of the optimization.                            |
102C+----------------------------------------------------------------------+
103        Write(*,100)
104        Write(*,110) IError
105        Write(*,120) (DIRx(i),i=1,n)
106        Write(*,130) DIRf
107        Write(*,140) DIRmaxf
108        Write(logfile,100)
109        Write(logfile,110) IError
110        Write(logfile,120) (DIRx(i),i=1,n)
111        Write(logfile,130) DIRf
112        Write(logfile,140) DIRmaxf
113        diff=dtime(tarray)
114        write(*,150) diff
115        write(logfile,150) diff
116C+----------------------------------------------------------------------+
117C| Calculate the percent error.                                         |
118C+----------------------------------------------------------------------+
119        per2 = DIRf - fglobal
120        if (fglobal .eq. 0.D0) then
121           per2 = per2*100.D0
122        else
123           per2 = per2/ abs(fglobal)*100.D0
124        end if
125C+----------------------------------------------------------------------+
126C| Save the results in the extra resultfile for use with Matlab etc.    |
127C+----------------------------------------------------------------------+
128      write(resultfile,200) problem, DIRmaxf, diff, per2, DIRalg
129C+----------------------------------------------------------------------+
130C| Close the logfile and rsultfile.                                     |
131C+----------------------------------------------------------------------+
132      close(logfile)
133      close(resultfile)
134100   FORMAT('-------------- Final result ------------------')
135110   FORMAT('DIRECT termination flag : ',I3)
136120   FORMAT('DIRECT minimal point    : ',20f12.7)
137130   FORMAT('DIRECT minimal value    : ',f12.7)
138140   FORMAT('DIRECT number of f-eval : ',I5)
139150   FORMAT('Time needed             : ',e10.4,' seconds.')
140200   FORMAT(I3, ' ', I6, ' ', f12.4, ' ', e10.5, ' ',I6)
141      end
142
143
144C+--------------------------------------------------------------+
145C| Subroutine to read the values of the internal variables      |
146C| and the data for the interpolator.                           |
147C+--------------------------------------------------------------+
148      subroutine inputdata(n, u, l, logfile, DIReps, DIRmaxf,
149     +       DIRmaxT, problem, Maxdim, DIRalg, fglobal,
150     + fglper, volper, sigmaper,
151     + iidata, iisize, ddata, idsize, cdata, icsize)
152      implicit none
153      Integer file, Maxdim, intproblem
154      parameter(file = 31)
155      Integer logfile,DOIFFCO
156C+----------------------------------------------------------------------+
157C| DIRECT specific variables.                                           |
158C+----------------------------------------------------------------------+
159      Double Precision DIReps
160      Integer DIRmaxf, DIRmaxT
161      Double Precision fglobal, fglper, volper, sigmaper
162      Integer DIRalg
163C+-----------------------------------------------------------------------+
164C| Variables to pass user defined data to the function to be optimized.  |
165C+-----------------------------------------------------------------------+
166      INTEGER iisize, idsize, icsize
167      INTEGER iidata(iisize)
168      Double Precision ddata(idsize)
169      Character*40 cdata(icsize)
170
171C+----------------------------------------------------------------------+
172C| General variables for the problem.                                   |
173C+----------------------------------------------------------------------+
174      integer n, i
175      integer problem
176      Double Precision l(maxdim), u(maxdim)
177C+----------------------------------------------------------------------+
178C| Variables to store the different file names.                         |
179C+----------------------------------------------------------------------+
180      character DIRectinit*20
181      character problemdata*20
182
183C+----------------------------------------------------------------------+
184C| Read file names of the different files used in this run.             |
185C+----------------------------------------------------------------------+
186      open(unit = file, file='ini/main.ini')
187      read(file, 154) DIRectinit
188      read(file, 153) intproblem
189      read(file, 153) DOIFFCO
190      close(unit = file)
191      problem = intproblem
192C+----------------------------------------------------------------------+
193C| Store the problem number in the last entry of iidata.                |
194C+----------------------------------------------------------------------+
195      iidata(iisize) = problem
196      write(*,2000)
197      write(*,2010) DIRectinit
198      write(logfile,2000)
199      write(logfile,2010) DIRectinit
200      open(unit = file, file='ini/problems.ini')
201      read(file,153)
202      do 40,i = 1,problem+1
203         read(file, 154) problemdata
20440    continue
205      close(unit = file)
206      write(*,2020) problemdata
207      write(*,2030) problem
208      write(logfile,2020) problemdata
209      write(logfile,2030) problem
210C+----------------------------------------------------------------------+
211C| Read DIRECT variables from DIRinit.ini                               |
212C+----------------------------------------------------------------------+
213      open(unit = file, file = 'ini/'//DIRectinit)
214      read(file, 151) DIReps
215      read(file, 150) DIRmaxf
216      read(file, 150) DIRmaxT
217      read(file, 150) DIRalg
218C+----------------------------------------------------------------------+
219C| Read in the percent error when DIRECT should stop. If the optimal    |
220C| function value is not known (that is, when a real optimization is    |
221C| done), set this value to 0 and fglobal to -1.D100. This ensures that |
222C| the percentage condition cannot be satiesfied.                       |
223C+----------------------------------------------------------------------+
224      read(file, 151) fglper
225C+----------------------------------------------------------------------+
226C| Read in the percentage of the volume that the hyperrectangle which   |
227C| assumes fmin at its center needs to have to stop. Set this value to  |
228C| 0.D0 if you don't want to use this stopping criteria.                |
229C+----------------------------------------------------------------------+
230      read(file, 151) volper
231C+----------------------------------------------------------------------+
232C| Read in the bound on the measure that the hyperrectangle which       |
233C| assumes fmin at its center needs to have to stop. Set this value to  |
234C| 0.D0 if you don't want to use this stopping criteria.                |
235C+----------------------------------------------------------------------+
236      read(file, 151) sigmaper
237      close(unit = file)
238C+----------------------------------------------------------------------+
239C| Read problem specifics from problem data file.                       |
240C+----------------------------------------------------------------------+
241      open(unit = file, file = 'problem/'//problemdata)
242C+----------------------------------------------------------------------+
243C| Read in the problem name. This name is used in the initial output    |
244C| from DIRECT.                                                         |
245C+----------------------------------------------------------------------+
246      read(file,152) cdata(1)
247      read(file, 150) n
248C+----------------------------------------------------------------------+
249C| Read in the (know) optimal function value. Note that this value is   |
250C| generally not know, but for the test problems it is. If this value is|
251C| unknown, set fglobal to -1.D100 and fglper (see above) to 0.         |
252C+----------------------------------------------------------------------+
253      read(file, 151) fglobal
254      do 1000, i = 1,n
255         read(file, 151) l(i)
2561000  continue
257      do 1005, i = 1,n
258         read(file, 151) u(i)
2591005  continue
260      close(unit = file)
261
262150   FORMAT(I10)
263151   FORMAT(F20.10)
264152   FORMAT(A40)
265153   FORMAT(I20)
266154   FORMAT(A20)
267
2682000  FORMAT('Name of ini-directory    : ini/')
2692010  FORMAT('Name of DIRect.ini file  : ',A20)
2702020  FORMAT('Name of problemdata file : ',A20)
2712030  FORMAT('Testproblem used         : ',I4)
272      end
273
274C+----------------------------------------------------------------------+
275C| Give out a header for the main program.                              |
276C+----------------------------------------------------------------------+
277      SUBROUTINE mainheader(logfile)
278      IMPLICIT None
279      Integer logfile
280
281      write(*,100)
282      write(*,110)
283      write(*,120)
284      write(*,130)
285      write(*,140)
286      write(*,150)
287      write(*,160)
288      write(*,170)
289      write(*,180)
290      write(*,190)
291      write(*,200)
292      write(logfile,100)
293      write(logfile,110)
294      write(logfile,120)
295      write(logfile,130)
296      write(logfile,140)
297      write(logfile,150)
298      write(logfile,160)
299      write(logfile,170)
300      write(logfile,180)
301      write(logfile,190)
302      write(logfile,200)
303100   FORMAT('+----------------------------------------+')
304110   FORMAT('|       Example Program for DIRECT       |')
305120   FORMAT('|  This program uses DIRECT to optimize  |')
306130   FORMAT('|  testfunctions. Which testfunction is  |')
307140   FORMAT('| optimized and what parameters are used |')
308150   FORMAT('| is controlled by the files in ini/.    |')
309160   FORMAT('|                                        |')
310170   FORMAT('|     Owen Esslinger, Joerg Gablonsky,   |')
311180   FORMAT('|             Alton Patrick              |')
312190   FORMAT('|              04/15/2001                |')
313200   FORMAT('+----------------------------------------+')
314      end
315